comparison lisp/calendar/calendar.el @ 82118:baffe86b0c44

(calendar-mode-map): Move initialization into declaration. Add menu bindings (used to be done in cal-menu). (calendar-mode): Don't add an activate-menubar-hook.

82117:8410b0ff0e7a

         (month (extract-calendar-month date))
         (year (extract-calendar-year date)))
    ;; (calendar-read-date t) returns a date with day = nil, which is
    ;; not a legal date for the visible test in the diary section.
    (if arg (setcar (cdr date) 1))
    (pop-to-buffer calendar-buffer)
    (increment-calendar-month month year (- calendar-offset))
    (generate-calendar-window month year)
    (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
        (diary-view-entries)))
  (let* ((diary-buffer (get-file-buffer diary-file))
         (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
         (split-height-threshold (if diary-window 2 1000)))

          (run-hooks 'today-visible-calendar-hook)
        (run-hooks 'today-invisible-calendar-hook)))))

(defun generate-calendar (month year)
  "Generate a three-month Gregorian calendar centered around MONTH, YEAR."
;;; A negative YEAR is interpreted as BC; -1 being 1 BC, and so on.
;;; Note that while calendars for years BC could be displayed as it
;;; stands, almost all other calendar functions (eg holidays) would
;;; at best have unpredictable results for such dates.
  (if (< (+ month (* 12 (1- year))) 2)
      (error "Months before January, 1 AD cannot be displayed"))
  (setq displayed-month month
        displayed-year year)
  (erase-buffer)

(defcustom calendar-debug-sexp nil
  "Turn debugging on when evaluating a sexp in the diary or holiday list."
  :type 'boolean
  :group 'calendar)

(defvar calendar-mode-map nil)
(if calendar-mode-map
    nil
  (let ((map (make-keymap)))
    (suppress-keymap map)
    (dolist (c '(narrow-to-region mark-word mark-sexp mark-paragraph
                 mark-defun mark-whole-buffer mark-page
                 downcase-region upcase-region kill-region

    (define-key map "\ee"   'calendar-end-of-month)
    (define-key map "\e<"   'calendar-beginning-of-year)
    (define-key map "\e>"   'calendar-end-of-year)
    (define-key map "\C-@"  'calendar-set-mark)
    ;; Many people are used to typing C-SPC and getting C-@.
    (define-key map [?\C- ] 'calendar-set-mark)
    (define-key map "\C-x\C-x" 'calendar-exchange-point-and-mark)
    (define-key map "\e=" 'calendar-count-days-region)
    (define-key map "gd"  'calendar-goto-date)
    (define-key map "gD"  'calendar-goto-day-of-year)
    (define-key map "gj"  'calendar-goto-julian-date)

    (define-key map "tfw" 'cal-tex-cursor-filofax-2week)
    (define-key map "tfW" 'cal-tex-cursor-filofax-week)
    (define-key map "tfy" 'cal-tex-cursor-filofax-year)
    (define-key map "ty" 'cal-tex-cursor-year)
    (define-key map "tY" 'cal-tex-cursor-year-landscape)
    (setq calendar-mode-map map)
    ;; Require cal-menu after initializing calendar-mode-map because it uses it.
    (require 'cal-menu)))

(defun describe-calendar-mode ()
  "Create a help buffer with a brief description of the `calendar-mode'."
  (interactive)
  (help-setup-xref (list #'describe-calendar-mode) (interactive-p))

This must be a list of items that evaluate to strings--those strings are
evaluated and concatenated together, evenly separated by blanks.  The variable
`date' is available for use as the date under (or near) the cursor; `date'
defaults to the current date if it is otherwise undefined.  Here is an example
value that has the Hebrew date, the day number/days remaining in the year,
and the ISO week/year numbers in the mode.  When calendar-move-hook is set to
'update-calendar-mode-line, these mode line shows these values for the date
under the cursor:

      (list
       \"\"
       '(calendar-hebrew-date-string date)

       '(let* ((d (calendar-absolute-from-gregorian date))
               (iso-date (calendar-iso-from-absolute d)))
          (format \"ISO week %d of %d\"
            (extract-calendar-month iso-date)
            (extract-calendar-year iso-date)))
       \"\"))
")

(defun mouse-scroll-calendar-left (event)
  "Scroll the displayed calendar left by one month.
Maintains the relative position of the cursor
with respect to the calendar as well as possible."

  (setq mode-name "Calendar")
  (use-local-map calendar-mode-map)
  (setq buffer-read-only t)
  (setq indent-tabs-mode nil)
  (update-calendar-mode-line)
  (add-hook 'activate-menubar-hook 'cal-menu-update nil t)
  (make-local-variable 'calendar-mark-ring)
  (make-local-variable 'displayed-month);;  Month in middle of window.
  (make-local-variable 'displayed-year)	;;  Year in middle of window.
  (set (make-local-variable 'font-lock-defaults)
       '(calendar-font-lock-keywords t))

           (t displayed-year))))
    (if (and (looking-at "[ 0-9]?[0-9][^0-9]")
             (< 2 (count-lines (point-min) (point))))
        (save-excursion
          (if (not (looking-at " "))
                   (re-search-backward "[^0-9]"))
          (list month
                (string-to-number (buffer-substring (1+ (point)) (+ 4 (point))))
                year))
      (if (and (looking-at "\\*")
               (save-excursion

82118:baffe86b0c44

         (month (extract-calendar-month date))
         (year (extract-calendar-year date)))
    ;; (calendar-read-date t) returns a date with day = nil, which is
    ;; not a legal date for the visible test in the diary section.
    (if arg (setcar (cdr date) 1))
    (increment-calendar-month month year (- calendar-offset))
    (generate-calendar-window month year)
    ;; Display the buffer *after* generating it, so that menu entries that
    ;; use display-month do not fail when creating the new frame.
    (pop-to-buffer calendar-buffer)
    (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
        (diary-view-entries)))
  (let* ((diary-buffer (get-file-buffer diary-file))
         (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
         (split-height-threshold (if diary-window 2 1000)))

          (run-hooks 'today-visible-calendar-hook)
        (run-hooks 'today-invisible-calendar-hook)))))

(defun generate-calendar (month year)
  "Generate a three-month Gregorian calendar centered around MONTH, YEAR."
  ;; A negative YEAR is interpreted as BC; -1 being 1 BC, and so on.
  ;; Note that while calendars for years BC could be displayed as it
  ;; stands, almost all other calendar functions (eg holidays) would
  ;; at best have unpredictable results for such dates.
  (if (< (+ month (* 12 (1- year))) 2)
      (error "Months before January, 1 AD cannot be displayed"))
  (setq displayed-month month
        displayed-year year)
  (erase-buffer)

(defcustom calendar-debug-sexp nil
  "Turn debugging on when evaluating a sexp in the diary or holiday list."
  :type 'boolean
  :group 'calendar)

(require 'cal-menu)

(defvar calendar-mode-map
  (let ((map (make-keymap)))
    (suppress-keymap map)
    (dolist (c '(narrow-to-region mark-word mark-sexp mark-paragraph
                 mark-defun mark-whole-buffer mark-page
                 downcase-region upcase-region kill-region

    (define-key map "\ee"   'calendar-end-of-month)
    (define-key map "\e<"   'calendar-beginning-of-year)
    (define-key map "\e>"   'calendar-end-of-year)
    (define-key map "\C-@"  'calendar-set-mark)
    ;; Many people are used to typing C-SPC and getting C-@.
    (define-key map [?\C-\s] 'calendar-set-mark)
    (define-key map "\C-x\C-x" 'calendar-exchange-point-and-mark)
    (define-key map "\e=" 'calendar-count-days-region)
    (define-key map "gd"  'calendar-goto-date)
    (define-key map "gD"  'calendar-goto-day-of-year)
    (define-key map "gj"  'calendar-goto-julian-date)

    (define-key map "tfw" 'cal-tex-cursor-filofax-2week)
    (define-key map "tfW" 'cal-tex-cursor-filofax-week)
    (define-key map "tfy" 'cal-tex-cursor-filofax-year)
    (define-key map "ty" 'cal-tex-cursor-year)
    (define-key map "tY" 'cal-tex-cursor-year-landscape)

    (define-key map [menu-bar edit] 'undefined)
    (define-key map [menu-bar search] 'undefined)
    ;; This ignores the mouse-up event after the mouse-down that pops up the
    ;; context menu.  It should not be necessary because the mouse-up event
    ;; should be eaten up by the menu-handling toolkit.
    ;; (define-key map [mouse-2] 'ignore)

    (easy-menu-define nil map nil cal-menu-moon-menu)
    (easy-menu-define nil map nil cal-menu-diary-menu)
    (easy-menu-define nil map nil cal-menu-holidays-menu)
    (easy-menu-define nil map nil cal-menu-goto-menu)
    (easy-menu-define nil map nil cal-menu-scroll-menu)
  
    (define-key map [down-mouse-3]
      (easy-menu-binding cal-menu-context-mouse-menu))
    (define-key map [down-mouse-2]
      (easy-menu-binding cal-menu-global-mouse-menu))

    map))

(defun describe-calendar-mode ()
  "Create a help buffer with a brief description of the `calendar-mode'."
  (interactive)
  (help-setup-xref (list #'describe-calendar-mode) (interactive-p))

This must be a list of items that evaluate to strings--those strings are
evaluated and concatenated together, evenly separated by blanks.  The variable
`date' is available for use as the date under (or near) the cursor; `date'
defaults to the current date if it is otherwise undefined.  Here is an example
value that has the Hebrew date, the day number/days remaining in the year,
and the ISO week/year numbers in the mode.  When `calendar-move-hook' is set
to `update-calendar-mode-line', these mode line shows these values for the date
under the cursor:

      (list
       \"\"
       '(calendar-hebrew-date-string date)

       '(let* ((d (calendar-absolute-from-gregorian date))
               (iso-date (calendar-iso-from-absolute d)))
          (format \"ISO week %d of %d\"
            (extract-calendar-month iso-date)
            (extract-calendar-year iso-date)))
       \"\"))")

(defun mouse-scroll-calendar-left (event)
  "Scroll the displayed calendar left by one month.
Maintains the relative position of the cursor
with respect to the calendar as well as possible."

  (setq mode-name "Calendar")
  (use-local-map calendar-mode-map)
  (setq buffer-read-only t)
  (setq indent-tabs-mode nil)
  (update-calendar-mode-line)
  (make-local-variable 'calendar-mark-ring)
  (make-local-variable 'displayed-month);;  Month in middle of window.
  (make-local-variable 'displayed-year)	;;  Year in middle of window.
  (set (make-local-variable 'font-lock-defaults)
       '(calendar-font-lock-keywords t))

           (t displayed-year))))
    (if (and (looking-at "[ 0-9]?[0-9][^0-9]")
             (< 2 (count-lines (point-min) (point))))
        (save-excursion
          (if (not (looking-at " "))
              (re-search-backward "[^0-9]"))
          (list month
                (string-to-number (buffer-substring (1+ (point)) (+ 4 (point))))
                year))
      (if (and (looking-at "\\*")
               (save-excursion