-(put 'calendar-forward-day 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-backward-day 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-forward-week 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-backward-week 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-forward-month 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-backward-month 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-forward-year 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-backward-year 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-beginning-of-year 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-end-of-year 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-beginning-of-month 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-end-of-month 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-end-of-week 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-beginning-of-week 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-mouse-print-dates 'menu-enable '(calendar-event-to-date))
-(put 'calendar-sunrise-sunset 'menu-enable '(calendar-event-to-date))
-(put 'calendar-cursor-holidays 'menu-enable '(calendar-cursor-to-date))
-(put 'view-diary-entries 'menu-enable '(calendar-cursor-to-date))
-(put 'view-other-diary-entries 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-mouse-insert-hebrew-diary-entry
- 'menu-enable
- '(calendar-cursor-to-date))
-(put 'calendar-mouse-insert-islamic-diary-entry
- 'menu-enable
- '(calendar-cursor-to-date))
-(put 'insert-cyclic-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'insert-block-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'insert-anniversary-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'insert-yearly-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'insert-monthly-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'insert-weekly-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-day 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-week 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-week2 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-week-iso 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-week-monday 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-filofax-2week
- 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-filofax-week 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-month 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-month-landscape 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-year 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-filofax-year 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-year-landscape 'menu-enable '(calendar-cursor-to-date))
+(defun calendar-flatten (list)
+ "Flatten LIST eliminating sublists structure; result is a list of atoms.
+This is the same as the preorder list of leaves in a rooted forest."
+ (if (atom list)
+ (list list)
+ (if (cdr list)
+ (append (calendar-flatten (car list)) (calendar-flatten (cdr list)))
+ (calendar-flatten (car list)))))
+
+(defun cal-menu-x-popup-menu (position menu)
+ "Like `x-popup-menu', but prints an error message if popup menus are
+not available."
+ (if (display-popup-menus-p)
+ (x-popup-menu position menu)
+ (error "Popup menus are not available on this system")))
+
+(defun cal-menu-list-holidays-year ()
+ "Display a list of the holidays of the selected date's year."
+ (interactive)
+ (let ((year (extract-calendar-year (calendar-cursor-to-date))))
+ (list-holidays year year)))
+
+(defun cal-menu-list-holidays-following-year ()
+ "Display a list of the holidays of the following year."
+ (interactive)
+ (let ((year (1+ (extract-calendar-year (calendar-cursor-to-date)))))
+ (list-holidays year year)))
+
+(defun cal-menu-list-holidays-previous-year ()
+ "Display a list of the holidays of the previous year."
+ (interactive)
+ (let ((year (1- (extract-calendar-year (calendar-cursor-to-date)))))
+ (list-holidays year year)))
+
+(defun cal-menu-update ()
+ ;; Update the holiday part of calendar menu bar for the current display.
+ (condition-case nil
+ (if (eq major-mode 'calendar-mode)
+ (let ((l))
+ (calendar-for-loop;; Show 11 years--5 before, 5 after year of
+ ;; middle month
+ i from (- displayed-year 5) to (+ displayed-year 5) do
+ (setq l (cons (vector (format "For Year %s" i)
+ (list (list 'lambda 'nil '(interactive)
+ (list 'list-holidays i i)))
+ t)
+ l)))
+ (setq l (cons ["Mark Holidays" mark-calendar-holidays t]
+ (cons ["Unmark Calendar" calendar-unmark t]
+ (cons ["--" '("--") t] l))))
+ (define-key calendar-mode-map [menu-bar Holidays]
+ (cons "Holidays" (easy-menu-create-menu "Holidays" (nreverse l))))
+ (define-key calendar-mode-map [menu-bar Holidays separator]
+ '("--"))
+ (define-key calendar-mode-map [menu-bar Holidays today]
+ `(,(format "For Today (%s)"
+ (calendar-date-string (calendar-current-date) t t))
+ . cal-menu-today-holidays))
+ (let ((title
+ (let ((m1 displayed-month)
+ (y1 displayed-year)
+ (m2 displayed-month)
+ (y2 displayed-year))
+ (increment-calendar-month m1 y1 -1)
+ (increment-calendar-month m2 y2 1)
+ (if (= y1 y2)
+ (format "%s-%s, %d"
+ (calendar-month-name m1 'abbrev)
+ (calendar-month-name m2 'abbrev)
+ y2)
+ (format "%s, %d-%s, %d"
+ (calendar-month-name m1 'abbrev)
+ y1
+ (calendar-month-name m2 'abbrev)
+ y2)))))
+ (define-key calendar-mode-map [menu-bar Holidays 3-month]
+ `(,(format "For Window (%s)" title)
+ . list-calendar-holidays)))
+ (let ((date (calendar-cursor-to-date)))
+ (if date
+ (define-key calendar-mode-map [menu-bar Holidays 1-day]
+ `(,(format "For Cursor Date (%s)"
+ (calendar-date-string date t t))
+ . calendar-cursor-holidays))))))
+ ;; Try to avoid entering infinite beep mode in case of errors.
+ (error (ding))))