comparison lisp/calendar/calendar.el @ 92858:7096add7a945

Whitespace only.

92857:ab9ec247b4ff

    (monthname " *" day ", *" year "[^0-9]")
    (dayname "\\W"))
  "List of pseudo-patterns describing the American patterns of date used.
See the documentation of `diary-date-forms' for an explanation."
  :type '(repeat (choice (cons :tag "Backup"
			       :value (backup . nil)
			       (const backup)
			       (repeat (list :inline t :format "%v"
					     (symbol :tag "Keyword")
					     (choice symbol regexp))))
			 (repeat (list :inline t :format "%v"
				       (symbol :tag "Keyword")
				       (choice symbol regexp)))))
  :group 'diary)

(defcustom european-date-diary-pattern
  '((day "/" month "[^/0-9]")
    (day "/" month "/" year "[^0-9]")

    (day " *" monthname " *" year "[^0-9]")
    (dayname "\\W"))
  "List of pseudo-patterns describing the European patterns of date used.
See the documentation of `diary-date-forms' for an explanation."
  :type '(repeat (choice (cons :tag "Backup"
			       :value (backup . nil)
			       (const backup)
			       (repeat (list :inline t :format "%v"
					     (symbol :tag "Keyword")
					     (choice symbol regexp))))
			 (repeat (list :inline t :format "%v"
				       (symbol :tag "Keyword")
				       (choice symbol regexp)))))
  :group 'diary)

(defvar diary-font-lock-keywords)

(defcustom diary-date-forms

diary entry itself, the first element of the pattern MUST be `backup'.  This
directive causes the date recognizer to back up to the beginning of the
current word of the diary entry, so in no case can the pattern match more than
a portion of the first word of the diary entry."
  :type '(repeat (choice (cons :tag "Backup"
			       :value (backup . nil)
			       (const backup)
			       (repeat (list :inline t :format "%v"
					     (symbol :tag "Keyword")
					     (choice symbol regexp))))
			 (repeat (list :inline t :format "%v"
				       (symbol :tag "Keyword")
				       (choice symbol regexp)))))
  :initialize 'custom-initialize-default
  :set (lambda (symbol value)
         (unless (equal value (eval symbol))
           (custom-set-default symbol value)
           (setq diary-font-lock-keywords (diary-font-lock-keywords))

(put 'general-holidays 'risky-local-variable t)

;;;###autoload
(defcustom oriental-holidays
  '((if (fboundp 'atan)
	(holiday-chinese-new-year)))
  "Oriental holidays.
See the documentation for `calendar-holidays' for details."
  :type 'sexp
  :group 'holidays)
;;;###autoload

  '((holiday-fixed
     3 21
     (format "Baha'i New Year (Naw-Ruz) %d" (- displayed-year (1- 1844))))
    (holiday-fixed  4 21 "First Day of Ridvan")
    (if all-bahai-calendar-holidays
	(holiday-fixed  4 22 "Second Day of Ridvan"))
    (if all-bahai-calendar-holidays
	(holiday-fixed  4 23 "Third Day of Ridvan"))
    (if all-bahai-calendar-holidays
	(holiday-fixed  4 24 "Fourth Day of Ridvan"))
    (if all-bahai-calendar-holidays
	(holiday-fixed  4 25 "Fifth Day of Ridvan"))
    (if all-bahai-calendar-holidays
	(holiday-fixed  4 26 "Sixth Day of Ridvan"))
    (if all-bahai-calendar-holidays
	(holiday-fixed  4 27 "Seventh Day of Ridvan"))
    (if all-bahai-calendar-holidays
	(holiday-fixed  4 28 "Eighth Day of Ridvan"))
    (holiday-fixed  4 29 "Ninth Day of Ridvan")
    (if all-bahai-calendar-holidays
	(holiday-fixed  4 30 "Tenth Day of Ridvan"))
    (if all-bahai-calendar-holidays
	(holiday-fixed  5  1 "Eleventh Day of Ridvan"))
    (holiday-fixed  5  2 "Twelfth Day of Ridvan")
    (holiday-fixed  5 23 "Declaration of the Bab")
    (holiday-fixed  5 29 "Ascension of Baha'u'llah")
    (holiday-fixed  7  9 "Martyrdom of the Bab")
    (holiday-fixed 10 20 "Birth of the Bab")
    (holiday-fixed 11 12 "Birth of Baha'u'llah")
    (if all-bahai-calendar-holidays
	(holiday-fixed 11 26 "Day of the Covenant"))
    (if all-bahai-calendar-holidays
	(holiday-fixed 11 28 "Ascension of `Abdu'l-Baha")))
  "Baha'i holidays.
