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 ;; 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, or (at your option)
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; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
31 ;; This collection of functions implements menu bar and popup menu support for
36 (defvar displayed-year
)
38 (defconst cal-menu-moon-menu
40 ["Lunar Phases" calendar-phases-of-moon
]))
42 (defconst cal-menu-diary-menu
44 ["Other File" view-other-diary-entries
]
45 ["Cursor Date" diary-view-entries
]
46 ["Mark All" mark-diary-entries
]
47 ["Show All" diary-show-all-entries
]
48 ["Insert Diary Entry" insert-diary-entry
]
49 ["Insert Weekly" insert-weekly-diary-entry
]
50 ["Insert Monthly" insert-monthly-diary-entry
]
51 ["Insert Yearly" insert-yearly-diary-entry
]
52 ["Insert Anniversary" insert-anniversary-diary-entry
]
53 ["Insert Block" insert-block-diary-entry
]
54 ["Insert Cyclic" insert-cyclic-diary-entry
]
56 [" " nil
:suffix
(calendar-bahai-date-string (calendar-cursor-to-date))]
57 ["One time" diary-bahai-insert-entry
]
58 ["Monthly" diary-bahai-insert-monthly-entry
]
59 ["Yearly" diary-bahai-insert-yearly-entry
])
61 [" " nil
:suffix
(calendar-islamic-date-string (calendar-cursor-to-date))]
62 ["One time" insert-islamic-diary-entry
]
63 ["Monthly" insert-monthly-islamic-diary-entry
]
64 ["Yearly" insert-yearly-islamic-diary-entry
])
66 [" " nil
:suffix
(calendar-hebrew-date-string (calendar-cursor-to-date))]
67 ["One time" insert-hebrew-diary-entry
]
68 ["Monthly" insert-monthly-hebrew-diary-entry
]
69 ["Yearly" insert-yearly-hebrew-diary-entry
])))
71 (defun cal-menu-holiday-window-suffix ()
72 (let ((my1 (calendar-increment-month -
1))
73 (my2 (calendar-increment-month 1)))
74 (if (= (cdr my1
) (cdr my2
))
76 (calendar-month-name (car my1
) 'abbrev
)
77 (calendar-month-name (car my2
) 'abbrev
)
79 (format "%s, %d-%s, %d"
80 (calendar-month-name (car my1
) 'abbrev
)
82 (calendar-month-name (car my2
) 'abbrev
)
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 -" cal-menu-today-holidays
93 :suffix
(calendar-date-string (calendar-current-date) t t
)]
96 ;; Show 11 years--5 before, 5 after year of middle month.
98 (push (vector "For Year"
101 (holiday-list (+ displayed-year
,(- i
5))
102 (+ displayed-year
,(- i
5))))
103 :suffix
`(number-to-string (+ displayed-year
,(- i
5))))
107 ["Unmark Calendar" calendar-unmark
]
108 ["Mark Holidays" mark-calendar-holidays
]))
110 (defconst cal-menu-goto-menu
112 ["Today" calendar-goto-today
]
113 ["Beginning of Week" calendar-beginning-of-week
]
114 ["End of Week" calendar-end-of-week
]
115 ["Beginning of Month" calendar-beginning-of-month
]
116 ["End of Month" calendar-end-of-month
]
117 ["Beginning of Year" calendar-beginning-of-year
]
118 ["End of Year" calendar-end-of-year
]
119 ["Other Date" calendar-goto-date
]
120 ["Day of Year" calendar-goto-day-of-year
]
121 ["ISO Week" calendar-goto-iso-week
]
122 ["ISO Date" calendar-goto-iso-date
]
123 ["Astronomical Date" calendar-goto-astro-day-number
]
124 ["Hebrew Date" calendar-goto-hebrew-date
]
125 ["Persian Date" calendar-goto-persian-date
]
126 ["Baha'i Date" calendar-bahai-goto-date
]
127 ["Islamic Date" calendar-goto-islamic-date
]
128 ["Julian Date" calendar-goto-julian-date
]
129 ["Chinese Date" calendar-goto-chinese-date
]
130 ["Coptic Date" calendar-goto-coptic-date
]
131 ["Ethiopic Date" calendar-goto-ethiopic-date
]
133 ["Next Tzolkin" calendar-next-tzolkin-date
]
134 ["Previous Tzolkin" calendar-previous-tzolkin-date
]
135 ["Next Haab" calendar-next-haab-date
]
136 ["Previous Haab" calendar-previous-haab-date
]
137 ["Next Round" calendar-next-calendar-round-date
]
138 ["Previous Round" calendar-previous-calendar-round-date
])
139 ["French Date" calendar-goto-french-date
]))
141 (defconst cal-menu-scroll-menu
143 ["Forward 1 Month" calendar-scroll-left
]
144 ["Forward 3 Months" calendar-scroll-left-three-months
]
145 ["Forward 1 Year" "4\C-v"]
146 ["Backward 1 Month" calendar-scroll-right
]
147 ["Backward 3 Months" calendar-scroll-right-three-months
]
148 ["Backward 1 Year" "4\ev"]))
150 (defun cal-menu-x-popup-menu (position menu
)
151 "Like `x-popup-menu', but prints an error message if popup menus are
153 (if (display-popup-menus-p)
154 (x-popup-menu position menu
)
155 (error "Popup menus are not available on this system")))
157 (defun cal-menu-list-holidays-year ()
158 "Display a list of the holidays of the selected date's year."
160 (let ((year (extract-calendar-year (calendar-cursor-to-date))))
161 (holiday-list year year
)))
163 (defun cal-menu-list-holidays-following-year ()
164 "Display a list of the holidays of the following year."
166 (let ((year (1+ (extract-calendar-year (calendar-cursor-to-date)))))
167 (holiday-list year year
)))
169 (defun cal-menu-list-holidays-previous-year ()
170 "Display a list of the holidays of the previous year."
172 (let ((year (1- (extract-calendar-year (calendar-cursor-to-date)))))
173 (holiday-list year year
)))
175 (defun calendar-event-to-date (&optional error
)
177 If event is not on a specific date, signals an error if optional parameter
178 ERROR is t, otherwise just returns nil."
180 (window-buffer (posn-window (event-start last-input-event
)))
181 (goto-char (posn-point (event-start last-input-event
)))
182 (calendar-cursor-to-date error
)))
184 (defun calendar-mouse-sunrise/sunset
()
185 "Show sunrise/sunset times for mouse-selected date."
188 (calendar-mouse-goto-date (calendar-event-to-date))
189 (calendar-sunrise-sunset)))
191 (defun cal-menu-today-holidays ()
192 "Show holidays for today's date."
195 (calendar-cursor-to-date (calendar-current-date))
196 (calendar-cursor-holidays)))
198 (autoload 'calendar-check-holidays
"holidays")
199 (autoload 'diary-list-entries
"diary-lib")
201 (defun calendar-mouse-holidays (&optional event
)
202 "Pop up menu of holidays for mouse selected date."
204 (let* ((date (calendar-event-to-date))
205 (l (mapcar 'list
(calendar-check-holidays date
)))
207 (cal-menu-x-popup-menu
210 (format "Holidays for %s" (calendar-date-string date
))
212 (list (format "Holidays for %s" (calendar-date-string date
)))
213 (if l l
'("None")))))))
214 (and selection
(call-interactively selection
))))
216 (defun calendar-mouse-view-diary-entries (&optional date diary event
)
217 "Pop up menu of diary entries for mouse-selected date.
218 Use optional DATE and alternative file DIARY.
220 Any holidays are shown if `holidays-in-diary-buffer' is t."
221 (interactive "i\ni\ne")
222 (let* ((date (or date
(calendar-event-to-date)))
223 (diary-file (if diary diary diary-file
))
224 (diary-list-include-blanks nil
)
225 (diary-display-hook 'ignore
)
227 (mapcar (lambda (x) (split-string (cadr x
) "\n"))
228 (diary-list-entries date
1 'list-only
)))
229 (holidays (if holidays-in-diary-buffer
230 (calendar-check-holidays date
)))
231 (title (concat "Diary entries "
232 (if diary
(format "from %s " diary
) "")
234 (calendar-date-string date
)))
236 (cal-menu-x-popup-menu
241 (mapcar (lambda (x) (list (concat " " x
))) holidays
)
243 (list "--shadow-etched-in" "--shadow-etched-in"))
245 (mapcar 'list
(apply 'append diary-entries
))
247 (and selection
(call-interactively selection
))))
249 (defun calendar-mouse-view-other-diary-entries ()
250 "Pop up menu of diary entries from alternative file on mouse-selected date."
252 (calendar-mouse-view-diary-entries
253 (calendar-event-to-date)
254 (read-file-name "Enter diary file name: " default-directory nil t
)))
256 (defun calendar-mouse-insert-diary-entry ()
257 "Insert diary entry for mouse-selected date."
260 (calendar-mouse-goto-date (calendar-event-to-date))
261 (insert-diary-entry nil
)))
263 (defun calendar-mouse-set-mark ()
264 "Mark the date under the cursor."
267 (calendar-mouse-goto-date (calendar-event-to-date))
268 (calendar-set-mark nil
)))
270 (defun cal-tex-mouse-day ()
271 "Make a buffer with LaTeX commands for the day mouse is on."
274 (calendar-mouse-goto-date (calendar-event-to-date))
275 (cal-tex-cursor-day nil
)))
277 (defun cal-tex-mouse-week ()
278 "One page calendar for week indicated by cursor.
279 Holidays are included if `cal-tex-holidays' is t."
282 (calendar-mouse-goto-date (calendar-event-to-date))
283 (cal-tex-cursor-week nil
)))
285 (defun cal-tex-mouse-week2 ()
286 "Make a buffer with LaTeX commands for the week cursor is on.
287 The printed output will be on two pages."
290 (calendar-mouse-goto-date (calendar-event-to-date))
291 (cal-tex-cursor-week2 nil
)))
293 (defun cal-tex-mouse-week-iso ()
294 "One page calendar for week indicated by cursor.
295 Holidays are included if `cal-tex-holidays' is t."
298 (calendar-mouse-goto-date (calendar-event-to-date))
299 (cal-tex-cursor-week-iso nil
)))
301 (defun cal-tex-mouse-week-monday ()
302 "One page calendar for week indicated by cursor."
305 (calendar-mouse-goto-date (calendar-event-to-date))
306 (cal-tex-cursor-week-monday nil
)))
308 (defun cal-tex-mouse-filofax-daily ()
309 "Day-per-page Filofax calendar for week indicated by cursor."
312 (calendar-mouse-goto-date (calendar-event-to-date))
313 (cal-tex-cursor-filofax-daily nil
)))
315 (defun cal-tex-mouse-filofax-2week ()
316 "One page Filofax calendar for week indicated by cursor."
319 (calendar-mouse-goto-date (calendar-event-to-date))
320 (cal-tex-cursor-filofax-2week nil
)))
322 (defun cal-tex-mouse-filofax-week ()
323 "Two page Filofax calendar for week indicated by cursor."
326 (calendar-mouse-goto-date (calendar-event-to-date))
327 (cal-tex-cursor-filofax-week nil
)))
329 (defun cal-tex-mouse-month ()
330 "Make a buffer with LaTeX commands for the month cursor is on.
331 Calendar is condensed onto one page."
334 (calendar-mouse-goto-date (calendar-event-to-date))
335 (cal-tex-cursor-month nil
)))
337 (defun cal-tex-mouse-month-landscape ()
338 "Make a buffer with LaTeX commands for the month cursor is on.
339 The output is in landscape format, one month to a page."
342 (calendar-mouse-goto-date (calendar-event-to-date))
343 (cal-tex-cursor-month-landscape nil
)))
345 (defun cal-tex-mouse-year ()
346 "Make a buffer with LaTeX commands for the year cursor is on."
349 (calendar-mouse-goto-date (calendar-event-to-date))
350 (cal-tex-cursor-year nil
)))
352 (defun cal-tex-mouse-filofax-year ()
353 "Make a buffer with LaTeX commands for Filofax calendar of year cursor is on."
356 (calendar-mouse-goto-date (calendar-event-to-date))
357 (cal-tex-cursor-filofax-year nil
)))
359 (defun cal-tex-mouse-year-landscape ()
360 "Make a buffer with LaTeX commands for the year cursor is on."
363 (calendar-mouse-goto-date (calendar-event-to-date))
364 (cal-tex-cursor-year-landscape nil
)))
366 (defun calendar-mouse-print-dates (&optional event
)
367 "Pop up menu of equivalent dates to mouse selected date."
369 (let* ((date (calendar-event-to-date))
371 (cal-menu-x-popup-menu
374 (concat (calendar-date-string date
) " (Gregorian)")
377 (concat (calendar-date-string date
) " (Gregorian)")
378 (list (calendar-day-of-year-string date
))
379 (list (format "ISO date: %s" (calendar-iso-date-string date
)))
380 (list (format "Julian date: %s"
381 (calendar-julian-date-string date
)))
383 (format "Astronomical (Julian) day number (at noon UTC): %s.0"
384 (calendar-astro-date-string date
)))
386 (format "Fixed (RD) date: %s"
387 (calendar-absolute-from-gregorian date
)))
388 (list (format "Hebrew date (before sunset): %s"
389 (calendar-hebrew-date-string date
)))
390 (list (format "Persian date: %s"
391 (calendar-persian-date-string date
)))
392 (list (format "Baha'i date (before sunset): %s"
393 (calendar-bahai-date-string date
))))
394 (let ((i (calendar-islamic-date-string date
)))
395 (if (not (string-equal i
""))
396 (list (list (format "Islamic date (before sunset): %s" i
)))))
398 (list (format "Chinese date: %s"
399 (calendar-chinese-date-string date
))))
400 ;; (list '("Chinese date (select to echo Chinese date)"
401 ;; . calendar-mouse-chinese-date))
402 (let ((c (calendar-coptic-date-string date
)))
403 (if (not (string-equal c
""))
404 (list (list (format "Coptic date: %s" c
)))))
405 (let ((e (calendar-ethiopic-date-string date
)))
406 (if (not (string-equal e
""))
407 (list (list (format "Ethiopic date: %s" e
)))))
408 (let ((f (calendar-french-date-string date
)))
409 (if (not (string-equal f
""))
410 (list (list (format "French Revolutionary date: %s" f
)))))
413 (format "Mayan date: %s"
414 (calendar-mayan-date-string date
)))))))))
415 (and selection
(call-interactively selection
))))
417 (defun calendar-mouse-chinese-date ()
418 "Show Chinese equivalent for mouse-selected date."
421 (calendar-mouse-goto-date (calendar-event-to-date))
422 (calendar-print-chinese-date)))
424 (defun calendar-mouse-goto-date (date)
425 (set-buffer (window-buffer (posn-window (event-start last-input-event
))))
426 (calendar-goto-date date
))
428 (easy-menu-define cal-menu-context-mouse-menu nil
429 "Pop up menu for Mouse-2 for selected date in the calendar window."
430 '("foo" :filter cal-menu-set-date-title
432 ["Holidays" calendar-mouse-holidays
]
433 ["Mark date" calendar-mouse-set-mark
]
434 ["Sunrise/sunset" calendar-mouse-sunrise
/sunset
]
435 ["Other calendars" calendar-mouse-print-dates
]
436 ("Prepare LaTeX buffer"
437 ["Daily (1 page)" cal-tex-mouse-day
]
438 ["Weekly (1 page)" cal-tex-mouse-week
]
439 ["Weekly (2 pages)" cal-tex-mouse-week2
]
440 ["Weekly (other style; 1 page)" cal-tex-mouse-week-iso
]
441 ["Weekly (yet another style; 1 page)" cal-tex-mouse-week-monday
]
442 ["Monthly" cal-tex-mouse-month
]
443 ["Monthly (landscape)" cal-tex-mouse-month-landscape
]
444 ["Yearly" cal-tex-mouse-year
]
445 ["Yearly (landscape)" cal-tex-mouse-year-landscape
]
447 ["Filofax Daily (one-day-per-page)" cal-tex-mouse-filofax-daily
]
448 ["Filofax Weekly (2-weeks-at-a-glance)" cal-tex-mouse-filofax-2week
]
449 ["Filofax Weekly (week-at-a-glance)" cal-tex-mouse-filofax-week
]
450 ["Filofax Yearly" cal-tex-mouse-filofax-year
]))
451 ["Diary entries" calendar-mouse-view-diary-entries
]
452 ["Insert diary entry" calendar-mouse-insert-diary-entry
]
453 ["Other diary file entries" calendar-mouse-view-other-diary-entries
]))
455 (defun cal-menu-set-date-title (menu)
456 (easy-menu-filter-return
457 menu
(calendar-date-string (calendar-event-to-date t
) t nil
)))
459 (easy-menu-define cal-menu-global-mouse-menu nil
460 "Menu bound to a mouse event, not specific to the mouse-click location."
462 ["Scroll forward" calendar-scroll-left-three-months
]
463 ["Scroll backward" calendar-scroll-right-three-months
]
464 ["Mark diary entries" mark-diary-entries
]
465 ["List holidays" calendar-list-holidays
]
466 ["Mark holidays" calendar-mark-holidays
]
467 ["Unmark" calendar-unmark
]
468 ["Lunar phases" calendar-phases-of-moon
]
469 ["Show diary" diary-show-all-entries
]
470 ["Exit calendar" exit-calendar
]))
472 (run-hooks 'cal-menu-load-hook
)
476 ;; arch-tag: aa81cf73-ce89-48a4-97ec-9ef861e87fe9
477 ;;; cal-menu.el ends here