Commit | Line | Data |
---|---|---|
aef1a243 RS |
1 | ;;; cal-menu.el --- calendar functions for menu bar and popup menu support |
2 | ||
acaf905b | 3 | ;; Copyright (C) 1994-1995, 2001-2012 Free Software Foundation, Inc. |
aef1a243 RS |
4 | |
5 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | |
71ea27ee | 6 | ;; Lara Rios <lrios@coewl.cen.uiuc.edu> |
aff88519 | 7 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
aef1a243 RS |
8 | ;; Keywords: calendar |
9 | ;; Human-Keywords: calendar, popup menus, menu bar | |
bd78fa1d | 10 | ;; Package: calendar |
aef1a243 RS |
11 | |
12 | ;; This file is part of GNU Emacs. | |
13 | ||
2ed66575 | 14 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
59243403 | 15 | ;; it under the terms of the GNU General Public License as published by |
2ed66575 GM |
16 | ;; the Free Software Foundation, either version 3 of the License, or |
17 | ;; (at your option) any later version. | |
59243403 | 18 | |
aef1a243 | 19 | ;; GNU Emacs is distributed in the hope that it will be useful, |
59243403 RS |
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. | |
23 | ||
24 | ;; You should have received a copy of the GNU General Public License | |
2ed66575 | 25 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
aef1a243 RS |
26 | |
27 | ;;; Commentary: | |
28 | ||
714b5034 | 29 | ;; See calendar.el. |
aef1a243 | 30 | |
aef1a243 RS |
31 | ;;; Code: |
32 | ||
7ff651d0 | 33 | (require 'calendar) |
f086f609 | 34 | |
70e420e3 GM |
35 | (defconst cal-menu-sunmoon-menu |
36 | '("Sun/Moon" | |
d88acfe1 | 37 | ["Lunar Phases" calendar-lunar-phases] |
70e420e3 GM |
38 | ["Sunrise/sunset for cursor date" calendar-sunrise-sunset] |
39 | ["Sunrise/sunset for cursor month" calendar-sunrise-sunset-month]) | |
40 | "Key map for \"Sun/Moon\" menu in the calendar.") | |
05efa389 SM |
41 | |
42 | (defconst cal-menu-diary-menu | |
43 | '("Diary" | |
9ee4e581 | 44 | ["Other File" diary-view-other-diary-entries] |
05efa389 | 45 | ["Cursor Date" diary-view-entries] |
9ee4e581 | 46 | ["Mark All" diary-mark-entries] |
05efa389 | 47 | ["Show All" diary-show-all-entries] |
9ee4e581 GM |
48 | ["Insert Diary Entry" diary-insert-entry] |
49 | ["Insert Weekly" diary-insert-weekly-entry] | |
50 | ["Insert Monthly" diary-insert-monthly-entry] | |
51 | ["Insert Yearly" diary-insert-yearly-entry] | |
52 | ["Insert Anniversary" diary-insert-anniversary-entry] | |
53 | ["Insert Block" diary-insert-block-entry] | |
54 | ["Insert Cyclic" diary-insert-cyclic-entry] | |
05efa389 | 55 | ("Insert Baha'i" |
4aefe5e2 GM |
56 | ["One time" diary-bahai-insert-entry] |
57 | ["Monthly" diary-bahai-insert-monthly-entry] | |
58 | ["Yearly" diary-bahai-insert-yearly-entry]) | |
05efa389 | 59 | ("Insert Islamic" |
c2bfc7e3 GM |
60 | ["One time" diary-islamic-insert-entry] |
61 | ["Monthly" diary-islamic-insert-monthly-entry] | |
62 | ["Yearly" diary-islamic-insert-yearly-entry]) | |
05efa389 | 63 | ("Insert Hebrew" |
7e254548 | 64 | ["One time" diary-hebrew-insert-entry] |
378d6045 | 65 | ["Monthly" diary-hebrew-insert-monthly-entry] |
0fa9d7e2 GM |
66 | ["Yearly" diary-hebrew-insert-yearly-entry])) |
67 | "Key map for \"Diary\" menu in the calendar.") | |
05efa389 SM |
68 | |
69 | (defun cal-menu-holiday-window-suffix () | |
5bbcf603 | 70 | "Return a string suffix for the \"Window\" entry in `cal-menu-holidays-menu'." |
e803eab7 GM |
71 | (let ((my1 (calendar-increment-month-cons -1)) |
72 | (my2 (calendar-increment-month-cons 1))) | |
df59aa7b GM |
73 | ;; Mon1-Mon2, Year or Mon1, Year1-Mon2, Year2. |
74 | (format "%s%s-%s, %d" | |
75 | (calendar-month-name (car my1) 'abbrev) | |
76 | (if (= (cdr my1) (cdr my2)) | |
77 | "" | |
78 | (format ", %d" (cdr my1))) | |
79 | (calendar-month-name (car my2) 'abbrev) | |
80 | (cdr my2)))) | |
05efa389 | 81 | |
e803eab7 | 82 | (defvar displayed-year) ; from calendar-generate |
6cd61ebd | 83 | |
05efa389 SM |
84 | (defconst cal-menu-holidays-menu |
85 | `("Holidays" | |
86 | ["For Cursor Date -" calendar-cursor-holidays | |
87 | :suffix (calendar-date-string (calendar-cursor-to-date) t t) | |
88 | :visible (calendar-cursor-to-date)] | |
175ede29 | 89 | ["For Window -" calendar-list-holidays |
05efa389 | 90 | :suffix (cal-menu-holiday-window-suffix)] |
df59aa7b | 91 | ["For Today -" (calendar-cursor-holidays (calendar-current-date)) |
05efa389 SM |
92 | :suffix (calendar-date-string (calendar-current-date) t t)] |
93 | "--" | |
94 | ,@(let ((l ())) | |
95 | ;; Show 11 years--5 before, 5 after year of middle month. | |
29ca115f SM |
96 | ;; We used to use :suffix rather than :label and bumped into |
97 | ;; an easymenu bug: | |
60806b73 | 98 | ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html |
29ca115f | 99 | ;; The bug has since been fixed. |
05efa389 | 100 | (dotimes (i 11) |
60806b73 | 101 | (push (vector (format "hol-year-%d" i) |
771e1882 GM |
102 | `(lambda () |
103 | (interactive) | |
fdbe82c9 | 104 | (holiday-list (+ displayed-year ,(- i 5)))) |
60806b73 GM |
105 | :label `(format "For Year %d" |
106 | (+ displayed-year ,(- i 5)))) | |
771e1882 | 107 | l)) |
05efa389 SM |
108 | (nreverse l)) |
109 | "--" | |
110 | ["Unmark Calendar" calendar-unmark] | |
0fa9d7e2 GM |
111 | ["Mark Holidays" calendar-mark-holidays]) |
112 | "Key map for \"Holidays\" menu in the calendar.") | |
05efa389 SM |
113 | |
114 | (defconst cal-menu-goto-menu | |
70e420e3 | 115 | '("Goto" |
05efa389 SM |
116 | ["Today" calendar-goto-today] |
117 | ["Beginning of Week" calendar-beginning-of-week] | |
118 | ["End of Week" calendar-end-of-week] | |
119 | ["Beginning of Month" calendar-beginning-of-month] | |
120 | ["End of Month" calendar-end-of-month] | |
121 | ["Beginning of Year" calendar-beginning-of-year] | |
122 | ["End of Year" calendar-end-of-year] | |
123 | ["Other Date" calendar-goto-date] | |
124 | ["Day of Year" calendar-goto-day-of-year] | |
c2bfc7e3 GM |
125 | ["ISO Week" calendar-iso-goto-week] |
126 | ["ISO Date" calendar-iso-goto-date] | |
127 | ["Astronomical Date" calendar-astro-goto-day-number] | |
7e254548 | 128 | ["Hebrew Date" calendar-hebrew-goto-date] |
c2bfc7e3 | 129 | ["Persian Date" calendar-persian-goto-date] |
4aefe5e2 | 130 | ["Baha'i Date" calendar-bahai-goto-date] |
c2bfc7e3 GM |
131 | ["Islamic Date" calendar-islamic-goto-date] |
132 | ["Julian Date" calendar-julian-goto-date] | |
7e254548 | 133 | ["Chinese Date" calendar-chinese-goto-date] |
06bfc982 GM |
134 | ["Coptic Date" calendar-coptic-goto-date] |
135 | ["Ethiopic Date" calendar-ethiopic-goto-date] | |
05efa389 | 136 | ("Mayan Date" |
c2bfc7e3 GM |
137 | ["Next Tzolkin" calendar-mayan-next-tzolkin-date] |
138 | ["Previous Tzolkin" calendar-mayan-previous-tzolkin-date] | |
139 | ["Next Haab" calendar-mayan-next-haab-date] | |
140 | ["Previous Haab" calendar-mayan-previous-haab-date] | |
141 | ["Next Round" calendar-mayan-next-round-date] | |
142 | ["Previous Round" calendar-mayan-previous-round-date]) | |
0fa9d7e2 | 143 | ["French Date" calendar-french-goto-date]) |
70e420e3 | 144 | "Key map for \"Goto\" menu in the calendar.") |
05efa389 SM |
145 | |
146 | (defconst cal-menu-scroll-menu | |
147 | '("Scroll" | |
d8899a74 | 148 | ["Scroll Commands" nil :help "Commands that scroll the visible window"] |
cca1dde0 SM |
149 | ["Forward 1 Month" calendar-scroll-left] |
150 | ["Forward 3 Months" calendar-scroll-left-three-months] | |
378d6045 | 151 | ["Forward 1 Year" (calendar-scroll-left 12) :keys "4 C-v"] |
cca1dde0 SM |
152 | ["Backward 1 Month" calendar-scroll-right] |
153 | ["Backward 3 Months" calendar-scroll-right-three-months] | |
d8899a74 GM |
154 | ["Backward 1 Year" (calendar-scroll-right 12) :keys "4 M-v"] |
155 | "--" | |
156 | ["Motion Commands" nil :help "Commands that move point"] | |
157 | ["Forward 1 Day" calendar-forward-day] | |
158 | ["Forward 1 Week" calendar-forward-week] | |
159 | ["Forward 1 Month" calendar-forward-month] | |
160 | ["Forward 1 Year" calendar-forward-year] | |
161 | ["Backward 1 Day" calendar-backward-day] | |
162 | ["Backward 1 Week" calendar-backward-week] | |
163 | ["Backward 1 Month" calendar-backward-month] | |
164 | ["Backward 1 Year" calendar-backward-year]) | |
0fa9d7e2 | 165 | "Key map for \"Scroll\" menu in the calendar.") |
f9df0ca0 | 166 | |
e8a11b22 | 167 | (declare-function x-popup-menu "menu.c" (position menu)) |
f2d9c15f | 168 | |
df59aa7b GM |
169 | (defmacro cal-menu-x-popup-menu (event title &rest body) |
170 | "Call `x-popup-menu' at position EVENT, with TITLE and contents BODY. | |
171 | Signals an error if popups are unavailable." | |
172 | (declare (indent 2)) | |
173 | `(if (display-popup-menus-p) | |
174 | (x-popup-menu ,event (list ,title (append (list ,title) ,@body))) | |
175 | (error "Popup menus are not available on this system"))) | |
07342a64 | 176 | |
fdbe82c9 | 177 | (autoload 'diary-list-entries "diary-lib") |
7ec41490 GM |
178 | ;; Autoloaded in diary-lib. |
179 | (declare-function calendar-check-holidays "holidays" (date)) | |
f7ae31df | 180 | |
e9f8d300 | 181 | (defun calendar-mouse-view-diary-entries (&optional date diary event) |
f9df0ca0 | 182 | "Pop up menu of diary entries for mouse-selected date. |
5bbcf603 | 183 | Use optional DATE and alternative file DIARY. EVENT is the event |
e803eab7 | 184 | that invoked this command. Shows holidays if `diary-show-holidays-flag' |
5bbcf603 | 185 | is non-nil." |
e9f8d300 | 186 | (interactive "i\ni\ne") |
df59aa7b | 187 | (let* ((date (or date (calendar-cursor-to-date nil event))) |
f328a783 | 188 | (diary-file (or diary diary-file)) |
f9df0ca0 | 189 | (diary-list-include-blanks nil) |
df59aa7b GM |
190 | (diary-entries (mapcar (lambda (x) (split-string (cadr x) "\n")) |
191 | (diary-list-entries date 1 'list-only))) | |
e803eab7 | 192 | (holidays (if diary-show-holidays-flag |
175ede29 | 193 | (calendar-check-holidays date))) |
df59aa7b GM |
194 | (title (format "Diary entries%s for %s" |
195 | (if diary (format " from %s" diary) "") | |
f9df0ca0 | 196 | (calendar-date-string date))) |
df59aa7b GM |
197 | (selection (cal-menu-x-popup-menu event title |
198 | (mapcar (lambda (x) (list (concat " " x))) holidays) | |
199 | (if holidays | |
200 | (list "--shadow-etched-in" "--shadow-etched-in")) | |
201 | (if diary-entries | |
202 | (mapcar 'list (apply 'append diary-entries)) | |
203 | '("None"))))) | |
6c8a48a6 | 204 | (and selection (call-interactively selection)))) |
aef1a243 | 205 | |
df59aa7b | 206 | (defun calendar-mouse-view-other-diary-entries (&optional event) |
6c8a48a6 | 207 | "Pop up menu of diary entries from alternative file on mouse-selected date." |
df59aa7b | 208 | (interactive "e") |
f9df0ca0 | 209 | (calendar-mouse-view-diary-entries |
df59aa7b GM |
210 | (calendar-cursor-to-date nil event) |
211 | (read-file-name "Enter diary file name: " default-directory nil t) | |
212 | event)) | |
e519449d | 213 | |
a71b84cd GM |
214 | ;; In 22, the equivalent code gave an error when not called on a date, |
215 | ;; but easymenu does not seem to allow this (?). | |
216 | ;; The ignore-errors is because `documentation' can end up calling | |
217 | ;; this in a non-calendar buffer where displayed-month is unbound. (Bug#3862) | |
a769dd15 | 218 | ;; This still has issues - bug#9976, so added derived-mode-p call. |
5bbcf603 GM |
219 | (defun cal-menu-set-date-title (menu) |
220 | "Convert date of last event to title suitable for MENU." | |
a769dd15 GM |
221 | (when (derived-mode-p 'calendar-mode) |
222 | (let ((date (ignore-errors (calendar-cursor-to-date nil last-input-event)))) | |
223 | (if date | |
224 | (easy-menu-filter-return menu (calendar-date-string date t nil)) | |
225 | (message "Not on a date!") | |
226 | nil)))) | |
5bbcf603 | 227 | |
05efa389 | 228 | (easy-menu-define cal-menu-context-mouse-menu nil |
a71b84cd GM |
229 | "Pop up mouse menu for selected date in the calendar window." |
230 | '("cal-menu-context-mouse-menu" :filter cal-menu-set-date-title | |
05efa389 | 231 | "--" |
cb906937 | 232 | ["Holidays" calendar-cursor-holidays] |
10979c74 SM |
233 | ["Mark date" calendar-set-mark] |
234 | ["Sunrise/sunset" calendar-sunrise-sunset] | |
0fa9d7e2 | 235 | ["Other calendars" calendar-print-other-dates] |
a71b84cd GM |
236 | ;; There was a bug (#447; fixed) with last-nonmenu-event and submenus. |
237 | ;; These did not work if called without calendar window selected. | |
05efa389 | 238 | ("Prepare LaTeX buffer" |
df59aa7b GM |
239 | ["Daily (1 page)" cal-tex-cursor-day] |
240 | ["Weekly (1 page)" cal-tex-cursor-week] | |
241 | ["Weekly (2 pages)" cal-tex-cursor-week2] | |
242 | ["Weekly (other style; 1 page)" cal-tex-cursor-week-iso] | |
243 | ["Weekly (yet another style; 1 page)" cal-tex-cursor-week-monday] | |
244 | ["Monthly" cal-tex-cursor-month] | |
245 | ["Monthly (landscape)" cal-tex-cursor-month-landscape] | |
246 | ["Yearly" cal-tex-cursor-year] | |
247 | ["Yearly (landscape)" cal-tex-cursor-year-landscape] | |
05efa389 | 248 | ("Filofax styles" |
df59aa7b GM |
249 | ["Filofax Daily (one-day-per-page)" cal-tex-cursor-filofax-daily] |
250 | ["Filofax Weekly (2-weeks-at-a-glance)" cal-tex-cursor-filofax-2week] | |
251 | ["Filofax Weekly (week-at-a-glance)" cal-tex-cursor-filofax-week] | |
252 | ["Filofax Yearly" cal-tex-cursor-filofax-year])) | |
253 | ("Write HTML calendar" | |
254 | ["For selected month" cal-html-cursor-month] | |
255 | ["For selected year" cal-html-cursor-year]) | |
8da2243f | 256 | ["Diary entries" calendar-mouse-view-diary-entries :keys "d"] |
10979c74 | 257 | ["Insert diary entry" diary-insert-entry] |
8da2243f GM |
258 | ["Other diary file entries" calendar-mouse-view-other-diary-entries |
259 | :keys "D"])) | |
05efa389 | 260 | |
05efa389 SM |
261 | (easy-menu-define cal-menu-global-mouse-menu nil |
262 | "Menu bound to a mouse event, not specific to the mouse-click location." | |
263 | '("Calendar" | |
cca1dde0 SM |
264 | ["Scroll forward" calendar-scroll-left-three-months] |
265 | ["Scroll backward" calendar-scroll-right-three-months] | |
9ee4e581 | 266 | ["Mark diary entries" diary-mark-entries] |
175ede29 GM |
267 | ["List holidays" calendar-list-holidays] |
268 | ["Mark holidays" calendar-mark-holidays] | |
05efa389 | 269 | ["Unmark" calendar-unmark] |
d88acfe1 | 270 | ["Lunar phases" calendar-lunar-phases] |
70e420e3 | 271 | ["Sunrise times for month" calendar-sunrise-sunset-month] |
05efa389 | 272 | ["Show diary" diary-show-all-entries] |
0e408f0c | 273 | ["Exit calendar" calendar-exit])) |
aef1a243 | 274 | |
f328a783 GM |
275 | ;; Undocumented and probably useless. |
276 | (defvar cal-menu-load-hook nil | |
277 | "Hook run on loading of the `cal-menu' package.") | |
278 | (make-obsolete-variable 'cal-menu-load-hook | |
279 | "it will be removed in future." "23.1") | |
280 | ||
aef1a243 RS |
281 | (run-hooks 'cal-menu-load-hook) |
282 | ||
283 | (provide 'cal-menu) | |
284 | ||
285 | ;;; cal-menu.el ends here |