summaryrefslogtreecommitdiff
path: root/lisp/calendar
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/calendar')
-rw-r--r--lisp/calendar/cal-bahai.el28
-rw-r--r--lisp/calendar/cal-china.el45
-rw-r--r--lisp/calendar/cal-coptic.el56
-rw-r--r--lisp/calendar/cal-french.el76
-rw-r--r--lisp/calendar/cal-hebrew.el68
-rw-r--r--lisp/calendar/cal-html.el19
-rw-r--r--lisp/calendar/cal-islam.el25
-rw-r--r--lisp/calendar/cal-iso.el21
-rw-r--r--lisp/calendar/cal-julian.el26
-rw-r--r--lisp/calendar/cal-mayan.el10
-rw-r--r--lisp/calendar/cal-menu.el4
-rw-r--r--lisp/calendar/cal-move.el17
-rw-r--r--lisp/calendar/cal-persia.el30
-rw-r--r--lisp/calendar/cal-tex.el85
-rw-r--r--lisp/calendar/cal-x.el2
-rw-r--r--lisp/calendar/calendar.el57
-rw-r--r--lisp/calendar/diary-lib.el4
-rw-r--r--lisp/calendar/holidays.el15
18 files changed, 318 insertions, 270 deletions
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index 22e4cdbcd52..c2e4205c0bc 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -1,4 +1,4 @@
-;;; cal-bahai.el --- calendar functions for the Bahá’í calendar.
+;;; cal-bahai.el --- calendar functions for the Bahá’í calendar. -*- lexical-binding: t; -*-
;; Copyright (C) 2001-2021 Free Software Foundation, Inc.
@@ -124,9 +124,10 @@ Defaults to today's date if DATE is not given."
(y (calendar-extract-year bahai-date)))
(if (< y 1)
"" ; pre-Bahai
- (let* ((m (calendar-extract-month bahai-date))
- (d (calendar-extract-day bahai-date))
- (monthname (if (and (= m 19)
+ (let ((m (calendar-extract-month bahai-date))
+ (d (calendar-extract-day bahai-date)))
+ (calendar-dlet*
+ ((monthname (if (and (= m 19)
(<= d 0))
"Ayyám-i-Há"
(aref calendar-bahai-month-name-array (1- m))))
@@ -137,8 +138,8 @@ Defaults to today's date if DATE is not given."
(year (number-to-string y))
(month (number-to-string m))
dayname)
- ;; Can't call calendar-date-string because of monthname oddity.
- (mapconcat 'eval calendar-date-display-form "")))))
+ ;; Can't call calendar-date-string because of monthname oddity.
+ (mapconcat #'eval calendar-date-display-form ""))))))
;;;###cal-autoload
(defun calendar-bahai-print-date ()
@@ -153,13 +154,12 @@ Defaults to today's date if DATE is not given."
"Interactively read the arguments for a Bahá’í date command.
Reads a year, month and day."
(let* ((today (calendar-current-date))
- (year (calendar-read
- "Bahá’í calendar year (not 0): "
+ (year (calendar-read-sexp
+ "Bahá’í calendar year (not 0)"
(lambda (x) (not (zerop x)))
- (number-to-string
- (calendar-extract-year
- (calendar-bahai-from-absolute
- (calendar-absolute-from-gregorian today))))))
+ (calendar-extract-year
+ (calendar-bahai-from-absolute
+ (calendar-absolute-from-gregorian today)))))
(completion-ignore-case t)
(month (cdr (assoc
(completing-read
@@ -169,8 +169,8 @@ Reads a year, month and day."
nil t)
(calendar-make-alist calendar-bahai-month-name-array
1))))
- (day (calendar-read "Bahá’í calendar day (1-19): "
- (lambda (x) (and (< 0 x) (<= x 19))))))
+ (day (calendar-read-sexp "Bahá’í calendar day (1-19)"
+ (lambda (x) (and (< 0 x) (<= x 19))))))
(list (list month day year))))
;;;###cal-autoload
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
index 7e5d0c46e11..9a28984a7ab 100644
--- a/lisp/calendar/cal-china.el
+++ b/lisp/calendar/cal-china.el
@@ -1,4 +1,4 @@
-;;; cal-china.el --- calendar functions for the Chinese calendar
+;;; cal-china.el --- calendar functions for the Chinese calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -185,7 +185,9 @@ N congruent to 1 gives the first name, N congruent to 2 gives the second name,
(defun calendar-chinese-zodiac-sign-on-or-after (d)
"Absolute date of first new Zodiac sign on or after absolute date D.
The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
- (let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
+ (with-suppressed-warnings ((lexical year))
+ (defvar year))
+ (let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
(calendar-time-zone (eval calendar-chinese-time-zone)) ; uses year
(calendar-daylight-time-offset
calendar-chinese-daylight-time-offset)
@@ -207,6 +209,8 @@ The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
(defun calendar-chinese-new-moon-on-or-after (d)
"Absolute date of first new moon on or after absolute date D."
+ (with-suppressed-warnings ((lexical year))
+ (defvar year))
(let* ((year (calendar-extract-year (calendar-gregorian-from-absolute d)))
(calendar-time-zone (eval calendar-chinese-time-zone))
(calendar-daylight-time-offset
@@ -602,14 +606,14 @@ Echo Chinese date unless NOECHO is non-nil."
(interactive
(let* ((c (calendar-chinese-from-absolute
(calendar-absolute-from-gregorian (calendar-current-date))))
- (cycle (calendar-read
- "Chinese calendar cycle number (>44): "
+ (cycle (calendar-read-sexp
+ "Chinese calendar cycle number (>44)"
(lambda (x) (> x 44))
- (number-to-string (car c))))
- (year (calendar-read
- "Year in Chinese cycle (1..60): "
+ (car c)))
+ (year (calendar-read-sexp
+ "Year in Chinese cycle (1..60)"
(lambda (x) (and (<= 1 x) (<= x 60)))
- (number-to-string (cadr c))))
+ (cadr c)))
(month-list (calendar-chinese-months-to-alist
(calendar-chinese-months cycle year)))
(month (cdr (assoc
@@ -624,9 +628,11 @@ Echo Chinese date unless NOECHO is non-nil."
(list cycle year month 1))))))
30
29))
- (day (calendar-read
- (format "Chinese calendar day (1-%d): " last)
- (lambda (x) (and (<= 1 x) (<= x last))))))
+ (day (calendar-read-sexp
+ "Chinese calendar day (1-%d)"
+ (lambda (x) (and (<= 1 x) (<= x last)))
+ nil
+ last)))
(list (list cycle year month day))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-chinese-to-absolute date)))
@@ -663,17 +669,17 @@ Echo Chinese date unless NOECHO is non-nil."
["正月" "二月" "三月" "四月" "五月" "六月"
"七月" "八月" "九月" "十月" "冬月" "臘月"])
-;;; NOTE: In the diary the cycle and year of a Chinese date is
-;;; combined using this formula: (+ (* cycle 100) year).
+;; NOTE: In the diary the cycle and year of a Chinese date is
+;; combined using this formula: (+ (* cycle 100) year).
;;;
-;;; These two functions convert to and back from this representation.
-(defun calendar-chinese-from-absolute-for-diary (date)
- (pcase-let ((`(,c ,y ,m ,d) (calendar-chinese-from-absolute date)))
+;; These two functions convert to and back from this representation.
+(defun calendar-chinese-from-absolute-for-diary (thedate)
+ (pcase-let ((`(,c ,y ,m ,d) (calendar-chinese-from-absolute thedate)))
;; Note: For leap months M is a float.
(list (floor m) d (+ (* c 100) y))))
-(defun calendar-chinese-to-absolute-for-diary (date &optional prefer-leap)
- (pcase-let* ((`(,m ,d ,y) date)
+(defun calendar-chinese-to-absolute-for-diary (thedate &optional prefer-leap)
+ (pcase-let* ((`(,m ,d ,y) thedate)
(cycle (floor y 100))
(year (mod y 100))
(months (calendar-chinese-months cycle year))
@@ -691,7 +697,8 @@ Echo Chinese date unless NOECHO is non-nil."
(unless (zerop month)
(calendar-mark-1 month day year
#'calendar-chinese-from-absolute-for-diary
- (lambda (date) (calendar-chinese-to-absolute-for-diary date t))
+ (lambda (thedate)
+ (calendar-chinese-to-absolute-for-diary thedate t))
color)))
;;;###cal-autoload
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index 3461f3259b9..346585e1817 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -1,4 +1,4 @@
-;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars
+;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -116,12 +116,13 @@ Defaults to today's date if DATE is not given."
(m (calendar-extract-month coptic-date)))
(if (< y 1)
""
- (let ((monthname (aref calendar-coptic-month-name-array (1- m)))
- (day (number-to-string (calendar-extract-day coptic-date)))
- (dayname nil)
- (month (number-to-string m))
- (year (number-to-string y)))
- (mapconcat 'eval calendar-date-display-form "")))))
+ (calendar-dlet*
+ ((monthname (aref calendar-coptic-month-name-array (1- m)))
+ (day (number-to-string (calendar-extract-day coptic-date)))
+ (dayname nil)
+ (month (number-to-string m))
+ (year (number-to-string y)))
+ (mapconcat #'eval calendar-date-display-form "")))))
;;;###cal-autoload
(defun calendar-coptic-print-date ()
@@ -136,13 +137,13 @@ Defaults to today's date if DATE is not given."
"Interactively read the arguments for a Coptic date command.
Reads a year, month, and day."
(let* ((today (calendar-current-date))
- (year (calendar-read
- (format "%s calendar year (>0): " calendar-coptic-name)
+ (year (calendar-read-sexp
+ "%s calendar year (>0)"
(lambda (x) (> x 0))
- (number-to-string
- (calendar-extract-year
- (calendar-coptic-from-absolute
- (calendar-absolute-from-gregorian today))))))
+ (calendar-extract-year
+ (calendar-coptic-from-absolute
+ (calendar-absolute-from-gregorian today)))
+ calendar-coptic-name))
(completion-ignore-case t)
(month (cdr (assoc-string
(completing-read
@@ -151,11 +152,14 @@ Reads a year, month, and day."
(append calendar-coptic-month-name-array nil))
nil t)
(calendar-make-alist calendar-coptic-month-name-array
- 1) t)))
+ 1)
+ t)))
(last (calendar-coptic-last-day-of-month month year))
- (day (calendar-read
- (format "%s calendar day (1-%d): " calendar-coptic-name last)
- (lambda (x) (and (< 0 x) (<= x last))))))
+ (day (calendar-read-sexp
+ "%s calendar day (1-%d)"
+ (lambda (x) (and (< 0 x) (<= x last)))
+ nil
+ calendar-coptic-name last)))
(list (list month day year))))
;;;###cal-autoload
@@ -194,30 +198,30 @@ Echo Coptic date unless NOECHO is t."
(defconst calendar-ethiopic-name "Ethiopic"
"Used in some message strings.")
-(defun calendar-ethiopic-to-absolute (date)
+(defun calendar-ethiopic-to-absolute (thedate)
"Compute absolute date from Ethiopic date DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let ((calendar-coptic-epoch calendar-ethiopic-epoch))
- (calendar-coptic-to-absolute date)))
+ (calendar-coptic-to-absolute thedate)))
-(defun calendar-ethiopic-from-absolute (date)
+(defun calendar-ethiopic-from-absolute (thedate)
"Compute the Ethiopic equivalent for absolute date DATE.
The result is a list of the form (MONTH DAY YEAR).
The absolute date is the number of days elapsed since the imaginary
Gregorian date Sunday, December 31, 1 BC."
(let ((calendar-coptic-epoch calendar-ethiopic-epoch))
- (calendar-coptic-from-absolute date)))
+ (calendar-coptic-from-absolute thedate)))
;;;###cal-autoload
-(defun calendar-ethiopic-date-string (&optional date)
+(defun calendar-ethiopic-date-string (&optional thedate)
"String of Ethiopic date of Gregorian DATE.
Returns the empty string if DATE is pre-Ethiopic calendar.
Defaults to today's date if DATE is not given."
(let ((calendar-coptic-epoch calendar-ethiopic-epoch)
(calendar-coptic-name calendar-ethiopic-name)
(calendar-coptic-month-name-array calendar-ethiopic-month-name-array))
- (calendar-coptic-date-string date)))
+ (calendar-coptic-date-string thedate)))
;;;###cal-autoload
(defun calendar-ethiopic-print-date ()
@@ -229,8 +233,8 @@ Defaults to today's date if DATE is not given."
(call-interactively 'calendar-coptic-print-date)))
;;;###cal-autoload
-(defun calendar-ethiopic-goto-date (date &optional noecho)
- "Move cursor to Ethiopic date DATE.
+(defun calendar-ethiopic-goto-date (thedate &optional noecho)
+ "Move cursor to Ethiopic date THEDATE.
Echo Ethiopic date unless NOECHO is t."
(interactive
(let ((calendar-coptic-epoch calendar-ethiopic-epoch)
@@ -238,7 +242,7 @@ Echo Ethiopic date unless NOECHO is t."
(calendar-coptic-month-name-array calendar-ethiopic-month-name-array))
(calendar-coptic-read-date)))
(calendar-goto-date (calendar-gregorian-from-absolute
- (calendar-ethiopic-to-absolute date)))
+ (calendar-ethiopic-to-absolute thedate)))
(or noecho (calendar-ethiopic-print-date)))
;; To be called from diary-list-sexp-entries, where DATE is bound.
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
index e759b5dad95..639bae700cc 100644
--- a/lisp/calendar/cal-french.el
+++ b/lisp/calendar/cal-french.el
@@ -1,4 +1,4 @@
-;;; cal-french.el --- calendar functions for the French Revolutionary calendar
+;;; cal-french.el --- calendar functions for the French Revolutionary calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1988-1989, 1992, 1994-1995, 1997, 2001-2021 Free
;; Software Foundation, Inc.
@@ -35,54 +35,45 @@
(defconst calendar-french-epoch (calendar-absolute-from-gregorian '(9 22 1792))
"Absolute date of start of French Revolutionary calendar = Sept 22, 1792.")
-(defconst calendar-french-month-name-array
- ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se"
- "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]
- "Array of month names in the French calendar.")
+(define-obsolete-variable-alias 'calendar-french-multibyte-month-name-array
+ 'calendar-french-month-name-array "28.1")
-(defconst calendar-french-multibyte-month-name-array
+(defconst calendar-french-month-name-array
["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse"
"Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"]
- "Array of multibyte month names in the French calendar.")
+ "Array of month names in the French calendar.")
(defconst calendar-french-day-name-array
["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi"
"Octidi" "Nonidi" "Decadi"]
"Array of day names in the French calendar.")
-(defconst calendar-french-special-days-array
- ["de la Vertu" "du Ge'nie" "du Travail" "de la Raison" "des Re'compenses"
- "de la Re'volution"]
- "Array of special day names in the French calendar.")
+(define-obsolete-variable-alias 'calendar-french-multibyte-special-days-array
+ 'calendar-french-special-days-array "28.1")
-(defconst calendar-french-multibyte-special-days-array
+(defconst calendar-french-special-days-array
["de la Vertu" "du Génie" "du Travail" "de la Raison" "des Récompenses"
"de la Révolution"]
- "Array of multibyte special day names in the French calendar.")
+ "Array of special day names in the French calendar.")
(defun calendar-french-accents-p ()
- "Return non-nil if diacritical marks are available."
- (and (or window-system
- (terminal-coding-system))
- (or enable-multibyte-characters
- (and (char-table-p standard-display-table)
- (equal (aref standard-display-table 161) [161])))))
+ (declare (obsolete nil "28.1"))
+ t)
(defun calendar-french-month-name-array ()
"Return the array of month names, depending on whether accents are available."
- (if (calendar-french-accents-p)
- calendar-french-multibyte-month-name-array
- calendar-french-month-name-array))
+ (declare (obsolete "use the variable of the same name instead" "28.1"))
+ calendar-french-month-name-array)
(defun calendar-french-day-name-array ()
"Return the array of day names."
+ (declare (obsolete "use the variable of the same name instead" "28.1"))
calendar-french-day-name-array)
(defun calendar-french-special-days-array ()
"Return the special day names, depending on whether accents are available."
- (if (calendar-french-accents-p)
- calendar-french-multibyte-special-days-array
- calendar-french-special-days-array))
+ (declare (obsolete "use the variable of the same name instead" "28.1"))
+ calendar-french-special-days-array)
(defun calendar-french-leap-year-p (year)
"True if YEAR is a leap year on the French Revolutionary calendar.
@@ -171,17 +162,13 @@ Defaults to today's date if DATE is not given."
(d (calendar-extract-day french-date)))
(cond
((< y 1) "")
- ((= m 13) (format (if (calendar-french-accents-p)
- "Jour %s de l'Année %d de la Révolution"
- "Jour %s de l'Anne'e %d de la Re'volution")
- (aref (calendar-french-special-days-array) (1- d))
+ ((= m 13) (format "Jour %s de l'Année %d de la Révolution"
+ (aref calendar-french-special-days-array (1- d))
y))
(t (format
- (if (calendar-french-accents-p)
- "%d %s an %d de la Révolution"
- "%d %s an %d de la Re'volution")
+ "%d %s an %d de la Révolution"
d
- (aref (calendar-french-month-name-array) (1- m))
+ (aref calendar-french-month-name-array (1- m))
y)))))
;;;###cal-autoload
@@ -198,19 +185,16 @@ Defaults to today's date if DATE is not given."
"Move cursor to French Revolutionary date DATE.
Echo French Revolutionary date unless NOECHO is non-nil."
(interactive
- (let* ((months (calendar-french-month-name-array))
- (special-days (calendar-french-special-days-array))
+ (let* ((months calendar-french-month-name-array)
+ (special-days calendar-french-special-days-array)
(year (progn
- (calendar-read
- (if (calendar-french-accents-p)
- "Année de la Révolution (>0): "
- "Anne'e de la Re'volution (>0): ")
+ (calendar-read-sexp
+ "Année de la Révolution (>0)"
(lambda (x) (> x 0))
- (number-to-string
- (calendar-extract-year
- (calendar-french-from-absolute
- (calendar-absolute-from-gregorian
- (calendar-current-date))))))))
+ (calendar-extract-year
+ (calendar-french-from-absolute
+ (calendar-absolute-from-gregorian
+ (calendar-current-date)))))))
(month-list
(mapcar 'list
(append months
@@ -234,8 +218,8 @@ Echo French Revolutionary date unless NOECHO is non-nil."
(calendar-make-alist month-list 1 'car) t)))
(day (if (> month 12)
(- month 12)
- (calendar-read
- "Jour (1-30): "
+ (calendar-read-sexp
+ "Jour (1-30)"
(lambda (x) (and (<= 1 x) (<= x 30))))))
(month (if (> month 12) 13 month)))
(list (list month day year))))
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index bcc80f0877b..50b4fc363bb 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -1,4 +1,4 @@
-;;; cal-hebrew.el --- calendar functions for the Hebrew calendar
+;;; cal-hebrew.el --- calendar functions for the Hebrew calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -225,13 +225,12 @@ Driven by the variable `calendar-date-display-form'."
"Interactively read the arguments for a Hebrew date command.
Reads a year, month, and day."
(let* ((today (calendar-current-date))
- (year (calendar-read
- "Hebrew calendar year (>3760): "
+ (year (calendar-read-sexp
+ "Hebrew calendar year (>3760)"
(lambda (x) (> x 3760))
- (number-to-string
- (calendar-extract-year
- (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian today))))))
+ (calendar-extract-year
+ (calendar-hebrew-from-absolute
+ (calendar-absolute-from-gregorian today)))))
(month-array (if (calendar-hebrew-leap-year-p year)
calendar-hebrew-month-name-array-leap-year
calendar-hebrew-month-name-array-common-year))
@@ -258,10 +257,11 @@ Reads a year, month, and day."
(last (calendar-hebrew-last-day-of-month month year))
(first (if (and (= year 3761) (= month 10))
18 1))
- (day (calendar-read
- (format "Hebrew calendar day (%d-%d): "
- first last)
- (lambda (x) (and (<= first x) (<= x last))))))
+ (day (calendar-read-sexp
+ "Hebrew calendar day (%d-%d)"
+ (lambda (x) (and (<= first x) (<= x last)))
+ nil
+ first last)))
(list (list month day year))))
;;;###cal-autoload
@@ -399,19 +399,20 @@ is non-nil."
(list m (calendar-last-day-of-month m y) y))))))
(abs-h (calendar-hebrew-to-absolute (list 9 25 h-y)))
(ord ["first" "second" "third" "fourth" "fifth" "sixth"
- "seventh" "eighth"])
- han)
+ "seventh" "eighth"]))
(holiday-filter-visible-calendar
(if (or all calendar-hebrew-all-holidays-flag)
(append
(list
(list (calendar-gregorian-from-absolute (1- abs-h))
"Erev Hanukkah"))
- (dotimes (i 8 (nreverse han))
- (push (list
- (calendar-gregorian-from-absolute (+ abs-h i))
- (format "Hanukkah (%s day)" (aref ord i)))
- han)))
+ (let (han)
+ (dotimes (i 8)
+ (push (list
+ (calendar-gregorian-from-absolute (+ abs-h i))
+ (format "Hanukkah (%s day)" (aref ord i)))
+ han))
+ (nreverse han)))
(list (list (calendar-gregorian-from-absolute abs-h) "Hanukkah")))))))
;;;###holiday-autoload
@@ -681,10 +682,10 @@ from the cursor position."
(if (equal (current-buffer) (get-buffer calendar-buffer))
(calendar-cursor-to-date t)
(let* ((today (calendar-current-date))
- (year (calendar-read
- "Year of death (>0): "
+ (year (calendar-read-sexp
+ "Year of death (>0)"
(lambda (x) (> x 0))
- (number-to-string (calendar-extract-year today))))
+ (calendar-extract-year today)))
(month-array calendar-month-name-array)
(completion-ignore-case t)
(month (cdr (assoc-string
@@ -694,20 +695,23 @@ from the cursor position."
nil t)
(calendar-make-alist month-array 1) t)))
(last (calendar-last-day-of-month month year))
- (day (calendar-read
- (format "Day of death (1-%d): " last)
- (lambda (x) (and (< 0 x) (<= x last))))))
+ (day (calendar-read-sexp
+ "Day of death (1-%d)"
+ (lambda (x) (and (< 0 x) (<= x last)))
+ nil
+ last)))
(list month day year))))
(death-year (calendar-extract-year death-date))
- (start-year (calendar-read
- (format "Starting year of Yahrzeit table (>%d): "
- death-year)
+ (start-year (calendar-read-sexp
+ "Starting year of Yahrzeit table (>%d)"
(lambda (x) (> x death-year))
- (number-to-string (1+ death-year))))
- (end-year (calendar-read
- (format "Ending year of Yahrzeit table (>=%d): "
- start-year)
- (lambda (x) (>= x start-year)))))
+ (1+ death-year)
+ death-year))
+ (end-year (calendar-read-sexp
+ "Ending year of Yahrzeit table (>=%d)"
+ (lambda (x) (>= x start-year))
+ nil
+ start-year)))
(list death-date start-year end-year)))
(message "Computing Yahrzeits...")
(let* ((h-date (calendar-hebrew-from-absolute
diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
index 3d7cc938437..e5810c3f027 100644
--- a/lisp/calendar/cal-html.el
+++ b/lisp/calendar/cal-html.el
@@ -1,4 +1,4 @@
-;;; cal-html.el --- functions for printing HTML calendars
+;;; cal-html.el --- functions for printing HTML calendars -*- lexical-binding: t; -*-
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
@@ -250,7 +250,7 @@ Contains links to previous and next month and year, and current minical."
calendar-week-start-day))
7))
(monthpage-name (cal-html-monthpage-name month year))
- date)
+ ) ;; date
;; Start writing table.
(insert (cal-html-comment "MINICAL")
(cal-html-b-table "class=minical border=1 align=center"))
@@ -276,7 +276,7 @@ Contains links to previous and next month and year, and current minical."
(insert cal-html-e-tablerow-string
cal-html-b-tablerow-string)))
;; End empty slots (for some browsers like konqueror).
- (dotimes (i end-blank-days)
+ (dotimes (_ end-blank-days)
(insert
cal-html-b-tabledata-string
cal-html-e-tabledata-string)))
@@ -431,12 +431,11 @@ holidays in HOLIDAY-LIST."
;;; User commands.
;;;###cal-autoload
-(defun cal-html-cursor-month (month year dir &optional event)
+(defun cal-html-cursor-month (month year dir &optional _event)
"Write an HTML calendar file for numeric MONTH of four-digit YEAR.
The output directory DIR is created if necessary. Interactively,
-MONTH and YEAR are taken from the calendar cursor position, or from
-the position specified by EVENT. Note that any existing output files
-are overwritten."
+MONTH and YEAR are taken from the calendar cursor position.
+Note that any existing output files are overwritten."
(interactive (let* ((event last-nonmenu-event)
(date (calendar-cursor-to-date t event))
(month (calendar-extract-month date))
@@ -446,11 +445,11 @@ are overwritten."
(cal-html-one-month month year dir))
;;;###cal-autoload
-(defun cal-html-cursor-year (year dir &optional event)
+(defun cal-html-cursor-year (year dir &optional _event)
"Write HTML calendar files (index and monthly pages) for four-digit YEAR.
The output directory DIR is created if necessary. Interactively,
-YEAR is taken from the calendar cursor position, or from the position
-specified by EVENT. Note that any existing output files are overwritten."
+YEAR is taken from the calendar cursor position.
+Note that any existing output files are overwritten."
(interactive (let* ((event last-nonmenu-event)
(year (calendar-extract-year
(calendar-cursor-to-date t event))))
diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el
index d256310ba6c..45c6ffa7bd7 100644
--- a/lisp/calendar/cal-islam.el
+++ b/lisp/calendar/cal-islam.el
@@ -1,4 +1,4 @@
-;;; cal-islam.el --- calendar functions for the Islamic calendar
+;;; cal-islam.el --- calendar functions for the Islamic calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -67,8 +67,8 @@
"Absolute date of Islamic DATE.
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
- (let* ((month (calendar-extract-month date))
- (day (calendar-extract-day date))
+ (let* (;;(month (calendar-extract-month date))
+ ;;(day (calendar-extract-day date))
(year (calendar-extract-year date))
(y (% year 30))
(leap-years-in-cycle (cond ((< y 3) 0)
@@ -143,13 +143,12 @@ Driven by the variable `calendar-date-display-form'."
"Interactively read the arguments for an Islamic date command.
Reads a year, month, and day."
(let* ((today (calendar-current-date))
- (year (calendar-read
- "Islamic calendar year (>0): "
+ (year (calendar-read-sexp
+ "Islamic calendar year (>0)"
(lambda (x) (> x 0))
- (number-to-string
- (calendar-extract-year
- (calendar-islamic-from-absolute
- (calendar-absolute-from-gregorian today))))))
+ (calendar-extract-year
+ (calendar-islamic-from-absolute
+ (calendar-absolute-from-gregorian today)))))
(month-array calendar-islamic-month-name-array)
(completion-ignore-case t)
(month (cdr (assoc-string
@@ -159,9 +158,11 @@ Reads a year, month, and day."
nil t)
(calendar-make-alist month-array 1) t)))
(last (calendar-islamic-last-day-of-month month year))
- (day (calendar-read
- (format "Islamic calendar day (1-%d): " last)
- (lambda (x) (and (< 0 x) (<= x last))))))
+ (day (calendar-read-sexp
+ "Islamic calendar day (1-%d)"
+ (lambda (x) (and (< 0 x) (<= x last)))
+ nil
+ last)))
(list (list month day year))))
;;;###cal-autoload
diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el
index 956433e4a20..90f57c25e9d 100644
--- a/lisp/calendar/cal-iso.el
+++ b/lisp/calendar/cal-iso.el
@@ -1,4 +1,4 @@
-;;; cal-iso.el --- calendar functions for the ISO calendar
+;;; cal-iso.el --- calendar functions for the ISO calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 1997, 2001-2021 Free Software Foundation, Inc.
@@ -92,22 +92,23 @@ date Sunday, December 31, 1 BC."
"Interactively read the arguments for an ISO date command.
Reads a year and week, and if DAYFLAG is non-nil a day (otherwise
taken to be 1)."
- (let* ((year (calendar-read
- "ISO calendar year (>0): "
+ (let* ((year (calendar-read-sexp
+ "ISO calendar year (>0)"
(lambda (x) (> x 0))
- (number-to-string (calendar-extract-year
- (calendar-current-date)))))
+ (calendar-extract-year (calendar-current-date))))
(no-weeks (calendar-extract-month
(calendar-iso-from-absolute
(1-
(calendar-dayname-on-or-before
1 (calendar-absolute-from-gregorian
(list 1 4 (1+ year))))))))
- (week (calendar-read
- (format "ISO calendar week (1-%d): " no-weeks)
- (lambda (x) (and (> x 0) (<= x no-weeks)))))
- (day (if dayflag (calendar-read
- "ISO day (1-7): "
+ (week (calendar-read-sexp
+ "ISO calendar week (1-%d)"
+ (lambda (x) (and (> x 0) (<= x no-weeks)))
+ nil
+ no-weeks))
+ (day (if dayflag (calendar-read-sexp
+ "ISO day (1-7)"
(lambda (x) (and (<= 1 x) (<= x 7))))
1)))
(list (list week day year))))
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index 235b4d00900..47880a4e974 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -95,14 +95,13 @@ Driven by the variable `calendar-date-display-form'."
"Move cursor to Julian DATE; echo Julian date unless NOECHO is non-nil."
(interactive
(let* ((today (calendar-current-date))
- (year (calendar-read
- "Julian calendar year (>0): "
+ (year (calendar-read-sexp
+ "Julian calendar year (>0)"
(lambda (x) (> x 0))
- (number-to-string
- (calendar-extract-year
- (calendar-julian-from-absolute
- (calendar-absolute-from-gregorian
- today))))))
+ (calendar-extract-year
+ (calendar-julian-from-absolute
+ (calendar-absolute-from-gregorian
+ today)))))
(month-array calendar-month-name-array)
(completion-ignore-case t)
(month (cdr (assoc-string
@@ -115,12 +114,13 @@ Driven by the variable `calendar-date-display-form'."
(if (and (zerop (% year 4)) (= month 2))
29
(aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
- (day (calendar-read
- (format "Julian calendar day (%d-%d): "
- (if (and (= year 1) (= month 1)) 3 1) last)
+ (day (calendar-read-sexp
+ "Julian calendar day (%d-%d)"
(lambda (x)
(and (< (if (and (= year 1) (= month 1)) 2 0) x)
- (<= x last))))))
+ (<= x last)))
+ nil
+ (if (and (= year 1) (= month 1)) 3 1) last)))
(list (list month day year))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-julian-to-absolute date)))
@@ -173,8 +173,8 @@ Defaults to today's date if DATE is not given."
(defun calendar-astro-goto-day-number (daynumber &optional noecho)
"Move cursor to astronomical (Julian) DAYNUMBER.
Echo astronomical (Julian) day number unless NOECHO is non-nil."
- (interactive (list (calendar-read
- "Astronomical (Julian) day number (>1721425): "
+ (interactive (list (calendar-read-sexp
+ "Astronomical (Julian) day number (>1721425)"
(lambda (x) (> x 1721425)))))
(calendar-goto-date
(calendar-gregorian-from-absolute
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el
index 8d894ebd986..9a221921130 100644
--- a/lisp/calendar/cal-mayan.el
+++ b/lisp/calendar/cal-mayan.el
@@ -1,4 +1,4 @@
-;;; cal-mayan.el --- calendar functions for the Mayan calendars
+;;; cal-mayan.el --- calendar functions for the Mayan calendars -*- lexical-binding: t; -*-
;; Copyright (C) 1992-1993, 1995, 1997, 2001-2021 Free Software
;; Foundation, Inc.
@@ -135,8 +135,8 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using
(defun calendar-mayan-read-haab-date ()
"Prompt for a Mayan haab date."
(let* ((completion-ignore-case t)
- (haab-day (calendar-read
- "Haab kin (0-19): "
+ (haab-day (calendar-read-sexp
+ "Haab kin (0-19)"
(lambda (x) (and (>= x 0) (< x 20)))))
(haab-month-list (append calendar-mayan-haab-month-name-array
(and (< haab-day 5) '("Uayeb"))))
@@ -151,8 +151,8 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using
(defun calendar-mayan-read-tzolkin-date ()
"Prompt for a Mayan tzolkin date."
(let* ((completion-ignore-case t)
- (tzolkin-count (calendar-read
- "Tzolkin kin (1-13): "
+ (tzolkin-count (calendar-read-sexp
+ "Tzolkin kin (1-13)"
(lambda (x) (and (> x 0) (< x 14)))))
(tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
(tzolkin-name (cdr
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index a30c681a897..497f3329055 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -1,4 +1,4 @@
-;;; cal-menu.el --- calendar functions for menu bar and popup menu support
+;;; cal-menu.el --- calendar functions for menu bar and popup menu support -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
@@ -183,6 +183,8 @@ Signals an error if popups are unavailable."
;; Autoloaded in diary-lib.
(declare-function calendar-check-holidays "holidays" (date))
+(defvar diary-list-include-blanks)
+
(defun calendar-mouse-view-diary-entries (&optional date diary event)
"Pop up menu of diary entries for mouse-selected date.
Use optional DATE and alternative file DIARY. EVENT is the event
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
index 710ce37ccbf..9294362cb43 100644
--- a/lisp/calendar/cal-move.el
+++ b/lisp/calendar/cal-move.el
@@ -1,4 +1,4 @@
-;;; cal-move.el --- calendar functions for movement in the calendar
+;;; cal-move.el --- calendar functions for movement in the calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
@@ -386,15 +386,16 @@ Moves forward if ARG is negative."
"Move cursor to YEAR, DAY number; echo DAY/YEAR unless NOECHO is non-nil.
Negative DAY counts backward from end of year."
(interactive
- (let* ((year (calendar-read
- "Year (>0): "
+ (let* ((year (calendar-read-sexp
+ "Year (>0)"
(lambda (x) (> x 0))
- (number-to-string (calendar-extract-year
- (calendar-current-date)))))
+ (calendar-extract-year (calendar-current-date))))
(last (if (calendar-leap-year-p year) 366 365))
- (day (calendar-read
- (format "Day number (+/- 1-%d): " last)
- (lambda (x) (and (<= 1 (abs x)) (<= (abs x) last))))))
+ (day (calendar-read-sexp
+ "Day number (+/- 1-%d)"
+ (lambda (x) (and (<= 1 (abs x)) (<= (abs x) last)))
+ nil
+ last)))
(list year day)))
(calendar-goto-date
(calendar-gregorian-from-absolute
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index a9c99fedbdb..ca37d803224 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -1,4 +1,4 @@
-;;; cal-persia.el --- calendar functions for the Persian calendar
+;;; cal-persia.el --- calendar functions for the Persian calendar -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1997, 2001-2021 Free Software Foundation, Inc.
@@ -139,13 +139,14 @@ Gregorian date Sunday, December 31, 1 BC."
(calendar-absolute-from-gregorian
(or date (calendar-current-date)))))
(y (calendar-extract-year persian-date))
- (m (calendar-extract-month persian-date))
- (monthname (aref calendar-persian-month-name-array (1- m)))
+ (m (calendar-extract-month persian-date)))
+ (calendar-dlet*
+ ((monthname (aref calendar-persian-month-name-array (1- m)))
(day (number-to-string (calendar-extract-day persian-date)))
(year (number-to-string y))
(month (number-to-string m))
dayname)
- (mapconcat 'eval calendar-date-display-form "")))
+ (mapconcat #'eval calendar-date-display-form ""))))
;;;###cal-autoload
(defun calendar-persian-print-date ()
@@ -157,14 +158,13 @@ Gregorian date Sunday, December 31, 1 BC."
(defun calendar-persian-read-date ()
"Interactively read the arguments for a Persian date command.
Reads a year, month, and day."
- (let* ((year (calendar-read
- "Persian calendar year (not 0): "
+ (let* ((year (calendar-read-sexp
+ "Persian calendar year (not 0)"
(lambda (x) (not (zerop x)))
- (number-to-string
- (calendar-extract-year
- (calendar-persian-from-absolute
- (calendar-absolute-from-gregorian
- (calendar-current-date)))))))
+ (calendar-extract-year
+ (calendar-persian-from-absolute
+ (calendar-absolute-from-gregorian
+ (calendar-current-date))))))
(completion-ignore-case t)
(month (cdr (assoc
(completing-read
@@ -175,9 +175,11 @@ Reads a year, month, and day."
(calendar-make-alist calendar-persian-month-name-array
1))))
(last (calendar-persian-last-day-of-month month year))
- (day (calendar-read
- (format "Persian calendar day (1-%d): " last)
- (lambda (x) (and (< 0 x) (<= x last))))))
+ (day (calendar-read-sexp
+ "Persian calendar day (1-%d)"
+ (lambda (x) (and (< 0 x) (<= x last)))
+ nil
+ last)))
(list (list month day year))))
;;;###cal-autoload
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index 9df9f4cbedf..f5932014dd9 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -1,4 +1,4 @@
-;;; cal-tex.el --- calendar functions for printing calendars with LaTeX
+;;; cal-tex.el --- calendar functions for printing calendars with LaTeX -*- lexical-binding: t; -*-
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
@@ -248,6 +248,8 @@ This definition is the heart of the calendar!")
(autoload 'diary-list-entries "diary-lib")
+(defvar diary-list-include-blanks)
+
(defun cal-tex-list-diary-entries (d1 d2)
"Generate a list of all diary-entries from absolute date D1 to D2."
(let (diary-list-include-blanks)
@@ -591,6 +593,8 @@ indicates a buffer position to use instead of point."
LaTeX commands are inserted for the days of the MONTH in YEAR.
Diary entries on DIARY-LIST are included. Holidays on HOLIDAYS
are included. Each day is formatted using format DAY-FORMAT."
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
(let ((blank-days ; at start of month
(mod
(- (calendar-day-of-week (list month 1 year))
@@ -605,7 +609,7 @@ are included. Each day is formatted using format DAY-FORMAT."
(insert (format day-format (cal-tex-month-name month) j))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (eval cal-tex-daily-string t))
(cal-tex-arg)
(cal-tex-comment))
(when (and (zerop (mod (+ j blank-days) 7))
@@ -885,13 +889,15 @@ argument EVENT specifies a different buffer position."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(or n (setq n 1))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
(month (calendar-extract-month date))
- (year (calendar-extract-year date))
+ ;; (year (calendar-extract-year date))
(day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
@@ -932,7 +938,7 @@ argument EVENT specifies a different buffer position."
(insert ": ")
(cal-tex-large-bf s))
(cal-tex-hfill)
- (insert " " (eval cal-tex-daily-string))
+ (insert " " (eval cal-tex-daily-string t))
(cal-tex-e-parbox)
(cal-tex-nl)
(cal-tex-noindent)
@@ -951,7 +957,8 @@ argument EVENT specifies a different buffer position."
(cal-tex-e-parbox "2cm")
(cal-tex-nl)
(setq month (calendar-extract-month date)
- year (calendar-extract-year date)))
+ ;; year (calendar-extract-year date)
+ ))
(cal-tex-e-parbox)
(unless (= i (1- n))
(run-hooks 'cal-tex-week-hook)
@@ -961,13 +968,16 @@ argument EVENT specifies a different buffer position."
;; TODO respect cal-tex-daily-start,end?
;; Using different numbers of hours will probably break some layouts.
-(defun cal-tex-week-hours (date holidays height)
- "Insert hourly entries for DATE with HOLIDAYS, with line height HEIGHT.
+(defun cal-tex-week-hours (thedate holidays height)
+ "Insert hourly entries for THEDATE with HOLIDAYS, with line height HEIGHT.
Uses the 24-hour clock if `cal-tex-24' is non-nil. Note that the hours
shown are hard-coded to 8-12, 13-17."
- (let ((month (calendar-extract-month date))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
+ (let ((date thedate)
+ (month (calendar-extract-month date))
(day (calendar-extract-day date))
- (year (calendar-extract-year date))
+ ;; (year (calendar-extract-year date))
morning afternoon s)
(cal-tex-comment "begin cal-tex-week-hours")
(cal-tex-cmd "\\ \\\\[-.2cm]")
@@ -983,7 +993,7 @@ shown are hard-coded to 8-12, 13-17."
(insert ": ")
(cal-tex-large-bf s))
(cal-tex-hfill)
- (insert " " (eval cal-tex-daily-string))
+ (insert " " (eval cal-tex-daily-string t))
(cal-tex-e-parbox)
(cal-tex-nl "-.3cm")
(cal-tex-rule "0pt" "6.8in" ".2mm")
@@ -1088,14 +1098,16 @@ shown are hard-coded to 8-12, 13-17."
(defun cal-tex-weekly-common (n event &optional filofax)
"Common code for weekly calendars."
(or n (setq n 1))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
- (month (calendar-extract-month date))
- (year (calendar-extract-year date))
- (day (calendar-extract-day date))
+ ;; (month (calendar-extract-month date))
+ ;; (year (calendar-extract-year date))
+ ;; (day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@@ -1161,7 +1173,7 @@ shown are hard-coded to 8-12, 13-17."
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (eval cal-tex-daily-string t))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
@@ -1258,14 +1270,16 @@ Optional EVENT indicates a buffer position to use instead of point."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(or n (setq n 1))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
calendar-week-start-day
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
- (month (calendar-extract-month date))
- (year (calendar-extract-year date))
- (day (calendar-extract-day date))
+ ;; (month (calendar-extract-month date))
+ ;; (year (calendar-extract-year date))
+ ;; (day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@@ -1311,7 +1325,7 @@ Optional EVENT indicates a buffer position to use instead of point."
(cal-tex-arg (number-to-string (calendar-extract-day date)))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (eval cal-tex-daily-string t))
(insert "%\n")
(setq date (cal-tex-incr-date date)))
(unless (= i (1- n))
@@ -1342,14 +1356,16 @@ Optional EVENT indicates a buffer position to use instead of point."
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(or n (setq n 1))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
(let* ((date (calendar-gregorian-from-absolute
(calendar-dayname-on-or-before
1
(calendar-absolute-from-gregorian
(calendar-cursor-to-date t event)))))
- (month (calendar-extract-month date))
- (year (calendar-extract-year date))
- (day (calendar-extract-day date))
+ ;; (month (calendar-extract-month date))
+ ;; (year (calendar-extract-year date))
+ ;; (day (calendar-extract-day date))
(d1 (calendar-absolute-from-gregorian date))
(d2 (+ (* 7 n) d1))
(holidays (if cal-tex-holidays
@@ -1383,11 +1399,11 @@ Optional EVENT indicates a buffer position to use instead of point."
"\\leftday")))
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (eval cal-tex-daily-string t))
(insert "%\n")
- (if cal-tex-rules
- (insert "\\linesfill\n")
- (insert "\\vfill\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n"))
+ (insert (if cal-tex-rules
+ "\\linesfill\n"
+ "\\vfill\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n"))
(cal-tex-newpage)
(setq date (cal-tex-incr-date date)))
(insert "%\n")
@@ -1397,11 +1413,11 @@ Optional EVENT indicates a buffer position to use instead of point."
(insert "\\weekend")
(cal-tex-arg (cal-tex-latexify-list diary-list date))
(cal-tex-arg (cal-tex-latexify-list holidays date "\\\\" t))
- (cal-tex-arg (eval cal-tex-daily-string))
+ (cal-tex-arg (eval cal-tex-daily-string t))
(insert "%\n")
- (if cal-tex-rules
- (insert "\\linesfill\n")
- (insert "\\vfill"))
+ (insert (if cal-tex-rules
+ "\\linesfill\n"
+ "\\vfill"))
(setq date (cal-tex-incr-date date)))
(or cal-tex-rules
(insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n"))
@@ -1442,12 +1458,15 @@ a buffer position to use instead of point."
(cal-tex-end-document)
(run-hooks 'cal-tex-hook)))
-(defun cal-tex-daily-page (date)
- "Make a calendar page for Gregorian DATE on 8.5 by 11 paper.
+(defun cal-tex-daily-page (thedate)
+ "Make a calendar page for Gregorian THEDATE on 8.5 by 11 paper.
Uses the 24-hour clock if `cal-tex-24' is non-nil. Produces
hourly sections for the period specified by `cal-tex-daily-start'
and `cal-tex-daily-end'."
- (let ((month-name (cal-tex-month-name (calendar-extract-month date)))
+ (with-suppressed-warnings ((lexical date))
+ (defvar date)) ;For `cal-tex-daily-string'.
+ (let ((date thedate)
+ (month-name (cal-tex-month-name (calendar-extract-month date)))
(i (1- cal-tex-daily-start))
hour)
(cal-tex-banner "cal-tex-daily-page")
@@ -1459,7 +1478,7 @@ and `cal-tex-daily-end'."
(cal-tex-bf month-name )
(cal-tex-e-parbox)
(cal-tex-hspace "1cm")
- (cal-tex-scriptsize (eval cal-tex-daily-string))
+ (cal-tex-scriptsize (eval cal-tex-daily-string t))
(cal-tex-hspace "3.5cm")
(cal-tex-e-makebox)
(cal-tex-hfill)
diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el
index 1c19a60db10..ca303ce39ae 100644
--- a/lisp/calendar/cal-x.el
+++ b/lisp/calendar/cal-x.el
@@ -1,4 +1,4 @@
-;;; cal-x.el --- calendar windows in dedicated frames
+;;; cal-x.el --- calendar windows in dedicated frames -*- lexical-binding: t; -*-
;; Copyright (C) 1994-1995, 2001-2021 Free Software Foundation, Inc.
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 21cea212e18..3f9fe1c9d8f 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -112,6 +112,8 @@
;;; Code:
+(eval-when-compile (require 'subr-x))
+
(load "cal-loaddefs" nil t)
;; Calendar has historically relied heavily on dynamic scoping.
@@ -1459,7 +1461,7 @@ Optional integers MON and YR are used instead of today's date."
Inserts STRING so that it ends at INDENT. STRING is either a
literal string, or a sexp to evaluate to return such. Truncates
STRING to length TRUNCATE, and ensures a trailing space."
- (if (not (ignore-errors (stringp (setq string (eval string)))))
+ (if (not (ignore-errors (stringp (setq string (eval string t)))))
(calendar-move-to-column indent)
(if (> (string-width string) truncate)
(setq string (truncate-string-to-width string truncate)))
@@ -1526,7 +1528,7 @@ first INDENT characters on the line."
(format (format "%%%dd" calendar-day-digit-width) day)
'mouse-face 'highlight
'help-echo (calendar-dlet* ((day day) (month month) (year year))
- (eval calendar-date-echo-text))
+ (eval calendar-date-echo-text t))
;; 'date property prevents intermonth text confusing re-searches.
;; (Tried intangible, it did not really work.)
'date t)
@@ -2054,23 +2056,40 @@ With argument ARG, jump to mark, pop it, and put point at end of ring."
(error "%s not available in the calendar"
(global-key-binding (this-command-keys))))
+(defun calendar-read-sexp (prompt predicate &optional default &rest args)
+ "Return an object read from the minibuffer.
+Passes PROMPT, DEFAULT, and ARGS to `format-prompt' to build
+the actual prompt. PREDICATE is called with a single value (the object
+the user entered) and it should return non-nil if that value is a valid choice.
+DEFAULT is the default value to use."
+ (unless (stringp default) (setq default (format "%S" default)))
+ (named-let query ()
+ ;; The call to `read-from-minibuffer' is copied from `read-minibuffer',
+ ;; except it's changed to use the DEFAULT arg instead of INITIAL-CONTENTS.
+ (let ((value (read-from-minibuffer
+ (apply #'format-prompt prompt default args)
+ nil minibuffer-local-map t 'minibuffer-history default)))
+ (if (funcall predicate value)
+ value
+ (query)))))
+
(defun calendar-read (prompt acceptable &optional initial-contents)
"Return an object read from the minibuffer.
Prompt with the string PROMPT and use the function ACCEPTABLE to decide
if entered item is acceptable. If non-nil, optional third arg
INITIAL-CONTENTS is a string to insert in the minibuffer before reading."
+ (declare (obsolete calendar-read-sexp "28.1"))
(let ((value (read-minibuffer prompt initial-contents)))
(while (not (funcall acceptable value))
(setq value (read-minibuffer prompt initial-contents)))
value))
-
(defun calendar-customized-p (symbol)
"Return non-nil if SYMBOL has been customized."
(and (default-boundp symbol)
(let ((standard (get symbol 'standard-value)))
(and standard
- (not (equal (eval (car standard)) (default-value symbol)))))))
+ (not (equal (eval (car standard) t) (default-value symbol)))))))
(defun calendar-abbrev-construct (full &optional maxlen)
"From sequence FULL, return a vector of abbreviations.
@@ -2284,32 +2303,38 @@ arguments SEQUENCES."
(append (list sequence) sequences))
(reverse alist)))
-(defun calendar-read-date (&optional noday)
+(defun calendar-read-date (&optional noday default-date)
"Prompt for Gregorian date. Return a list (month day year).
If optional NODAY is t, does not ask for day, but just returns
\(month 1 year); if NODAY is any other non-nil value the value
returned is (month year)."
- (let* ((year (calendar-read
- "Year (>0): "
- (lambda (x) (> x 0))
- (number-to-string (calendar-extract-year
- (calendar-current-date)))))
+ (unless default-date (setq default-date (calendar-current-date)))
+ (let* ((defyear (calendar-extract-year default-date))
+ (year (calendar-read-sexp "Year (>0)"
+ (lambda (x) (> x 0))
+ defyear))
(month-array calendar-month-name-array)
+ (defmon (aref month-array (1- (calendar-extract-month default-date))))
(completion-ignore-case t)
(month (cdr (assoc-string
- (completing-read
- "Month name: "
- (mapcar #'list (append month-array nil))
- nil t)
+ (completing-read
+ (format-prompt "Month name" defmon)
+ (append month-array nil)
+ nil t nil nil defmon)
(calendar-make-alist month-array 1) t)))
+ (defday (calendar-extract-day default-date))
(last (calendar-last-day-of-month month year)))
(if noday
(if (eq noday t)
(list month 1 year)
(list month year))
(list month
- (calendar-read (format "Day (1-%d): " last)
- (lambda (x) (and (< 0 x) (<= x last))))
+ (calendar-read-sexp "Day (1-%d)"
+ (lambda (x) (and (< 0 x) (<= x last)))
+ ;; Don't offer today's day as default
+ ;; if it's not valid for the chosen
+ ;; month/year.
+ (if (<= defday last) defday) last)
year))))
(defun calendar-interval (mon1 yr1 mon2 yr2)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index aad70161f9f..4efa3669967 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -2221,8 +2221,8 @@ Prefix argument ARG makes the entry nonmarking."
(diary-make-entry
(format "%s(diary-cyclic %d %s)"
diary-sexp-entry-symbol
- (calendar-read "Repeat every how many days: "
- (lambda (x) (> x 0)))
+ (calendar-read-sexp "Repeat every how many days"
+ (lambda (x) (> x 0)))
(calendar-date-string (calendar-cursor-to-date t) nil t))
arg)))
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 932993beba0..4bc17de3067 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -423,16 +423,15 @@ of a holiday list.
The optional LABEL is used to label the buffer created."
(interactive
- (let* ((start-year (calendar-read
- "Starting year of holidays (>0): "
+ (let* ((start-year (calendar-read-sexp
+ "Starting year of holidays (>0)"
(lambda (x) (> x 0))
- (number-to-string (calendar-extract-year
- (calendar-current-date)))))
- (end-year (calendar-read
- (format "Ending year (inclusive) of holidays (>=%s): "
- start-year)
+ (calendar-extract-year (calendar-current-date))))
+ (end-year (calendar-read-sexp
+ "Ending year (inclusive) of holidays (>=%s)"
(lambda (x) (>= x start-year))
- (number-to-string start-year)))
+ start-year
+ start-year))
(completion-ignore-case t)
(lists
(list
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-03 05:37:17 +0000