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