Commit 71855cc5 authored by Glenn Morris's avatar Glenn Morris
Browse files

(displayed-month, displayed-year): Move declarations where needed.

(calendar-holiday-list, calendar-list-holidays)
(holiday-filter-visible-calendar): Move definitions before use.
(list-holidays): Use cadr.
Relocate obsolete aliases after their replacements.
parent 20a614c6
......@@ -93,6 +93,13 @@
(calendar-buffer-list): Return buffers rather than strings (fixes
previous change).
 
* calendar/holidays.el (displayed-month, displayed-year):
Move declarations where needed.
(calendar-holiday-list, calendar-list-holidays)
(holiday-filter-visible-calendar): Move definitions before use.
(list-holidays): Use cadr.
Relocate obsolete aliases after their replacements.
* textmodes/org-irc.el (top-level): CL not required when compiling.
(org-irc-visit-erc): Replace runtime CL functions.
 
......
......@@ -47,14 +47,75 @@
;;; Code:
(defvar displayed-month)
(defvar displayed-year)
(require 'calendar)
(eval-and-compile
(load "hol-loaddefs" nil 'quiet))
(defvar displayed-month) ; from generate-calendar
(defvar displayed-year)
;;;###diary-autoload
(defun calendar-holiday-list ()
"Form the list of holidays that occur on dates in the calendar window.
The holidays are those in the list `calendar-holidays'."
(let (holiday-list)
(dolist (p calendar-holidays)
(let* ((holidays
(if calendar-debug-sexp
(let ((stack-trace-on-error t))
(eval p))
(condition-case nil
(eval p)
(error (beep)
(message "Bad holiday list item: %s" p)
(sleep-for 2))))))
(if holidays
(setq holiday-list (append holidays holiday-list)))))
(setq holiday-list (sort holiday-list 'calendar-date-compare))))
;;;###cal-autoload
(defun calendar-list-holidays ()
"Create a buffer containing the holidays for the current calendar window.
The holidays are those in the list `calendar-notable-days'. Returns t if any
holidays are found, nil if not."
(interactive)
(message "Looking up holidays...")
(let ((holiday-list (calendar-holiday-list))
(m1 displayed-month)
(y1 displayed-year)
(m2 displayed-month)
(y2 displayed-year))
(if (not holiday-list)
(progn
(message "Looking up holidays...none found")
nil)
(set-buffer (get-buffer-create holiday-buffer))
(setq buffer-read-only nil)
(increment-calendar-month m1 y1 -1)
(increment-calendar-month m2 y2 1)
(calendar-set-mode-line
(if (= y1 y2)
(format "Notable Dates from %s to %s, %d%%-"
(calendar-month-name m1) (calendar-month-name m2) y2)
(format "Notable Dates from %s, %d to %s, %d%%-"
(calendar-month-name m1) y1 (calendar-month-name m2) y2)))
(erase-buffer)
(insert
(mapconcat
(lambda (x) (concat (calendar-date-string (car x))
": " (cadr x)))
holiday-list "\n"))
(goto-char (point-min))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(display-buffer holiday-buffer)
(message "Looking up holidays...done")
t)))
(define-obsolete-function-alias
'list-calendar-holidays 'calendar-list-holidays "23.1")
;;;###autoload
(defun holidays (&optional arg)
"Display the holidays for last month, this month, and next month.
......@@ -63,8 +124,7 @@ This function is suitable for execution in a .emacs file."
(interactive "P")
(save-excursion
(let* ((completion-ignore-case t)
(date (if arg
(calendar-read-date t)
(date (if arg (calendar-read-date t)
(calendar-current-date)))
(displayed-month (extract-calendar-month date))
(displayed-year (extract-calendar-year date)))
......@@ -100,10 +160,10 @@ The optional LABEL is used to label the buffer created."
(int-to-string (extract-calendar-year
(calendar-current-date)))))
(end-year (calendar-read
(format "Ending year (inclusive) of holidays (>=%s): "
start-year)
(lambda (x) (>= x start-year))
(int-to-string start-year)))
(format "Ending year (inclusive) of holidays (>=%s): "
start-year)
(lambda (x) (>= x start-year))
(int-to-string start-year)))
(completion-ignore-case t)
(lists
(list
......@@ -161,7 +221,7 @@ The optional LABEL is used to label the buffer created."
(insert
(mapconcat
(lambda (x) (concat (calendar-date-string (car x))
": " (car (cdr x))))
": " (cadr x)))
holiday-list "\n"))
(goto-char (point-min))
(set-buffer-modified-p nil)
......@@ -185,6 +245,9 @@ The holidays are those in the list `calendar-holidays'."
(setq holiday-list (append holiday-list (cdr h)))))
holiday-list))
(define-obsolete-function-alias
'check-calendar-holidays 'calendar-check-holidays "23.1")
;;;###cal-autoload
(defun calendar-cursor-holidays ()
"Find holidays for the date specified by the cursor in the calendar window."
......@@ -217,67 +280,11 @@ The holidays are those in the list `calendar-holidays'."
(setq mark-holidays-in-calendar t)
(message "Marking holidays...")
(dolist (holiday (calendar-holiday-list))
(mark-visible-calendar-date
(car holiday) calendar-holiday-marker))
(mark-visible-calendar-date (car holiday) calendar-holiday-marker))
(message "Marking holidays...done"))
;;;###cal-autoload
(defun calendar-list-holidays ()
"Create a buffer containing the holidays for the current calendar window.
The holidays are those in the list `calendar-notable-days'. Returns t if any
holidays are found, nil if not."
(interactive)
(message "Looking up holidays...")
(let ((holiday-list (calendar-holiday-list))
(m1 displayed-month)
(y1 displayed-year)
(m2 displayed-month)
(y2 displayed-year))
(if (not holiday-list)
(progn
(message "Looking up holidays...none found")
nil)
(set-buffer (get-buffer-create holiday-buffer))
(setq buffer-read-only nil)
(increment-calendar-month m1 y1 -1)
(increment-calendar-month m2 y2 1)
(calendar-set-mode-line
(if (= y1 y2)
(format "Notable Dates from %s to %s, %d%%-"
(calendar-month-name m1) (calendar-month-name m2) y2)
(format "Notable Dates from %s, %d to %s, %d%%-"
(calendar-month-name m1) y1 (calendar-month-name m2) y2)))
(erase-buffer)
(insert
(mapconcat
(lambda (x) (concat (calendar-date-string (car x))
": " (car (cdr x))))
holiday-list "\n"))
(goto-char (point-min))
(set-buffer-modified-p nil)
(setq buffer-read-only t)
(display-buffer holiday-buffer)
(message "Looking up holidays...done")
t)))
;;;###diary-autoload
(defun calendar-holiday-list ()
"Form the list of holidays that occur on dates in the calendar window.
The holidays are those in the list `calendar-holidays'."
(let (holiday-list)
(dolist (p calendar-holidays)
(let* ((holidays
(if calendar-debug-sexp
(let ((stack-trace-on-error t))
(eval p))
(condition-case nil
(eval p)
(error (beep)
(message "Bad holiday list item: %s" p)
(sleep-for 2))))))
(if holidays
(setq holiday-list (append holidays holiday-list)))))
(setq holiday-list (sort holiday-list 'calendar-date-compare))))
(define-obsolete-function-alias
'mark-calendar-holidays 'calendar-mark-holidays "23.1")
;; Below are the functions that calculate the dates of holidays; these
;; are eval'ed in the function calendar-holiday-list. If you
......@@ -293,7 +300,7 @@ STRING)). Returns nil if it is not visible in the current calendar window."
(y displayed-year))
(increment-calendar-month m y (- 11 month))
(if (> m 9)
(list (list (list month day y) string)))))
(list (list (list month day y) string)))))
(defun holiday-float (month dayname n string &optional day)
"Holiday on MONTH, DAYNAME (Nth occurrence) called STRING.
......@@ -305,18 +312,18 @@ If N<0, count backward from the end of MONTH.
An optional parameter DAY means the Nth DAYNAME on or after/before MONTH DAY.
Returns nil if it is not visible in the current calendar window."
;; This is messy because the holiday may be visible, while the date on which
;; it is based is not. For example, the first Monday after December 30 may be
;; visible when January is not. For large values of |n| the problem is more
;; grotesque. If we didn't have to worry about such cases, we could just use
;; This is messy because the holiday may be visible, while the date on which
;; it is based is not. For example, the first Monday after December 30 may be
;; visible when January is not. For large values of |n| the problem is more
;; grotesque. If we didn't have to worry about such cases, we could just use
;; (let ((m displayed-month)
;; (y displayed-year))
;; (increment-calendar-month m y (- 11 month))
;; (if (> m 9); month in year y is visible
;; (list (list (calendar-nth-named-day n dayname month y day) string)))))
;; (let ((m displayed-month)
;; (y displayed-year))
;; (increment-calendar-month m y (- 11 month))
;; (if (> m 9); month in year y is visible
;; (list (list (calendar-nth-named-day n dayname month y day) string)))))
;; which is the way the function was originally written.
;; which is the way the function was originally written.
(let* ((m1 displayed-month)
(y1 displayed-year)
......@@ -336,8 +343,8 @@ Returns nil if it is not visible in the current calendar window."
(y2 (extract-calendar-year (calendar-gregorian-from-absolute d2)))
(y ; year of base date
(if (or (= y1 y2) (> month 9))
y1
y2))
y1
y2))
(d ; day of base date
(or day (if (> n 0)
1
......@@ -348,6 +355,18 @@ Returns nil if it is not visible in the current calendar window."
(list (list (calendar-nth-named-day n dayname month y d)
string))))))
(defun holiday-filter-visible-calendar (l)
"Return a list of all visible holidays of those on L."
(let ((visible ()))
(dolist (p l)
(and (car p)
(calendar-date-is-visible-p (car p))
(push p visible)))
visible))
(define-obsolete-function-alias
'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1")
(defun holiday-sexp (sexp string)
"Sexp holiday for dates in the calendar window.
SEXP is an expression in variable `year' evaluates to `date'.
......@@ -437,7 +456,7 @@ is non-nil)."
(% (+ 14 (* 11 (% displayed-year 19)) ; ...by Nicaean rule
(- ; ...corrected for the Gregorian century rule
(/ (* 3 century) 4))
(/ ; ...corrected for Metonic cycle inaccuracy
(/ ; ...corrected for Metonic cycle inaccuracy
(+ 5 (* 8 century)) 25)
(* 30 century)) ; keeps value positive
30))
......@@ -480,25 +499,6 @@ is non-nil)."
(if (calendar-date-is-visible-p nicaean-easter)
(list (list nicaean-easter "Pascha (Greek Orthodox Easter)"))))))
(defun holiday-filter-visible-calendar (l)
"Return a list of all visible holidays of those on L."
(let ((visible ()))
(dolist (p l)
(and (car p)
(calendar-date-is-visible-p (car p))
(push p visible)))
visible))
;; Backward compatibility.
(define-obsolete-function-alias
'filter-visible-calendar-holidays 'holiday-filter-visible-calendar "23.1")
(define-obsolete-function-alias
'list-calendar-holidays 'calendar-list-holidays "23.1")
(define-obsolete-function-alias
'mark-calendar-holidays 'calendar-mark-holidays "23.1")
(define-obsolete-function-alias
'check-calendar-holidays 'calendar-check-holidays "23.1")
(provide 'holidays)
;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment