Mercurial > emacs

--- a/lisp/calendar/cal-menu.el	Wed Jun 18 02:55:32 2008 +0000
+++ b/lisp/calendar/cal-menu.el	Wed Jun 18 02:56:17 2008 +0000
@@ -66,16 +66,14 @@
   "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)))
-    (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)))))
+    ;; 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

@@ -86,7 +84,7 @@
      :visible (calendar-cursor-to-date)]
     ["For Window -" calendar-list-holidays
      :suffix (cal-menu-holiday-window-suffix)]
-    ["For Today -" cal-menu-today-holidays
+    ["For Today -" (calendar-cursor-holidays (calendar-current-date))
      :suffix (calendar-date-string (calendar-current-date) t t)]
     "--"
     ,@(let ((l ()))
@@ -148,48 +146,13 @@
     ["Backward 3 Months" calendar-scroll-right-three-months]
     ["Backward 1 Year" (calendar-scroll-right 12) :keys "4 M-v"]))

-(defun cal-menu-x-popup-menu (position menu)
-  "Like `x-popup-menu', but print an error message if popups are unavailable.
-POSITION and MENU are passed to `x-popup-menu'."
-  (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)
-  (holiday-list (calendar-extract-year (calendar-cursor-to-date))))
-
-(defun cal-menu-list-holidays-following-year ()
-  "Display a list of the holidays of the following year."
-  (interactive)
-  (holiday-list (1+ (calendar-extract-year (calendar-cursor-to-date)))))
-
-(defun cal-menu-list-holidays-previous-year ()
-  "Display a list of the holidays of the previous year."
-  (interactive)
-  (holiday-list (1- (calendar-extract-year (calendar-cursor-to-date)))))
-
-(defun cal-menu-event-to-date (&optional error)
-  "Date of last event.
-If event is not on a specific date, signals an error if optional parameter
-ERROR is non-nil, otherwise just returns nil."
-  (with-current-buffer
-      (window-buffer (posn-window (event-start last-input-event)))
-    (goto-char (posn-point (event-start last-input-event)))
-    (calendar-cursor-to-date error)))
-
-(defun calendar-mouse-goto-date (date)
-  "Go to DATE in the buffer specified by `last-input-event'."
-  (set-buffer (window-buffer (posn-window (event-start last-input-event))))
-  (calendar-goto-date date))
-
-(defun cal-menu-today-holidays ()
-  "Show holidays for today's date."
-  (interactive)
-  (save-excursion
-    (calendar-cursor-to-date (calendar-current-date))
-    (calendar-cursor-holidays)))
+(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 'calendar-check-holidays "holidays")

@@ -197,15 +160,11 @@
   "Pop up menu of holidays for mouse selected date.
 EVENT is the event that invoked this command."
   (interactive "e")
-  (let* ((date (cal-menu-event-to-date))
+  (let* ((date (calendar-cursor-to-date nil event))
          (title (format "Holidays for %s" (calendar-date-string date)))
-         (selection
-          (cal-menu-x-popup-menu
-           event
-           (list title
-                 (append (list title)
-                         (or (mapcar 'list (calendar-check-holidays date))
-                             '("None")))))))
+         (selection (cal-menu-x-popup-menu event title
+                      (or (mapcar 'list (calendar-check-holidays date))
+                          '("None")))))
     (and selection (call-interactively selection))))

 (autoload 'diary-list-entries "diary-lib")
@@ -217,153 +176,48 @@
 that invoked this command.  Shows holidays if `diary-show-holidays-flag'
 is non-nil."
   (interactive "i\ni\ne")
-  (let* ((date (or date (cal-menu-event-to-date)))
+  (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)))
+         (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 (concat "Diary entries "
-                        (if diary (format "from %s " diary) "")
-                        "for "
+         (title (format "Diary entries%s for %s"
+                        (if diary (format " from %s" diary) "")
                         (calendar-date-string date)))
-         (selection
-          (cal-menu-x-popup-menu
-           event
-           (list title
-                 (append
-                  (list 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")))))))
+         (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 ()
+(defun calendar-mouse-view-other-diary-entries (&optional event)
   "Pop up menu of diary entries from alternative file on mouse-selected date."
-  (interactive)
+  (interactive "e")
   (calendar-mouse-view-diary-entries
-   (cal-menu-event-to-date)
-   (read-file-name "Enter diary file name: " default-directory nil t)))
-
-(defun calendar-mouse-tex-day ()
-  "Make a buffer with LaTeX commands for the day mouse is on."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-day nil)))
-
-(defun calendar-mouse-tex-week ()
-  "One page calendar for week indicated by cursor.
-Holidays are included if `cal-tex-holidays' is non-nil."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-week nil)))
-
-(defun calendar-mouse-tex-week2 ()
-  "Make a buffer with LaTeX commands for the week cursor is on.
-The printed output will be on two pages."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-week2 nil)))
-
-(defun calendar-mouse-tex-week-iso ()
-  "One page calendar for week indicated by cursor.
-Holidays are included if `cal-tex-holidays' is non-nil."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-week-iso nil)))
-
-(defun calendar-mouse-tex-week-monday ()
-  "One page calendar for week indicated by cursor."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-week-monday nil)))
-
-(defun calendar-mouse-tex-filofax-daily ()
-  "Day-per-page Filofax calendar for week indicated by cursor."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-filofax-daily nil)))
-
-(defun calendar-mouse-tex-filofax-2week ()
-  "One page Filofax calendar for week indicated by cursor."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-filofax-2week nil)))
-
-(defun calendar-mouse-tex-filofax-week ()
-  "Two page Filofax calendar for week indicated by cursor."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-filofax-week nil)))
-
-(defun calendar-mouse-tex-month ()
-  "Make a buffer with LaTeX commands for the month cursor is on.
-Calendar is condensed onto one page."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-month nil)))
-
-(defun calendar-mouse-tex-month-landscape ()
-  "Make a buffer with LaTeX commands for the month cursor is on.
-The output is in landscape format, one month to a page."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-month-landscape nil)))
-
-(defun calendar-mouse-tex-year ()
-  "Make a buffer with LaTeX commands for the year cursor is on."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-year nil)))
-
-(defun calendar-mouse-tex-filofax-year ()
-  "Make a buffer with LaTeX commands for Filofax calendar of year cursor is on."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-filofax-year nil)))
-
-(defun calendar-mouse-tex-year-landscape ()
-  "Make a buffer with LaTeX commands for the year cursor is on."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (cal-menu-event-to-date))
-    (cal-tex-cursor-year-landscape nil)))
+   (calendar-cursor-to-date nil event)
+   (read-file-name "Enter diary file name: " default-directory nil t)
+   event))

 (defun calendar-mouse-print-dates (&optional event)
   "Pop up menu of equivalent dates to mouse selected date.
 EVENT is the event that invoked this command."
   (interactive "e")
-  (let* ((date (cal-menu-event-to-date))
+  (let* ((date (calendar-cursor-to-date nil event))
          (title (format "%s (Gregorian)" (calendar-date-string date)))
-         (selection
-          (cal-menu-x-popup-menu
-           event
-           (list title
-                 (append (list title)
-                         (mapcar 'list (calendar-other-dates date)))))))
+         (selection (cal-menu-x-popup-menu event title
+                      (mapcar 'list (calendar-other-dates date)))))
     (and selection (call-interactively selection))))

 (defun cal-menu-set-date-title (menu)
   "Convert date of last event to title suitable for MENU."
   (easy-menu-filter-return
-   menu (calendar-date-string (cal-menu-event-to-date t) t nil)))
+   menu (calendar-date-string (calendar-cursor-to-date t last-input-event)
+                              t nil)))

 (easy-menu-define cal-menu-context-mouse-menu nil
   "Pop up menu for Mouse-2 for selected date in the calendar window."
@@ -373,21 +227,26 @@
     ["Mark date" calendar-set-mark]
     ["Sunrise/sunset" calendar-sunrise-sunset]
     ["Other calendars" calendar-mouse-print-dates]
+    ;; FIXME there is a bug with last-nonmenu-event and submenus.
+    ;; These currently don't work if called without calendar window selected.
     ("Prepare LaTeX buffer"
-     ["Daily (1 page)" calendar-mouse-tex-day]
-     ["Weekly (1 page)" calendar-mouse-tex-week]
-     ["Weekly (2 pages)" calendar-mouse-tex-week2]
-     ["Weekly (other style; 1 page)" calendar-mouse-tex-week-iso]
-     ["Weekly (yet another style; 1 page)" calendar-mouse-tex-week-monday]
-     ["Monthly" calendar-mouse-tex-month]
-     ["Monthly (landscape)" calendar-mouse-tex-month-landscape]
-     ["Yearly" calendar-mouse-tex-year]
-     ["Yearly (landscape)" calendar-mouse-tex-year-landscape]
+     ["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)" calendar-mouse-tex-filofax-daily]
-      ["Filofax Weekly (2-weeks-at-a-glance)" calendar-mouse-tex-filofax-2week]
-      ["Filofax Weekly (week-at-a-glance)" calendar-mouse-tex-filofax-week]
-      ["Filofax Yearly" calendar-mouse-tex-filofax-year]))
+      ["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]
     ["Insert diary entry" diary-insert-entry]
     ["Other diary file entries" calendar-mouse-view-other-diary-entries]))