See the documentation for `calendar-holidays' for details."
  :type 'sexp
  :group 'holidays)
;;;###autoload
(put 'bahai-holidays 'risky-local-variable t)

;;;###autoload
(defcustom solar-holidays
  '((if (fboundp 'atan)
	(solar-equinoxes-solstices))
    (if (require 'cal-dst)
      (funcall
       'holiday-sexp
        calendar-daylight-savings-starts
        '(format "Daylight Saving Time Begins %s"

          (set-window-vscroll nil 0)
        ;; Adjust the window to exactly fit the displayed calendar.
        (fit-window-to-buffer nil nil calendar-minimum-window-height))
      (sit-for 0))
    (if (and (boundp 'font-lock-mode)
	     font-lock-mode)
	(font-lock-fontify-buffer))
    (and mark-holidays-in-calendar
;;;         (calendar-date-is-valid-p today) ; useful for BC dates
         (calendar-mark-holidays)
         (and in-calendar-window (sit-for 0)))
    (unwind-protect

  (let* ((blank-days                    ; at start of month
          (mod
           (- (calendar-day-of-week (list month 1 year))
              calendar-week-start-day)
           7))
	 (last (calendar-last-day-of-month month year)))
   (goto-char (point-min))
   (calendar-insert-indented
    (calendar-string-spread
     (list (format "%s %d" (calendar-month-name month) year)) ?  20)
    indent t)

   (calendar-for-loop i from 1 to last do
      (insert (format "%2d " i))
      (add-text-properties
       (- (point) 3) (1- (point))
       '(mouse-face highlight
	 help-echo "mouse-2: menu of operations for this date"))
      (and (zerop (mod (+ i blank-days) 7))
           (/= i last)
           (calendar-insert-indented "" 0 t) ; force onto following line
           (calendar-insert-indented "" indent))))) ; go to proper spot

;; After calendar-mode-map.
(defcustom calendar-mode-line-format
  (list
   (propertize "<"
	       'help-echo "mouse-1: previous month"
	       'mouse-face 'mode-line-highlight
	       'keymap (make-mode-line-mouse-map 'mouse-1
						 'calendar-scroll-right))
   "Calendar"
   (concat
    (propertize
     (substitute-command-keys
      "\\<calendar-mode-map>\\[calendar-goto-info-node] info")

     (substitute-command-keys
     " \\<calendar-mode-map>\\[calendar-other-month] other")
     'help-echo "mouse-1: choose another month"
     'mouse-face 'mode-line-highlight
     'keymap (make-mode-line-mouse-map
	      'mouse-1 'mouse-calendar-other-month))
    " / "
    (propertize
     (substitute-command-keys
     "\\<calendar-mode-map>\\[calendar-goto-today] today")
     'help-echo "mouse-1: go to today's date"
     'mouse-face 'mode-line-highlight
     'keymap (make-mode-line-mouse-map 'mouse-1 #'calendar-goto-today)))
   '(calendar-date-string (calendar-current-date) t)
   (propertize ">"
	       'help-echo "mouse-1: next month"
	       'mouse-face 'mode-line-highlight
	       'keymap (make-mode-line-mouse-map
			'mouse-1 'calendar-scroll-left)))
  "The mode line of the calendar buffer.

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'

(defun calendar-window-list ()
  "List of all calendar-related windows."
  (let ((calendar-buffers (calendar-buffer-list))
        list)
    (walk-windows (lambda (w)
		    (if (memq (window-buffer w) calendar-buffers)
			(push w list)))
                  nil t)
    list))

(defun calendar-buffer-list ()
  "List of all calendar-related buffers."

        (if (eq noday t)
            (list month nil year)
          (list month year))
      (list month
            (calendar-read (format "Day (1-%d): " last)
			   (lambda (x) (and (< 0 x) (<= x last))))
            year))))

(defun calendar-interval (mon1 yr1 mon2 yr2)
  "The number of months difference between MON1, YR1 and MON2, YR2.
The result is positive if the second date is later than the first.

            array (append array (list elem))))
    (vconcat array)))

(defvar calendar-font-lock-keywords
  `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
	      " -?[0-9]+")
     . font-lock-function-name-face) ; month and year
    (,(regexp-opt
       (list (substring (aref calendar-day-name-array 6) 0 2)
	     (substring (aref calendar-day-name-array 0) 0 2)))
     ;; Saturdays and Sundays are highlighted differently.
     . font-lock-comment-face)
    ;; First two chars of each day are used in the calendar.
    (,(regexp-opt (mapcar (lambda (x) (substring x 0 2))
                          calendar-day-name-array))

If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).

