"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
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
(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
(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)))
"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
(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
(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
(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))))
"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))
(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
(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
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
"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
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
"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))))
"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
(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)))
(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
(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"))))
(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
"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
(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
(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
(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)))
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