Commit d8a9828b authored by Stefan Monnier's avatar Stefan Monnier

* lisp/calendar/calendar.el (calendar-read-sexp): New function

(calendar-read): Mark as obsolete.
(calendar-read-date): Use it.  Add `default-date` argument.
Provide defaults for the month and day (fixes bug#32105).
parent b9511362
......@@ -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)
......
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