Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Use calendar-read-sexp instead of the now obsolete calendar-read

Browse source 
* lisp/calendar/diary-lib.el (diary-insert-cyclic-entry):
* lisp/calendar/cal-persia.el (calendar-persian-read-date):
* lisp/calendar/cal-move.el (calendar-goto-day-of-year):
* lisp/calendar/cal-mayan.el (calendar-mayan-read-haab-date)
(calendar-mayan-read-tzolkin-date):
* lisp/calendar/cal-julian.el (calendar-julian-goto-date)
(calendar-astro-goto-day-number):
* lisp/calendar/cal-iso.el (calendar-iso-read-date):
* lisp/calendar/cal-islam.el (calendar-islamic-read-date):
* lisp/calendar/cal-hebrew.el (calendar-hebrew-read-date)
(calendar-hebrew-list-yahrzeits):
* lisp/calendar/cal-french.el (calendar-french-goto-date):
* lisp/calendar/cal-coptic.el (calendar-coptic-read-date):
* lisp/calendar/cal-china.el (calendar-chinese-goto-date):
* lisp/calendar/cal-bahai.el (calendar-bahai-read-date):
* lisp/calendar/holidays.el (list-holidays): Use `calendar-read-sexp`.
This commit is contained in:
Stefan Monnier 2021-01-20 23:14:25 -05:00
parent 0f65baa03b
commit 0c93d0d072
13 changed files with 131 additions and 122 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
lisp/calendar/cal-bahai.el
View file

@ -153,13 +153,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 +168,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

20
lisp/calendar/cal-china.el
View file

@ -602,14 +602,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 +624,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)))

23
lisp/calendar/cal-coptic.el
View file

@ -136,13 +136,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 +151,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

17
lisp/calendar/cal-french.el
View file

@ -188,14 +188,13 @@ Echo French Revolutionary date unless NOECHO is non-nil."
(let* ((months calendar-french-month-name-array)
(special-days calendar-french-special-days-array)
(year (progn
(calendar-read
"Année de la Ré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
@ -219,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))))

51
lisp/calendar/cal-hebrew.el
View file

@ -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
@ -681,10 +681,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 +694,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

19
lisp/calendar/cal-islam.el
View file

@ -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

19
lisp/calendar/cal-iso.el
View file

@ -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))))

26
lisp/calendar/cal-julian.el
View file

@ -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

8
lisp/calendar/cal-mayan.el
View file

@ -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

15
lisp/calendar/cal-move.el
View file

@ -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

21
lisp/calendar/cal-persia.el
View file

@ -157,14 +157,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 +174,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

4
lisp/calendar/diary-lib.el
View file

@ -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)))

15
lisp/calendar/holidays.el
View file

@ -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