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