-(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-week3 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-week4 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-week5 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-week6 '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))
+ ;; Show 11 years--5 before, 5 after year of middle month
+ (dotimes (i 11)
+ (let ((y (+ displayed-year -5 i)))
+ (push (vector (format "For Year %s" y)
+ (list (list 'lambda 'nil '(interactive)
+ (list 'list-holidays y y)))
+ t)
+ l)))
+ (setq l (cons ["Mark Holidays" mark-calendar-holidays t]
+ (cons ["Unmark Calendar" calendar-unmark t]
+ (cons "--" 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 ((my1 (calendar-increment-month -1))
+ (my2 (calendar-increment-month 1)))
+ (if (= (cdr my1) (cdr my2))
+ (format "%s-%s, %d"
+ (calendar-month-name (car my1) 'abbrev)
+ (calendar-month-name (car my2) 'abbrev)
+ (cdr my2))
+ (format "%s, %d-%s, %d"
+ (calendar-month-name (car my1) 'abbrev)
+ (cdr my1)
+ (calendar-month-name (car my2) 'abbrev)
+ (cdr my2))))))
+ (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))))