1 ;;; cal-menu.el --- calendar functions for menu bar and popup menu support
3 ;; Copyright (C) 1994, 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4 ;; 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
7 ;; Lara Rios <lrios@coewl.cen.uiuc.edu>
8 ;; Maintainer: Glenn Morris <rgm@gnu.org>
10 ;; Human-Keywords: calendar, popup menus, menu bar
13 ;; This file is part of GNU Emacs.
15 ;; GNU Emacs is free software: you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation, either version 3 of the License, or
18 ;; (at your option) any later version.
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
36 (defconst cal-menu-sunmoon-menu
38 ["Lunar Phases" calendar-lunar-phases
]
39 ["Sunrise/sunset for cursor date" calendar-sunrise-sunset
]
40 ["Sunrise/sunset for cursor month" calendar-sunrise-sunset-month
])
41 "Key map for \"Sun/Moon\" menu in the calendar.")
43 (defconst cal-menu-diary-menu
45 ["Other File" diary-view-other-diary-entries
]
46 ["Cursor Date" diary-view-entries
]
47 ["Mark All" diary-mark-entries
]
48 ["Show All" diary-show-all-entries
]
49 ["Insert Diary Entry" diary-insert-entry
]
50 ["Insert Weekly" diary-insert-weekly-entry
]
51 ["Insert Monthly" diary-insert-monthly-entry
]
52 ["Insert Yearly" diary-insert-yearly-entry
]
53 ["Insert Anniversary" diary-insert-anniversary-entry
]
54 ["Insert Block" diary-insert-block-entry
]
55 ["Insert Cyclic" diary-insert-cyclic-entry
]
57 ["One time" diary-bahai-insert-entry
]
58 ["Monthly" diary-bahai-insert-monthly-entry
]
59 ["Yearly" diary-bahai-insert-yearly-entry
])
61 ["One time" diary-islamic-insert-entry
]
62 ["Monthly" diary-islamic-insert-monthly-entry
]
63 ["Yearly" diary-islamic-insert-yearly-entry
])
65 ["One time" diary-hebrew-insert-entry
]
66 ["Monthly" diary-hebrew-insert-monthly-entry
]
67 ["Yearly" diary-hebrew-insert-yearly-entry
]))
68 "Key map for \"Diary\" menu in the calendar.")
70 (defun cal-menu-holiday-window-suffix ()
71 "Return a string suffix for the \"Window\" entry in `cal-menu-holidays-menu'."
72 (let ((my1 (calendar-increment-month-cons -
1))
73 (my2 (calendar-increment-month-cons 1)))
74 ;; Mon1-Mon2, Year or Mon1, Year1-Mon2, Year2.
76 (calendar-month-name (car my1
) 'abbrev
)
77 (if (= (cdr my1
) (cdr my2
))
79 (format ", %d" (cdr my1
)))
80 (calendar-month-name (car my2
) 'abbrev
)
83 (defvar displayed-year
) ; from calendar-generate
85 (defconst cal-menu-holidays-menu
87 ["For Cursor Date -" calendar-cursor-holidays
88 :suffix
(calendar-date-string (calendar-cursor-to-date) t t
)
89 :visible
(calendar-cursor-to-date)]
90 ["For Window -" calendar-list-holidays
91 :suffix
(cal-menu-holiday-window-suffix)]
92 ["For Today -" (calendar-cursor-holidays (calendar-current-date))
93 :suffix
(calendar-date-string (calendar-current-date) t t
)]
96 ;; Show 11 years--5 before, 5 after year of middle month.
97 ;; We used to use :suffix rather than :label and bumped into
99 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html
100 ;; The bug has since been fixed.
102 (push (vector (format "hol-year-%d" i
)
105 (holiday-list (+ displayed-year
,(- i
5))))
106 :label
`(format "For Year %d"
107 (+ displayed-year
,(- i
5))))
111 ["Unmark Calendar" calendar-unmark
]
112 ["Mark Holidays" calendar-mark-holidays
])
113 "Key map for \"Holidays\" menu in the calendar.")
115 (defconst cal-menu-goto-menu
117 ["Today" calendar-goto-today
]
118 ["Beginning of Week" calendar-beginning-of-week
]
119 ["End of Week" calendar-end-of-week
]
120 ["Beginning of Month" calendar-beginning-of-month
]
121 ["End of Month" calendar-end-of-month
]
122 ["Beginning of Year" calendar-beginning-of-year
]
123 ["End of Year" calendar-end-of-year
]
124 ["Other Date" calendar-goto-date
]
125 ["Day of Year" calendar-goto-day-of-year
]
126 ["ISO Week" calendar-iso-goto-week
]
127 ["ISO Date" calendar-iso-goto-date
]
128 ["Astronomical Date" calendar-astro-goto-day-number
]
129 ["Hebrew Date" calendar-hebrew-goto-date
]
130 ["Persian Date" calendar-persian-goto-date
]
131 ["Baha'i Date" calendar-bahai-goto-date
]
132 ["Islamic Date" calendar-islamic-goto-date
]
133 ["Julian Date" calendar-julian-goto-date
]
134 ["Chinese Date" calendar-chinese-goto-date
]
135 ["Coptic Date" calendar-coptic-goto-date
]
136 ["Ethiopic Date" calendar-ethiopic-goto-date
]
138 ["Next Tzolkin" calendar-mayan-next-tzolkin-date
]
139 ["Previous Tzolkin" calendar-mayan-previous-tzolkin-date
]
140 ["Next Haab" calendar-mayan-next-haab-date
]
141 ["Previous Haab" calendar-mayan-previous-haab-date
]
142 ["Next Round" calendar-mayan-next-round-date
]
143 ["Previous Round" calendar-mayan-previous-round-date
])
144 ["French Date" calendar-french-goto-date
])
145 "Key map for \"Goto\" menu in the calendar.")
147 (defconst cal-menu-scroll-menu
149 ["Scroll Commands" nil
:help
"Commands that scroll the visible window"]
150 ["Forward 1 Month" calendar-scroll-left
]
151 ["Forward 3 Months" calendar-scroll-left-three-months
]
152 ["Forward 1 Year" (calendar-scroll-left 12) :keys
"4 C-v"]
153 ["Backward 1 Month" calendar-scroll-right
]
154 ["Backward 3 Months" calendar-scroll-right-three-months
]
155 ["Backward 1 Year" (calendar-scroll-right 12) :keys
"4 M-v"]
157 ["Motion Commands" nil
:help
"Commands that move point"]
158 ["Forward 1 Day" calendar-forward-day
]
159 ["Forward 1 Week" calendar-forward-week
]
160 ["Forward 1 Month" calendar-forward-month
]
161 ["Forward 1 Year" calendar-forward-year
]
162 ["Backward 1 Day" calendar-backward-day
]
163 ["Backward 1 Week" calendar-backward-week
]
164 ["Backward 1 Month" calendar-backward-month
]
165 ["Backward 1 Year" calendar-backward-year
])
166 "Key map for \"Scroll\" menu in the calendar.")
168 (declare-function x-popup-menu
"menu.c" (position menu
))
170 (defmacro cal-menu-x-popup-menu
(event title
&rest body
)
171 "Call `x-popup-menu' at position EVENT, with TITLE and contents BODY.
172 Signals an error if popups are unavailable."
174 `(if (display-popup-menus-p)
175 (x-popup-menu ,event
(list ,title
(append (list ,title
) ,@body
)))
176 (error "Popup menus are not available on this system")))
178 (autoload 'diary-list-entries
"diary-lib")
179 ;; Autoloaded in diary-lib.
180 (declare-function calendar-check-holidays
"holidays" (date))
182 (defun calendar-mouse-view-diary-entries (&optional date diary event
)
183 "Pop up menu of diary entries for mouse-selected date.
184 Use optional DATE and alternative file DIARY. EVENT is the event
185 that invoked this command. Shows holidays if `diary-show-holidays-flag'
187 (interactive "i\ni\ne")
188 (let* ((date (or date
(calendar-cursor-to-date nil event
)))
189 (diary-file (or diary diary-file
))
190 (diary-list-include-blanks nil
)
191 (diary-entries (mapcar (lambda (x) (split-string (cadr x
) "\n"))
192 (diary-list-entries date
1 'list-only
)))
193 (holidays (if diary-show-holidays-flag
194 (calendar-check-holidays date
)))
195 (title (format "Diary entries%s for %s"
196 (if diary
(format " from %s" diary
) "")
197 (calendar-date-string date
)))
198 (selection (cal-menu-x-popup-menu event title
199 (mapcar (lambda (x) (list (concat " " x
))) holidays
)
201 (list "--shadow-etched-in" "--shadow-etched-in"))
203 (mapcar 'list
(apply 'append diary-entries
))
205 (and selection
(call-interactively selection
))))
207 (defun calendar-mouse-view-other-diary-entries (&optional event
)
208 "Pop up menu of diary entries from alternative file on mouse-selected date."
210 (calendar-mouse-view-diary-entries
211 (calendar-cursor-to-date nil event
)
212 (read-file-name "Enter diary file name: " default-directory nil t
)
215 ;; In 22, the equivalent code gave an error when not called on a date,
216 ;; but easymenu does not seem to allow this (?).
217 ;; The ignore-errors is because `documentation' can end up calling
218 ;; this in a non-calendar buffer where displayed-month is unbound. (Bug#3862)
219 (defun cal-menu-set-date-title (menu)
220 "Convert date of last event to title suitable for MENU."
221 (let ((date (ignore-errors (calendar-cursor-to-date nil last-input-event
))))
223 (easy-menu-filter-return menu
(calendar-date-string date t nil
))
224 (message "Not on a date!")
227 (easy-menu-define cal-menu-context-mouse-menu nil
228 "Pop up mouse menu for selected date in the calendar window."
229 '("cal-menu-context-mouse-menu" :filter cal-menu-set-date-title
231 ["Holidays" calendar-cursor-holidays
]
232 ["Mark date" calendar-set-mark
]
233 ["Sunrise/sunset" calendar-sunrise-sunset
]
234 ["Other calendars" calendar-print-other-dates
]
235 ;; There was a bug (#447; fixed) with last-nonmenu-event and submenus.
236 ;; These did not work if called without calendar window selected.
237 ("Prepare LaTeX buffer"
238 ["Daily (1 page)" cal-tex-cursor-day
]
239 ["Weekly (1 page)" cal-tex-cursor-week
]
240 ["Weekly (2 pages)" cal-tex-cursor-week2
]
241 ["Weekly (other style; 1 page)" cal-tex-cursor-week-iso
]
242 ["Weekly (yet another style; 1 page)" cal-tex-cursor-week-monday
]
243 ["Monthly" cal-tex-cursor-month
]
244 ["Monthly (landscape)" cal-tex-cursor-month-landscape
]
245 ["Yearly" cal-tex-cursor-year
]
246 ["Yearly (landscape)" cal-tex-cursor-year-landscape
]
248 ["Filofax Daily (one-day-per-page)" cal-tex-cursor-filofax-daily
]
249 ["Filofax Weekly (2-weeks-at-a-glance)" cal-tex-cursor-filofax-2week
]
250 ["Filofax Weekly (week-at-a-glance)" cal-tex-cursor-filofax-week
]
251 ["Filofax Yearly" cal-tex-cursor-filofax-year
]))
252 ("Write HTML calendar"
253 ["For selected month" cal-html-cursor-month
]
254 ["For selected year" cal-html-cursor-year
])
255 ["Diary entries" calendar-mouse-view-diary-entries
:keys
"d"]
256 ["Insert diary entry" diary-insert-entry
]
257 ["Other diary file entries" calendar-mouse-view-other-diary-entries
260 (easy-menu-define cal-menu-global-mouse-menu nil
261 "Menu bound to a mouse event, not specific to the mouse-click location."
263 ["Scroll forward" calendar-scroll-left-three-months
]
264 ["Scroll backward" calendar-scroll-right-three-months
]
265 ["Mark diary entries" diary-mark-entries
]
266 ["List holidays" calendar-list-holidays
]
267 ["Mark holidays" calendar-mark-holidays
]
268 ["Unmark" calendar-unmark
]
269 ["Lunar phases" calendar-lunar-phases
]
270 ["Sunrise times for month" calendar-sunrise-sunset-month
]
271 ["Show diary" diary-show-all-entries
]
272 ["Exit calendar" calendar-exit
]))
274 ;; Undocumented and probably useless.
275 (defvar cal-menu-load-hook nil
276 "Hook run on loading of the `cal-menu' package.")
277 (make-obsolete-variable 'cal-menu-load-hook
278 "it will be removed in future." "23.1")
280 (run-hooks 'cal-menu-load-hook
)
284 ;; arch-tag: aa81cf73-ce89-48a4-97ec-9ef861e87fe9
285 ;;; cal-menu.el ends here