Commit | Line | Data |
---|---|---|
aef1a243 RS |
1 | ;;; cal-menu.el --- calendar functions for menu bar and popup menu support |
2 | ||
965c8899 | 3 | ;; Copyright (C) 1994, 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
114f9c96 | 4 | ;; 2008, 2009, 2010 Free Software Foundation, Inc. |
aef1a243 RS |
5 | |
6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | |
71ea27ee | 7 | ;; Lara Rios <lrios@coewl.cen.uiuc.edu> |
aff88519 | 8 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
aef1a243 RS |
9 | ;; Keywords: calendar |
10 | ;; Human-Keywords: calendar, popup menus, menu bar | |
bd78fa1d | 11 | ;; Package: calendar |
aef1a243 RS |
12 | |
13 | ;; This file is part of GNU Emacs. | |
14 | ||
2ed66575 | 15 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
59243403 | 16 | ;; it under the terms of the GNU General Public License as published by |
2ed66575 GM |
17 | ;; the Free Software Foundation, either version 3 of the License, or |
18 | ;; (at your option) any later version. | |
59243403 | 19 | |
aef1a243 | 20 | ;; GNU Emacs is distributed in the hope that it will be useful, |
59243403 RS |
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. | |
24 | ||
25 | ;; You should have received a copy of the GNU General Public License | |
2ed66575 | 26 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
aef1a243 RS |
27 | |
28 | ;;; Commentary: | |
29 | ||
714b5034 | 30 | ;; See calendar.el. |
aef1a243 | 31 | |
aef1a243 RS |
32 | ;;; Code: |
33 | ||
7ff651d0 | 34 | (require 'calendar) |
f086f609 | 35 | |
70e420e3 GM |
36 | (defconst cal-menu-sunmoon-menu |
37 | '("Sun/Moon" | |
d88acfe1 | 38 | ["Lunar Phases" calendar-lunar-phases] |
70e420e3 GM |
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.") | |
05efa389 SM |
42 | |
43 | (defconst cal-menu-diary-menu | |
44 | '("Diary" | |
9ee4e581 | 45 | ["Other File" diary-view-other-diary-entries] |
05efa389 | 46 | ["Cursor Date" diary-view-entries] |
9ee4e581 | 47 | ["Mark All" diary-mark-entries] |
05efa389 | 48 | ["Show All" diary-show-all-entries] |
9ee4e581 GM |
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] | |
05efa389 | 56 | ("Insert Baha'i" |
4aefe5e2 GM |
57 | ["One time" diary-bahai-insert-entry] |
58 | ["Monthly" diary-bahai-insert-monthly-entry] | |
59 | ["Yearly" diary-bahai-insert-yearly-entry]) | |
05efa389 | 60 | ("Insert Islamic" |
c2bfc7e3 GM |
61 | ["One time" diary-islamic-insert-entry] |
62 | ["Monthly" diary-islamic-insert-monthly-entry] | |
63 | ["Yearly" diary-islamic-insert-yearly-entry]) | |
05efa389 | 64 | ("Insert Hebrew" |
7e254548 | 65 | ["One time" diary-hebrew-insert-entry] |
378d6045 | 66 | ["Monthly" diary-hebrew-insert-monthly-entry] |
0fa9d7e2 GM |
67 | ["Yearly" diary-hebrew-insert-yearly-entry])) |
68 | "Key map for \"Diary\" menu in the calendar.") | |
05efa389 SM |
69 | |
70 | (defun cal-menu-holiday-window-suffix () | |
5bbcf603 | 71 | "Return a string suffix for the \"Window\" entry in `cal-menu-holidays-menu'." |
e803eab7 GM |
72 | (let ((my1 (calendar-increment-month-cons -1)) |
73 | (my2 (calendar-increment-month-cons 1))) | |
df59aa7b GM |
74 | ;; Mon1-Mon2, Year or Mon1, Year1-Mon2, Year2. |
75 | (format "%s%s-%s, %d" | |
76 | (calendar-month-name (car my1) 'abbrev) | |
77 | (if (= (cdr my1) (cdr my2)) | |
78 | "" | |
79 | (format ", %d" (cdr my1))) | |
80 | (calendar-month-name (car my2) 'abbrev) | |
81 | (cdr my2)))) | |
05efa389 | 82 | |
e803eab7 | 83 | (defvar displayed-year) ; from calendar-generate |
6cd61ebd | 84 | |
05efa389 SM |
85 | (defconst cal-menu-holidays-menu |
86 | `("Holidays" | |
87 | ["For Cursor Date -" calendar-cursor-holidays | |
88 | :suffix (calendar-date-string (calendar-cursor-to-date) t t) | |
89 | :visible (calendar-cursor-to-date)] | |
175ede29 | 90 | ["For Window -" calendar-list-holidays |
05efa389 | 91 | :suffix (cal-menu-holiday-window-suffix)] |
df59aa7b | 92 | ["For Today -" (calendar-cursor-holidays (calendar-current-date)) |
05efa389 SM |
93 | :suffix (calendar-date-string (calendar-current-date) t t)] |
94 | "--" | |
95 | ,@(let ((l ())) | |
96 | ;; Show 11 years--5 before, 5 after year of middle month. | |
29ca115f SM |
97 | ;; We used to use :suffix rather than :label and bumped into |
98 | ;; an easymenu bug: | |
60806b73 | 99 | ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html |
29ca115f | 100 | ;; The bug has since been fixed. |
05efa389 | 101 | (dotimes (i 11) |
60806b73 | 102 | (push (vector (format "hol-year-%d" i) |
771e1882 GM |
103 | `(lambda () |
104 | (interactive) | |
fdbe82c9 | 105 | (holiday-list (+ displayed-year ,(- i 5)))) |
60806b73 GM |
106 | :label `(format "For Year %d" |
107 | (+ displayed-year ,(- i 5)))) | |
771e1882 | 108 | l)) |
05efa389 SM |
109 | (nreverse l)) |
110 | "--" | |
111 | ["Unmark Calendar" calendar-unmark] | |
0fa9d7e2 GM |
112 | ["Mark Holidays" calendar-mark-holidays]) |
113 | "Key map for \"Holidays\" menu in the calendar.") | |
05efa389 SM |
114 | |
115 | (defconst cal-menu-goto-menu | |
70e420e3 | 116 | '("Goto" |
05efa389 SM |
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] | |
c2bfc7e3 GM |
126 | ["ISO Week" calendar-iso-goto-week] |
127 | ["ISO Date" calendar-iso-goto-date] | |
128 | ["Astronomical Date" calendar-astro-goto-day-number] | |
7e254548 | 129 | ["Hebrew Date" calendar-hebrew-goto-date] |
c2bfc7e3 | 130 | ["Persian Date" calendar-persian-goto-date] |
4aefe5e2 | 131 | ["Baha'i Date" calendar-bahai-goto-date] |
c2bfc7e3 GM |
132 | ["Islamic Date" calendar-islamic-goto-date] |
133 | ["Julian Date" calendar-julian-goto-date] | |
7e254548 | 134 | ["Chinese Date" calendar-chinese-goto-date] |
06bfc982 GM |
135 | ["Coptic Date" calendar-coptic-goto-date] |
136 | ["Ethiopic Date" calendar-ethiopic-goto-date] | |
05efa389 | 137 | ("Mayan Date" |
c2bfc7e3 GM |
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]) | |
0fa9d7e2 | 144 | ["French Date" calendar-french-goto-date]) |
70e420e3 | 145 | "Key map for \"Goto\" menu in the calendar.") |
05efa389 SM |
146 | |
147 | (defconst cal-menu-scroll-menu | |
148 | '("Scroll" | |
d8899a74 | 149 | ["Scroll Commands" nil :help "Commands that scroll the visible window"] |
cca1dde0 SM |
150 | ["Forward 1 Month" calendar-scroll-left] |
151 | ["Forward 3 Months" calendar-scroll-left-three-months] | |
378d6045 | 152 | ["Forward 1 Year" (calendar-scroll-left 12) :keys "4 C-v"] |
cca1dde0 SM |
153 | ["Backward 1 Month" calendar-scroll-right] |
154 | ["Backward 3 Months" calendar-scroll-right-three-months] | |
d8899a74 GM |
155 | ["Backward 1 Year" (calendar-scroll-right 12) :keys "4 M-v"] |
156 | "--" | |
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]) | |
0fa9d7e2 | 166 | "Key map for \"Scroll\" menu in the calendar.") |
f9df0ca0 | 167 | |
e8a11b22 | 168 | (declare-function x-popup-menu "menu.c" (position menu)) |
f2d9c15f | 169 | |
df59aa7b GM |
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." | |
173 | (declare (indent 2)) | |
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"))) | |
07342a64 | 177 | |
fdbe82c9 | 178 | (autoload 'diary-list-entries "diary-lib") |
7ec41490 GM |
179 | ;; Autoloaded in diary-lib. |
180 | (declare-function calendar-check-holidays "holidays" (date)) | |
f7ae31df | 181 | |
e9f8d300 | 182 | (defun calendar-mouse-view-diary-entries (&optional date diary event) |
f9df0ca0 | 183 | "Pop up menu of diary entries for mouse-selected date. |
5bbcf603 | 184 | Use optional DATE and alternative file DIARY. EVENT is the event |
e803eab7 | 185 | that invoked this command. Shows holidays if `diary-show-holidays-flag' |
5bbcf603 | 186 | is non-nil." |
e9f8d300 | 187 | (interactive "i\ni\ne") |
df59aa7b | 188 | (let* ((date (or date (calendar-cursor-to-date nil event))) |
f328a783 | 189 | (diary-file (or diary diary-file)) |
f9df0ca0 | 190 | (diary-list-include-blanks nil) |
df59aa7b GM |
191 | (diary-entries (mapcar (lambda (x) (split-string (cadr x) "\n")) |
192 | (diary-list-entries date 1 'list-only))) | |
e803eab7 | 193 | (holidays (if diary-show-holidays-flag |
175ede29 | 194 | (calendar-check-holidays date))) |
df59aa7b GM |
195 | (title (format "Diary entries%s for %s" |
196 | (if diary (format " from %s" diary) "") | |
f9df0ca0 | 197 | (calendar-date-string date))) |
df59aa7b GM |
198 | (selection (cal-menu-x-popup-menu event title |
199 | (mapcar (lambda (x) (list (concat " " x))) holidays) | |
200 | (if holidays | |
201 | (list "--shadow-etched-in" "--shadow-etched-in")) | |
202 | (if diary-entries | |
203 | (mapcar 'list (apply 'append diary-entries)) | |
204 | '("None"))))) | |
6c8a48a6 | 205 | (and selection (call-interactively selection)))) |
aef1a243 | 206 | |
df59aa7b | 207 | (defun calendar-mouse-view-other-diary-entries (&optional event) |
6c8a48a6 | 208 | "Pop up menu of diary entries from alternative file on mouse-selected date." |
df59aa7b | 209 | (interactive "e") |
f9df0ca0 | 210 | (calendar-mouse-view-diary-entries |
df59aa7b GM |
211 | (calendar-cursor-to-date nil event) |
212 | (read-file-name "Enter diary file name: " default-directory nil t) | |
213 | event)) | |
e519449d | 214 | |
a71b84cd GM |
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) | |
5bbcf603 GM |
219 | (defun cal-menu-set-date-title (menu) |
220 | "Convert date of last event to title suitable for MENU." | |
a71b84cd GM |
221 | (let ((date (ignore-errors (calendar-cursor-to-date nil last-input-event)))) |
222 | (if date | |
223 | (easy-menu-filter-return menu (calendar-date-string date t nil)) | |
224 | (message "Not on a date!") | |
225 | nil))) | |
5bbcf603 | 226 | |
05efa389 | 227 | (easy-menu-define cal-menu-context-mouse-menu nil |
a71b84cd GM |
228 | "Pop up mouse menu for selected date in the calendar window." |
229 | '("cal-menu-context-mouse-menu" :filter cal-menu-set-date-title | |
05efa389 | 230 | "--" |
cb906937 | 231 | ["Holidays" calendar-cursor-holidays] |
10979c74 SM |
232 | ["Mark date" calendar-set-mark] |
233 | ["Sunrise/sunset" calendar-sunrise-sunset] | |
0fa9d7e2 | 234 | ["Other calendars" calendar-print-other-dates] |
a71b84cd GM |
235 | ;; There was a bug (#447; fixed) with last-nonmenu-event and submenus. |
236 | ;; These did not work if called without calendar window selected. | |
05efa389 | 237 | ("Prepare LaTeX buffer" |
df59aa7b GM |
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] | |
05efa389 | 247 | ("Filofax styles" |
df59aa7b GM |
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]) | |
8da2243f | 255 | ["Diary entries" calendar-mouse-view-diary-entries :keys "d"] |
10979c74 | 256 | ["Insert diary entry" diary-insert-entry] |
8da2243f GM |
257 | ["Other diary file entries" calendar-mouse-view-other-diary-entries |
258 | :keys "D"])) | |
05efa389 | 259 | |
05efa389 SM |
260 | (easy-menu-define cal-menu-global-mouse-menu nil |
261 | "Menu bound to a mouse event, not specific to the mouse-click location." | |
262 | '("Calendar" | |
cca1dde0 SM |
263 | ["Scroll forward" calendar-scroll-left-three-months] |
264 | ["Scroll backward" calendar-scroll-right-three-months] | |
9ee4e581 | 265 | ["Mark diary entries" diary-mark-entries] |
175ede29 GM |
266 | ["List holidays" calendar-list-holidays] |
267 | ["Mark holidays" calendar-mark-holidays] | |
05efa389 | 268 | ["Unmark" calendar-unmark] |
d88acfe1 | 269 | ["Lunar phases" calendar-lunar-phases] |
70e420e3 | 270 | ["Sunrise times for month" calendar-sunrise-sunset-month] |
05efa389 | 271 | ["Show diary" diary-show-all-entries] |
0e408f0c | 272 | ["Exit calendar" calendar-exit])) |
aef1a243 | 273 | |
f328a783 GM |
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") | |
279 | ||
aef1a243 RS |
280 | (run-hooks 'cal-menu-load-hook) |
281 | ||
282 | (provide 'cal-menu) | |
283 | ||
e9f8d300 | 284 | ;; arch-tag: aa81cf73-ce89-48a4-97ec-9ef861e87fe9 |
aef1a243 | 285 | ;;; cal-menu.el ends here |