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 ;; 2008 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 of the License, or
17 ;; (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>.
35 (defconst cal-menu-moon-menu
37 ["Lunar Phases" calendar-phases-of-moon
]))
39 (defconst cal-menu-diary-menu
41 ["Other File" diary-view-other-diary-entries
]
42 ["Cursor Date" diary-view-entries
]
43 ["Mark All" diary-mark-entries
]
44 ["Show All" diary-show-all-entries
]
45 ["Insert Diary Entry" diary-insert-entry
]
46 ["Insert Weekly" diary-insert-weekly-entry
]
47 ["Insert Monthly" diary-insert-monthly-entry
]
48 ["Insert Yearly" diary-insert-yearly-entry
]
49 ["Insert Anniversary" diary-insert-anniversary-entry
]
50 ["Insert Block" diary-insert-block-entry
]
51 ["Insert Cyclic" diary-insert-cyclic-entry
]
53 ["One time" diary-bahai-insert-entry
]
54 ["Monthly" diary-bahai-insert-monthly-entry
]
55 ["Yearly" diary-bahai-insert-yearly-entry
])
57 ["One time" diary-islamic-insert-entry
]
58 ["Monthly" diary-islamic-insert-monthly-entry
]
59 ["Yearly" diary-islamic-insert-yearly-entry
])
61 ["One time" diary-hebrew-insert-entry
]
62 ["Monthly" diary-hebrew-insert-monthly-entry
]
63 ["Yearly" diary-hebrew-insert-yearly-entry
])))
65 (defun cal-menu-holiday-window-suffix ()
66 "Return a string suffix for the \"Window\" entry in `cal-menu-holidays-menu'."
67 (let ((my1 (calendar-increment-month-cons -
1))
68 (my2 (calendar-increment-month-cons 1)))
69 ;; Mon1-Mon2, Year or Mon1, Year1-Mon2, Year2.
71 (calendar-month-name (car my1
) 'abbrev
)
72 (if (= (cdr my1
) (cdr my2
))
74 (format ", %d" (cdr my1
)))
75 (calendar-month-name (car my2
) 'abbrev
)
78 (defvar displayed-year
) ; from calendar-generate
80 (defconst cal-menu-holidays-menu
82 ["For Cursor Date -" calendar-cursor-holidays
83 :suffix
(calendar-date-string (calendar-cursor-to-date) t t
)
84 :visible
(calendar-cursor-to-date)]
85 ["For Window -" calendar-list-holidays
86 :suffix
(cal-menu-holiday-window-suffix)]
87 ["For Today -" (calendar-cursor-holidays (calendar-current-date))
88 :suffix
(calendar-date-string (calendar-current-date) t t
)]
91 ;; Show 11 years--5 before, 5 after year of middle month.
92 ;; We used to use :suffix rather than :label and bumped into
94 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html
95 ;; The bug has since been fixed.
97 (push (vector (format "hol-year-%d" i
)
100 (holiday-list (+ displayed-year
,(- i
5))))
101 :label
`(format "For Year %d"
102 (+ displayed-year
,(- i
5))))
106 ["Unmark Calendar" calendar-unmark
]
107 ["Mark Holidays" calendar-mark-holidays
]))
109 (defconst cal-menu-goto-menu
111 ["Today" calendar-goto-today
]
112 ["Beginning of Week" calendar-beginning-of-week
]
113 ["End of Week" calendar-end-of-week
]
114 ["Beginning of Month" calendar-beginning-of-month
]
115 ["End of Month" calendar-end-of-month
]
116 ["Beginning of Year" calendar-beginning-of-year
]
117 ["End of Year" calendar-end-of-year
]
118 ["Other Date" calendar-goto-date
]
119 ["Day of Year" calendar-goto-day-of-year
]
120 ["ISO Week" calendar-iso-goto-week
]
121 ["ISO Date" calendar-iso-goto-date
]
122 ["Astronomical Date" calendar-astro-goto-day-number
]
123 ["Hebrew Date" calendar-hebrew-goto-date
]
124 ["Persian Date" calendar-persian-goto-date
]
125 ["Baha'i Date" calendar-bahai-goto-date
]
126 ["Islamic Date" calendar-islamic-goto-date
]
127 ["Julian Date" calendar-julian-goto-date
]
128 ["Chinese Date" calendar-chinese-goto-date
]
129 ["Coptic Date" calendar-coptic-goto-date
]
130 ["Ethiopic Date" calendar-ethiopic-goto-date
]
132 ["Next Tzolkin" calendar-mayan-next-tzolkin-date
]
133 ["Previous Tzolkin" calendar-mayan-previous-tzolkin-date
]
134 ["Next Haab" calendar-mayan-next-haab-date
]
135 ["Previous Haab" calendar-mayan-previous-haab-date
]
136 ["Next Round" calendar-mayan-next-round-date
]
137 ["Previous Round" calendar-mayan-previous-round-date
])
138 ["French Date" calendar-french-goto-date
]))
140 (defconst cal-menu-scroll-menu
142 ["Forward 1 Month" calendar-scroll-left
]
143 ["Forward 3 Months" calendar-scroll-left-three-months
]
144 ["Forward 1 Year" (calendar-scroll-left 12) :keys
"4 C-v"]
145 ["Backward 1 Month" calendar-scroll-right
]
146 ["Backward 3 Months" calendar-scroll-right-three-months
]
147 ["Backward 1 Year" (calendar-scroll-right 12) :keys
"4 M-v"]))
149 (defmacro cal-menu-x-popup-menu
(event title
&rest body
)
150 "Call `x-popup-menu' at position EVENT, with TITLE and contents BODY.
151 Signals an error if popups are unavailable."
153 `(if (display-popup-menus-p)
154 (x-popup-menu ,event
(list ,title
(append (list ,title
) ,@body
)))
155 (error "Popup menus are not available on this system")))
157 (autoload 'calendar-check-holidays
"holidays")
159 (defun calendar-mouse-holidays (&optional event
)
160 "Pop up menu of holidays for mouse selected date.
161 EVENT is the event that invoked this command."
163 (let* ((date (calendar-cursor-to-date nil event
))
164 (title (format "Holidays for %s" (calendar-date-string date
)))
165 (selection (cal-menu-x-popup-menu event title
166 (or (mapcar 'list
(calendar-check-holidays date
))
168 (and selection
(call-interactively selection
))))
170 (autoload 'diary-list-entries
"diary-lib")
171 (defvar diary-show-holidays-flag
) ; only called from calendar.el
173 (defun calendar-mouse-view-diary-entries (&optional date diary event
)
174 "Pop up menu of diary entries for mouse-selected date.
175 Use optional DATE and alternative file DIARY. EVENT is the event
176 that invoked this command. Shows holidays if `diary-show-holidays-flag'
178 (interactive "i\ni\ne")
179 (let* ((date (or date
(calendar-cursor-to-date nil event
)))
180 (diary-file (or diary diary-file
))
181 (diary-list-include-blanks nil
)
182 (diary-entries (mapcar (lambda (x) (split-string (cadr x
) "\n"))
183 (diary-list-entries date
1 'list-only
)))
184 (holidays (if diary-show-holidays-flag
185 (calendar-check-holidays date
)))
186 (title (format "Diary entries%s for %s"
187 (if diary
(format " from %s" diary
) "")
188 (calendar-date-string date
)))
189 (selection (cal-menu-x-popup-menu event title
190 (mapcar (lambda (x) (list (concat " " x
))) holidays
)
192 (list "--shadow-etched-in" "--shadow-etched-in"))
194 (mapcar 'list
(apply 'append diary-entries
))
196 (and selection
(call-interactively selection
))))
198 (defun calendar-mouse-view-other-diary-entries (&optional event
)
199 "Pop up menu of diary entries from alternative file on mouse-selected date."
201 (calendar-mouse-view-diary-entries
202 (calendar-cursor-to-date nil event
)
203 (read-file-name "Enter diary file name: " default-directory nil t
)
206 (defun calendar-mouse-print-dates (&optional event
)
207 "Pop up menu of equivalent dates to mouse selected date.
208 EVENT is the event that invoked this command."
210 (let* ((date (calendar-cursor-to-date nil event
))
211 (title (format "%s (Gregorian)" (calendar-date-string date
)))
212 (selection (cal-menu-x-popup-menu event title
213 (mapcar 'list
(calendar-other-dates date
)))))
214 (and selection
(call-interactively selection
))))
216 (defun cal-menu-set-date-title (menu)
217 "Convert date of last event to title suitable for MENU."
218 (easy-menu-filter-return
219 menu
(calendar-date-string (calendar-cursor-to-date t last-input-event
)
222 (easy-menu-define cal-menu-context-mouse-menu nil
223 "Pop up menu for Mouse-2 for selected date in the calendar window."
224 '("cal-menu-mouse2" :filter cal-menu-set-date-title
226 ["Holidays" calendar-mouse-holidays
]
227 ["Mark date" calendar-set-mark
]
228 ["Sunrise/sunset" calendar-sunrise-sunset
]
229 ["Other calendars" calendar-mouse-print-dates
]
230 ;; FIXME there is a bug with last-nonmenu-event and submenus.
231 ;; These currently don't work if called without calendar window selected.
232 ("Prepare LaTeX buffer"
233 ["Daily (1 page)" cal-tex-cursor-day
]
234 ["Weekly (1 page)" cal-tex-cursor-week
]
235 ["Weekly (2 pages)" cal-tex-cursor-week2
]
236 ["Weekly (other style; 1 page)" cal-tex-cursor-week-iso
]
237 ["Weekly (yet another style; 1 page)" cal-tex-cursor-week-monday
]
238 ["Monthly" cal-tex-cursor-month
]
239 ["Monthly (landscape)" cal-tex-cursor-month-landscape
]
240 ["Yearly" cal-tex-cursor-year
]
241 ["Yearly (landscape)" cal-tex-cursor-year-landscape
]
243 ["Filofax Daily (one-day-per-page)" cal-tex-cursor-filofax-daily
]
244 ["Filofax Weekly (2-weeks-at-a-glance)" cal-tex-cursor-filofax-2week
]
245 ["Filofax Weekly (week-at-a-glance)" cal-tex-cursor-filofax-week
]
246 ["Filofax Yearly" cal-tex-cursor-filofax-year
]))
247 ("Write HTML calendar"
248 ["For selected month" cal-html-cursor-month
]
249 ["For selected year" cal-html-cursor-year
])
250 ["Diary entries" calendar-mouse-view-diary-entries
]
251 ["Insert diary entry" diary-insert-entry
]
252 ["Other diary file entries" calendar-mouse-view-other-diary-entries
]))
254 (easy-menu-define cal-menu-global-mouse-menu nil
255 "Menu bound to a mouse event, not specific to the mouse-click location."
257 ["Scroll forward" calendar-scroll-left-three-months
]
258 ["Scroll backward" calendar-scroll-right-three-months
]
259 ["Mark diary entries" diary-mark-entries
]
260 ["List holidays" calendar-list-holidays
]
261 ["Mark holidays" calendar-mark-holidays
]
262 ["Unmark" calendar-unmark
]
263 ["Lunar phases" calendar-phases-of-moon
]
264 ["Show diary" diary-show-all-entries
]
265 ["Exit calendar" calendar-exit
]))
267 ;; Undocumented and probably useless.
268 (defvar cal-menu-load-hook nil
269 "Hook run on loading of the `cal-menu' package.")
270 (make-obsolete-variable 'cal-menu-load-hook
271 "it will be removed in future." "23.1")
273 (run-hooks 'cal-menu-load-hook
)
277 ;; arch-tag: aa81cf73-ce89-48a4-97ec-9ef861e87fe9
278 ;;; cal-menu.el ends here