If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
  (if (> n 0)
      (+ (* 7 (1- n))
	 (calendar-dayname-on-or-before
	  dayname
	  (+ 6 (calendar-absolute-from-gregorian
		(list month (or day 1) year)))))
    (+ (* 7 (1+ n))
       (calendar-dayname-on-or-before
	dayname
	(calendar-absolute-from-gregorian
	 (list month
	       (or day (calendar-last-day-of-month month year))
	       year))))))

(defun calendar-nth-named-day (n dayname month year &optional day)
  "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
A DAYNAME of 0 means Sunday, 1 means Monday, and so on.  If N<0,
return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).

92858:7096add7a945

    (monthname " *" day ", *" year "[^0-9]")
    (dayname "\\W"))
  "List of pseudo-patterns describing the American patterns of date used.
See the documentation of `diary-date-forms' for an explanation."
  :type '(repeat (choice (cons :tag "Backup"
                               :value (backup . nil)
                               (const backup)
                               (repeat (list :inline t :format "%v"
                                             (symbol :tag "Keyword")
                                             (choice symbol regexp))))
                         (repeat (list :inline t :format "%v"
                                       (symbol :tag "Keyword")
                                       (choice symbol regexp)))))
  :group 'diary)

(defcustom european-date-diary-pattern
  '((day "/" month "[^/0-9]")
    (day "/" month "/" year "[^0-9]")

    (day " *" monthname " *" year "[^0-9]")
    (dayname "\\W"))
  "List of pseudo-patterns describing the European patterns of date used.
See the documentation of `diary-date-forms' for an explanation."
  :type '(repeat (choice (cons :tag "Backup"
                               :value (backup . nil)
                               (const backup)
                               (repeat (list :inline t :format "%v"
                                             (symbol :tag "Keyword")
                                             (choice symbol regexp))))
                         (repeat (list :inline t :format "%v"
                                       (symbol :tag "Keyword")
                                       (choice symbol regexp)))))
  :group 'diary)

(defvar diary-font-lock-keywords)

