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 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
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
35 (defconst cal-menu-moon-menu
37 ["Lunar Phases" calendar-phases-of-moon
]))
39 (defconst cal-menu-diary-menu
41 ["Other File" diary-view-other-diary-entries
]
42 ["Cursor Date" diary-view-entries
]
43 ["Mark All" diary-mark-entries
]
44 ["Show All" diary-show-all-entries
]
45 ["Insert Diary Entry" diary-insert-entry
]
46 ["Insert Weekly" diary-insert-weekly-entry
]
47 ["Insert Monthly" diary-insert-monthly-entry
]
48 ["Insert Yearly" diary-insert-yearly-entry
]
49 ["Insert Anniversary" diary-insert-anniversary-entry
]
50 ["Insert Block" diary-insert-block-entry
]
51 ["Insert Cyclic" diary-insert-cyclic-entry
]
53 ["One time" diary-bahai-insert-entry
]
54 ["Monthly" diary-bahai-insert-monthly-entry
]
55 ["Yearly" diary-bahai-insert-yearly-entry
])
57 ["One time" diary-islamic-insert-entry
]
58 ["Monthly" diary-islamic-insert-monthly-entry
]
59 ["Yearly" diary-islamic-insert-yearly-entry
])
61 ["One time" diary-hebrew-insert-entry
]
62 ["Monthly" diary-hebrew-insert-monthly-entry
]
63 ["Yearly" diary-hebrew-insert-yearly-entry
])))
65 (defun cal-menu-holiday-window-suffix ()
66 "Return a string suffix for the \"Window\" entry in `cal-menu-holidays-menu'."
67 (let ((my1 (calendar-increment-month-cons -
1))
68 (my2 (calendar-increment-month-cons 1)))
69 (if (= (cdr my1
) (cdr my2
))
71 (calendar-month-name (car my1
) 'abbrev
)
72 (calendar-month-name (car my2
) 'abbrev
)
74 (format "%s, %d-%s, %d"
75 (calendar-month-name (car my1
) 'abbrev
)
77 (calendar-month-name (car my2
) 'abbrev
)
80 (defvar displayed-year
) ; from calendar-generate
82 (defconst cal-menu-holidays-menu
84 ["For Cursor Date -" calendar-cursor-holidays
85 :suffix
(calendar-date-string (calendar-cursor-to-date) t t
)
86 :visible
(calendar-cursor-to-date)]
87 ["For Window -" calendar-list-holidays
88 :suffix
(cal-menu-holiday-window-suffix)]
89 ["For Today -" cal-menu-today-holidays
90 :suffix
(calendar-date-string (calendar-current-date) t t
)]
93 ;; Show 11 years--5 before, 5 after year of middle month.
94 ;; We used to use :suffix rather than :label and bumped into
96 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html
97 ;; The bug has since been fixed.
99 (push (vector (format "hol-year-%d" i
)
102 (holiday-list (+ displayed-year
,(- i
5))))
103 :label
`(format "For Year %d"
104 (+ displayed-year
,(- i
5))))
108 ["Unmark Calendar" calendar-unmark
]
109 ["Mark Holidays" calendar-mark-holidays
]))
111 (defconst cal-menu-goto-menu
113 ["Today" calendar-goto-today
]
114 ["Beginning of Week" calendar-beginning-of-week
]
115 ["End of Week" calendar-end-of-week
]
116 ["Beginning of Month" calendar-beginning-of-month
]
117 ["End of Month" calendar-end-of-month
]
118 ["Beginning of Year" calendar-beginning-of-year
]
119 ["End of Year" calendar-end-of-year
]
120 ["Other Date" calendar-goto-date
]
121 ["Day of Year" calendar-goto-day-of-year
]
122 ["ISO Week" calendar-iso-goto-week
]
123 ["ISO Date" calendar-iso-goto-date
]
124 ["Astronomical Date" calendar-astro-goto-day-number
]
125 ["Hebrew Date" calendar-hebrew-goto-date
]
126 ["Persian Date" calendar-persian-goto-date
]
127 ["Baha'i Date" calendar-bahai-goto-date
]
128 ["Islamic Date" calendar-islamic-goto-date
]
129 ["Julian Date" calendar-julian-goto-date
]
130 ["Chinese Date" calendar-chinese-goto-date
]
131 ["Coptic Date" calendar-coptic-goto-date
]
132 ["Ethiopic Date" calendar-ethiopic-goto-date
]
134 ["Next Tzolkin" calendar-mayan-next-tzolkin-date
]
135 ["Previous Tzolkin" calendar-mayan-previous-tzolkin-date
]
136 ["Next Haab" calendar-mayan-next-haab-date
]
137 ["Previous Haab" calendar-mayan-previous-haab-date
]
138 ["Next Round" calendar-mayan-next-round-date
]
139 ["Previous Round" calendar-mayan-previous-round-date
])
140 ["French Date" calendar-french-goto-date
]))
142 (defconst cal-menu-scroll-menu
144 ["Forward 1 Month" calendar-scroll-left
]
145 ["Forward 3 Months" calendar-scroll-left-three-months
]
146 ["Forward 1 Year" (calendar-scroll-left 12) :keys
"4 C-v"]
147 ["Backward 1 Month" calendar-scroll-right
]
148 ["Backward 3 Months" calendar-scroll-right-three-months
]
149 ["Backward 1 Year" (calendar-scroll-right 12) :keys
"4 M-v"]))
151 (defun cal-menu-x-popup-menu (position menu
)
152 "Like `x-popup-menu', but print an error message if popups are unavailable.
153 POSITION and MENU are passed to `x-popup-menu'."
154 (if (display-popup-menus-p)
155 (x-popup-menu position menu
)
156 (error "Popup menus are not available on this system")))
158 (defun cal-menu-list-holidays-year ()
159 "Display a list of the holidays of the selected date's year."
161 (holiday-list (calendar-extract-year (calendar-cursor-to-date))))
163 (defun cal-menu-list-holidays-following-year ()
164 "Display a list of the holidays of the following year."
166 (holiday-list (1+ (calendar-extract-year (calendar-cursor-to-date)))))
168 (defun cal-menu-list-holidays-previous-year ()
169 "Display a list of the holidays of the previous year."
171 (holiday-list (1- (calendar-extract-year (calendar-cursor-to-date)))))
173 (defun cal-menu-event-to-date (&optional error
)
175 If event is not on a specific date, signals an error if optional parameter
176 ERROR is non-nil, otherwise just returns nil."
178 (window-buffer (posn-window (event-start last-input-event
)))
179 (goto-char (posn-point (event-start last-input-event
)))
180 (calendar-cursor-to-date error
)))
182 (defun calendar-mouse-goto-date (date)
183 "Go to DATE in the buffer specified by `last-input-event'."
184 (set-buffer (window-buffer (posn-window (event-start last-input-event
))))
185 (calendar-goto-date date
))
187 (defun calendar-mouse-sunrise/sunset
()
188 "Show sunrise/sunset times for mouse-selected date."
191 (calendar-mouse-goto-date (cal-menu-event-to-date))
192 (calendar-sunrise-sunset)))
194 (defun cal-menu-today-holidays ()
195 "Show holidays for today's date."
198 (calendar-cursor-to-date (calendar-current-date))
199 (calendar-cursor-holidays)))
201 (autoload 'calendar-check-holidays
"holidays")
203 (defun calendar-mouse-holidays (&optional event
)
204 "Pop up menu of holidays for mouse selected date.
205 EVENT is the event that invoked this command."
207 (let* ((date (cal-menu-event-to-date))
208 (title (format "Holidays for %s" (calendar-date-string date
)))
210 (cal-menu-x-popup-menu
214 (or (mapcar 'list
(calendar-check-holidays date
))
216 (and selection
(call-interactively selection
))))
218 (autoload 'diary-list-entries
"diary-lib")
219 (defvar diary-show-holidays-flag
) ; only called from calendar.el
221 (defun calendar-mouse-view-diary-entries (&optional date diary event
)
222 "Pop up menu of diary entries for mouse-selected date.
223 Use optional DATE and alternative file DIARY. EVENT is the event
224 that invoked this command. Shows holidays if `diary-show-holidays-flag'
226 (interactive "i\ni\ne")
227 (let* ((date (or date
(cal-menu-event-to-date)))
228 (diary-file (or diary diary-file
))
229 (diary-list-include-blanks nil
)
231 (mapcar (lambda (x) (split-string (cadr x
) "\n"))
232 (diary-list-entries date
1 'list-only
)))
233 (holidays (if diary-show-holidays-flag
234 (calendar-check-holidays date
)))
235 (title (concat "Diary entries "
236 (if diary
(format "from %s " diary
) "")
238 (calendar-date-string date
)))
240 (cal-menu-x-popup-menu
245 (mapcar (lambda (x) (list (concat " " x
))) holidays
)
247 (list "--shadow-etched-in" "--shadow-etched-in"))
249 (mapcar 'list
(apply 'append diary-entries
))
251 (and selection
(call-interactively selection
))))
253 (defun calendar-mouse-view-other-diary-entries ()
254 "Pop up menu of diary entries from alternative file on mouse-selected date."
256 (calendar-mouse-view-diary-entries
257 (cal-menu-event-to-date)
258 (read-file-name "Enter diary file name: " default-directory nil t
)))
260 (defun calendar-mouse-insert-diary-entry ()
261 "Insert diary entry for mouse-selected date."
264 (calendar-mouse-goto-date (cal-menu-event-to-date))
265 (diary-insert-entry nil
)))
267 (defun calendar-mouse-set-mark ()
268 "Mark the date under the cursor."
271 (calendar-mouse-goto-date (cal-menu-event-to-date))
272 (calendar-set-mark nil
)))
274 (defun calendar-mouse-tex-day ()
275 "Make a buffer with LaTeX commands for the day mouse is on."
278 (calendar-mouse-goto-date (cal-menu-event-to-date))
279 (cal-tex-cursor-day nil
)))
281 (defun calendar-mouse-tex-week ()
282 "One page calendar for week indicated by cursor.
283 Holidays are included if `cal-tex-holidays' is non-nil."
286 (calendar-mouse-goto-date (cal-menu-event-to-date))
287 (cal-tex-cursor-week nil
)))
289 (defun calendar-mouse-tex-week2 ()
290 "Make a buffer with LaTeX commands for the week cursor is on.
291 The printed output will be on two pages."
294 (calendar-mouse-goto-date (cal-menu-event-to-date))
295 (cal-tex-cursor-week2 nil
)))
297 (defun calendar-mouse-tex-week-iso ()
298 "One page calendar for week indicated by cursor.
299 Holidays are included if `cal-tex-holidays' is non-nil."
302 (calendar-mouse-goto-date (cal-menu-event-to-date))
303 (cal-tex-cursor-week-iso nil
)))
305 (defun calendar-mouse-tex-week-monday ()
306 "One page calendar for week indicated by cursor."
309 (calendar-mouse-goto-date (cal-menu-event-to-date))
310 (cal-tex-cursor-week-monday nil
)))
312 (defun calendar-mouse-tex-filofax-daily ()
313 "Day-per-page Filofax calendar for week indicated by cursor."
316 (calendar-mouse-goto-date (cal-menu-event-to-date))
317 (cal-tex-cursor-filofax-daily nil
)))
319 (defun calendar-mouse-tex-filofax-2week ()
320 "One page Filofax calendar for week indicated by cursor."
323 (calendar-mouse-goto-date (cal-menu-event-to-date))
324 (cal-tex-cursor-filofax-2week nil
)))
326 (defun calendar-mouse-tex-filofax-week ()
327 "Two page Filofax calendar for week indicated by cursor."
330 (calendar-mouse-goto-date (cal-menu-event-to-date))
331 (cal-tex-cursor-filofax-week nil
)))
333 (defun calendar-mouse-tex-month ()
334 "Make a buffer with LaTeX commands for the month cursor is on.
335 Calendar is condensed onto one page."
338 (calendar-mouse-goto-date (cal-menu-event-to-date))
339 (cal-tex-cursor-month nil
)))
341 (defun calendar-mouse-tex-month-landscape ()
342 "Make a buffer with LaTeX commands for the month cursor is on.
343 The output is in landscape format, one month to a page."
346 (calendar-mouse-goto-date (cal-menu-event-to-date))
347 (cal-tex-cursor-month-landscape nil
)))
349 (defun calendar-mouse-tex-year ()
350 "Make a buffer with LaTeX commands for the year cursor is on."
353 (calendar-mouse-goto-date (cal-menu-event-to-date))
354 (cal-tex-cursor-year nil
)))
356 (defun calendar-mouse-tex-filofax-year ()
357 "Make a buffer with LaTeX commands for Filofax calendar of year cursor is on."
360 (calendar-mouse-goto-date (cal-menu-event-to-date))
361 (cal-tex-cursor-filofax-year nil
)))
363 (defun calendar-mouse-tex-year-landscape ()
364 "Make a buffer with LaTeX commands for the year cursor is on."
367 (calendar-mouse-goto-date (cal-menu-event-to-date))
368 (cal-tex-cursor-year-landscape nil
)))
370 (defun calendar-mouse-print-dates (&optional event
)
371 "Pop up menu of equivalent dates to mouse selected date.
372 EVENT is the event that invoked this command."
374 (let* ((date (cal-menu-event-to-date))
375 (title (format "%s (Gregorian)" (calendar-date-string date
)))
377 (cal-menu-x-popup-menu
381 (mapcar 'list
(calendar-other-dates date
)))))))
382 (and selection
(call-interactively selection
))))
384 (defun cal-menu-set-date-title (menu)
385 "Convert date of last event to title suitable for MENU."
386 (easy-menu-filter-return
387 menu
(calendar-date-string (cal-menu-event-to-date t
) t nil
)))
389 (easy-menu-define cal-menu-context-mouse-menu nil
390 "Pop up menu for Mouse-2 for selected date in the calendar window."
391 '("cal-menu-mouse2" :filter cal-menu-set-date-title
393 ["Holidays" calendar-mouse-holidays
]
394 ["Mark date" calendar-mouse-set-mark
]
395 ["Sunrise/sunset" calendar-mouse-sunrise
/sunset
]
396 ["Other calendars" calendar-mouse-print-dates
]
397 ("Prepare LaTeX buffer"
398 ["Daily (1 page)" calendar-mouse-tex-day
]
399 ["Weekly (1 page)" calendar-mouse-tex-week
]
400 ["Weekly (2 pages)" calendar-mouse-tex-week2
]
401 ["Weekly (other style; 1 page)" calendar-mouse-tex-week-iso
]
402 ["Weekly (yet another style; 1 page)" calendar-mouse-tex-week-monday
]
403 ["Monthly" calendar-mouse-tex-month
]
404 ["Monthly (landscape)" calendar-mouse-tex-month-landscape
]
405 ["Yearly" calendar-mouse-tex-year
]
406 ["Yearly (landscape)" calendar-mouse-tex-year-landscape
]
408 ["Filofax Daily (one-day-per-page)" calendar-mouse-tex-filofax-daily
]
409 ["Filofax Weekly (2-weeks-at-a-glance)" calendar-mouse-tex-filofax-2week
]
410 ["Filofax Weekly (week-at-a-glance)" calendar-mouse-tex-filofax-week
]
411 ["Filofax Yearly" calendar-mouse-tex-filofax-year
]))
412 ["Diary entries" calendar-mouse-view-diary-entries
]
413 ["Insert diary entry" calendar-mouse-insert-diary-entry
]
414 ["Other diary file entries" calendar-mouse-view-other-diary-entries
]))
416 (easy-menu-define cal-menu-global-mouse-menu nil
417 "Menu bound to a mouse event, not specific to the mouse-click location."
419 ["Scroll forward" calendar-scroll-left-three-months
]
420 ["Scroll backward" calendar-scroll-right-three-months
]
421 ["Mark diary entries" diary-mark-entries
]
422 ["List holidays" calendar-list-holidays
]
423 ["Mark holidays" calendar-mark-holidays
]
424 ["Unmark" calendar-unmark
]
425 ["Lunar phases" calendar-phases-of-moon
]
426 ["Show diary" diary-show-all-entries
]
427 ["Exit calendar" calendar-exit
]))
429 ;; Undocumented and probably useless.
430 (defvar cal-menu-load-hook nil
431 "Hook run on loading of the `cal-menu' package.")
432 (make-obsolete-variable 'cal-menu-load-hook
433 "it will be removed in future." "23.1")
435 (run-hooks 'cal-menu-load-hook
)
439 ;; arch-tag: aa81cf73-ce89-48a4-97ec-9ef861e87fe9
440 ;;; cal-menu.el ends here