(defcustom diary-date-forms

diary entry itself, the first element of the pattern MUST be `backup'.  This
directive causes the date recognizer to back up to the beginning of the
current word of the diary entry, so in no case can the pattern match more than
a portion of the first word of the diary entry."
  :type '(repeat (choice (cons :tag "Backup"
                               :value (backup . nil)
                               (const backup)
                               (repeat (list :inline t :format "%v"
                                             (symbol :tag "Keyword")
                                             (choice symbol regexp))))
                         (repeat (list :inline t :format "%v"
                                       (symbol :tag "Keyword")
                                       (choice symbol regexp)))))
  :initialize 'custom-initialize-default
  :set (lambda (symbol value)
         (unless (equal value (eval symbol))
           (custom-set-default symbol value)
           (setq diary-font-lock-keywords (diary-font-lock-keywords))

(put 'general-holidays 'risky-local-variable t)

;;;###autoload
(defcustom oriental-holidays
  '((if (fboundp 'atan)
        (holiday-chinese-new-year)))
  "Oriental holidays.
See the documentation for `calendar-holidays' for details."
  :type 'sexp
  :group 'holidays)
;;;###autoload

  '((holiday-fixed
     3 21
     (format "Baha'i New Year (Naw-Ruz) %d" (- displayed-year (1- 1844))))
    (holiday-fixed  4 21 "First Day of Ridvan")
    (if all-bahai-calendar-holidays
        (holiday-fixed  4 22 "Second Day of Ridvan"))
    (if all-bahai-calendar-holidays
        (holiday-fixed  4 23 "Third Day of Ridvan"))
    (if all-bahai-calendar-holidays
        (holiday-fixed  4 24 "Fourth Day of Ridvan"))
    (if all-bahai-calendar-holidays
        (holiday-fixed  4 25 "Fifth Day of Ridvan"))
    (if all-bahai-calendar-holidays
        (holiday-fixed  4 26 "Sixth Day of Ridvan"))
    (if all-bahai-calendar-holidays
        (holiday-fixed  4 27 "Seventh Day of Ridvan"))
    (if all-bahai-calendar-holidays
        (holiday-fixed  4 28 "Eighth Day of Ridvan"))
    (holiday-fixed  4 29 "Ninth Day of Ridvan")
    (if all-bahai-calendar-holidays
        (holiday-fixed  4 30 "Tenth Day of Ridvan"))
    (if all-bahai-calendar-holidays
        (holiday-fixed  5  1 "Eleventh Day of Ridvan"))
    (holiday-fixed  5  2 "Twelfth Day of Ridvan")
    (holiday-fixed  5 23 "Declaration of the Bab")
    (holiday-fixed  5 29 "Ascension of Baha'u'llah")
    (holiday-fixed  7  9 "Martyrdom of the Bab")
    (holiday-fixed 10 20 "Birth of the Bab")
    (holiday-fixed 11 12 "Birth of Baha'u'llah")
    (if all-bahai-calendar-holidays
        (holiday-fixed 11 26 "Day of the Covenant"))
    (if all-bahai-calendar-holidays
        (holiday-fixed 11 28 "Ascension of `Abdu'l-Baha")))
  "Baha'i holidays.
See the documentation for `calendar-holidays' for details."
  :type 'sexp
  :group 'holidays)
;;;###autoload
(put 'bahai-holidays 'risky-local-variable t)

;;;###autoload
(defcustom solar-holidays
  '((if (fboundp 'atan)
        (solar-equinoxes-solstices))
    (if (require 'cal-dst)
      (funcall
       'holiday-sexp
        calendar-daylight-savings-starts
        '(format "Daylight Saving Time Begins %s"

          (set-window-vscroll nil 0)
        ;; Adjust the window to exactly fit the displayed calendar.
        (fit-window-to-buffer nil nil calendar-minimum-window-height))
      (sit-for 0))
    (if (and (boundp 'font-lock-mode)
             font-lock-mode)
        (font-lock-fontify-buffer))
    (and mark-holidays-in-calendar
;;;         (calendar-date-is-valid-p today) ; useful for BC dates
         (calendar-mark-holidays)
         (and in-calendar-window (sit-for 0)))
    (unwind-protect

  (let* ((blank-days                    ; at start of month
          (mod
           (- (calendar-day-of-week (list month 1 year))
              calendar-week-start-day)
           7))
         (last (calendar-last-day-of-month month year)))
   (goto-char (point-min))
   (calendar-insert-indented
    (calendar-string-spread
     (list (format "%s %d" (calendar-month-name month) year)) ?  20)
    indent t)

   (calendar-for-loop i from 1 to last do
      (insert (format "%2d " i))
      (add-text-properties
       (- (point) 3) (1- (point))
       '(mouse-face highlight
         help-echo "mouse-2: menu of operations for this date"))
      (and (zerop (mod (+ i blank-days) 7))
           (/= i last)
           (calendar-insert-indented "" 0 t) ; force onto following line
           (calendar-insert-indented "" indent))))) ; go to proper spot

;; After calendar-mode-map.
(defcustom calendar-mode-line-format
  (list
   (propertize "<"
               'help-echo "mouse-1: previous month"
               'mouse-face 'mode-line-highlight
               'keymap (make-mode-line-mouse-map 'mouse-1
                                                 'calendar-scroll-right))
   "Calendar"
   (concat
    (propertize
     (substitute-command-keys
      "\\<calendar-mode-map>\\[calendar-goto-info-node] info")

     (substitute-command-keys
     " \\<calendar-mode-map>\\[calendar-other-month] other")
     'help-echo "mouse-1: choose another month"
     'mouse-face 'mode-line-highlight
     'keymap (make-mode-line-mouse-map
              'mouse-1 'mouse-calendar-other-month))
    " / "
    (propertize
     (substitute-command-keys
     "\\<calendar-mode-map>\\[calendar-goto-today] today")
     'help-echo "mouse-1: go to today's date"
     'mouse-face 'mode-line-highlight
     'keymap (make-mode-line-mouse-map 'mouse-1 #'calendar-goto-today)))
   '(calendar-date-string (calendar-current-date) t)
   (propertize ">"
               'help-echo "mouse-1: next month"
               'mouse-face 'mode-line-highlight
               'keymap (make-mode-line-mouse-map
                        'mouse-1 'calendar-scroll-left)))
  "The mode line of the calendar buffer.

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'

(defun calendar-window-list ()
  "List of all calendar-related windows."
  (let ((calendar-buffers (calendar-buffer-list))
        list)
    (walk-windows (lambda (w)
                    (if (memq (window-buffer w) calendar-buffers)
                        (push w list)))
                  nil t)
    list))

(defun calendar-buffer-list ()
  "List of all calendar-related buffers."

        (if (eq noday t)
            (list month nil year)
          (list month year))
      (list month
            (calendar-read (format "Day (1-%d): " last)
                           (lambda (x) (and (< 0 x) (<= x last))))
            year))))

(defun calendar-interval (mon1 yr1 mon2 yr2)
  "The number of months difference between MON1, YR1 and MON2, YR2.
The result is positive if the second date is later than the first.

            array (append array (list elem))))
    (vconcat array)))

(defvar calendar-font-lock-keywords
  `((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t)
              " -?[0-9]+")
     . font-lock-function-name-face) ; month and year
    (,(regexp-opt
       (list (substring (aref calendar-day-name-array 6) 0 2)
             (substring (aref calendar-day-name-array 0) 0 2)))
     ;; Saturdays and Sundays are highlighted differently.
     . font-lock-comment-face)
    ;; First two chars of each day are used in the calendar.
    (,(regexp-opt (mapcar (lambda (x) (substring x 0 2))
                          calendar-day-name-array))

If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).

If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
  (if (> n 0)
      (+ (* 7 (1- n))
         (calendar-dayname-on-or-before
          dayname
          (+ 6 (calendar-absolute-from-gregorian
                (list month (or day 1) year)))))
    (+ (* 7 (1+ n))
       (calendar-dayname-on-or-before
        dayname
        (calendar-absolute-from-gregorian
         (list month
               (or day (calendar-last-day-of-month month year))
               year))))))

(defun calendar-nth-named-day (n dayname month year &optional day)
  "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
A DAYNAME of 0 means Sunday, 1 means Monday, and so on.  If N<0,
return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).