(eval-when-compile (require 'compat-macs))
(compat-require compat-26 "26.1")
(compat-version "27.1")
(compat-defun proper-list-p (object) "Return OBJECT's length if it is a proper list, nil otherwise.
A proper list is neither circular nor dotted (i.e., its last cdr
is nil)."
(if (eval-when-compile (< emacs-major-version 26))
(when (listp object)
(catch 'cycle
(let ((hare object) (tortoise object)
(max 2) (q 2))
(while (consp hare)
(setq hare (cdr hare))
(when (and (or (/= 0 (setq q (1- q)))
(ignore
(setq max (ash max 1)
q max
tortoise hare)))
(eq hare tortoise))
(throw 'cycle nil)))
(and (null hare) (length object)))))
(and (listp object) (ignore-errors (length object)))))
(compat-defun string-distance (string1 string2 &optional bytecompare) "Return Levenshtein distance between STRING1 and STRING2.
The distance is the number of deletions, insertions, and substitutions
required to transform STRING1 into STRING2.
If BYTECOMPARE is nil or omitted, compute distance in terms of characters.
If BYTECOMPARE is non-nil, compute distance in terms of bytes.
Letter-case is significant, but text properties are ignored."
(let ((s1 (if bytecompare
(encode-coding-string string1 'raw-text)
(concat string1 "")))
(s2 (if bytecompare
(encode-coding-string string2 'raw-text)
string2)))
(let* ((len1 (length s1))
(len2 (length s2))
(column (make-vector (1+ len1) 0)))
(dotimes (y len1)
(setf (aref column (1+ y)) y))
(dotimes (x len2)
(setf (aref column 0) (1+ x))
(let ((lastdiag x) olddiag)
(dotimes (y len1)
(setf olddiag (aref column (1+ y))
(aref column (1+ y))
(min (+ (if (= (aref s1 y) (aref s2 x)) 0 1)
lastdiag)
(1+ (aref column (1+ y)))
(1+ (aref column y)))
lastdiag olddiag))))
(aref column len1))))
(compat-defun recenter (&optional arg redisplay) "Handle optional argument REDISPLAY."
:extended t
(recenter arg)
(when (and redisplay recenter-redisplay)
(redisplay)))
(compat-defun lookup-key (keymap key &optional accept-default) "Allow for KEYMAP to be a list of keymaps."
:extended t
(cond
((keymapp keymap)
(lookup-key keymap key accept-default))
((listp keymap)
(catch 'found
(dolist (map keymap)
(when-let ((fn (lookup-key map key accept-default)))
(throw 'found fn)))))
((signal 'wrong-type-argument (list 'keymapp keymap)))))
(compat-defun time-equal-p (t1 t2) "Return non-nil if time value T1 is equal to time value T2.
A nil value for either argument stands for the current time.
NOTE: This function is not as accurate as the actual `time-equal-p'."
(cond
((eq t1 t2))
((and (consp t1) (consp t2))
(equal t1 t2))
(t
(< (abs (- (float-time t1) (float-time t2)))
(if (and t1 t2) 1e-6 1e-5)))))
(compat-defalias fixnump integerp) (compat-defalias bignump ignore)
(compat-defmacro setq-local (&rest pairs) "Handle multiple assignments."
:extended t
(unless (zerop (mod (length pairs) 2))
(error "PAIRS must have an even number of variable/value members"))
(let (body)
(while pairs
(let* ((sym (pop pairs))
(val (pop pairs)))
(unless (symbolp sym)
(error "Attempting to set a non-symbol: %s" (car pairs)))
(push `(set (make-local-variable ',sym) ,val)
body)))
(cons 'progn (nreverse body))))
(compat-defmacro ignore-error (condition &rest body) "Execute BODY; if the error CONDITION occurs, return nil.
Otherwise, return result of last form in BODY.
CONDITION can also be a list of error conditions."
(declare (debug t) (indent 1))
`(condition-case nil (progn ,@body) (,condition nil)))
(compat-defmacro dolist-with-progress-reporter (spec reporter-or-message &rest body) "Loop over a list and report progress in the echo area.
Evaluate BODY with VAR bound to each car from LIST, in turn.
Then evaluate RESULT to get return value, default nil.
REPORTER-OR-MESSAGE is a progress reporter object or a string. In the latter
case, use this string to create a progress reporter.
At each iteration, print the reporter message followed by progress
percentage in the echo area. After the loop is finished,
print the reporter message followed by the word \"done\".
\(fn (VAR LIST [RESULT]) REPORTER-OR-MESSAGE BODY...)"
(declare (indent 2) (debug ((symbolp form &optional form) form body)))
(let ((prep (make-symbol "--dolist-progress-reporter--"))
(count (make-symbol "--dolist-count--"))
(list (make-symbol "--dolist-list--")))
`(let ((,prep ,reporter-or-message)
(,count 0)
(,list ,(cadr spec)))
(when (stringp ,prep)
(setq ,prep (make-progress-reporter ,prep 0 (length ,list))))
(dolist (,(car spec) ,list)
,@body
(progress-reporter-update ,prep (setq ,count (1+ ,count))))
(progress-reporter-done ,prep)
(or ,@(cdr (cdr spec)) nil))))
(compat-defun flatten-tree (tree) "Return a \"flattened\" copy of TREE.
In other words, return a list of the non-nil terminal nodes, or
leaves, of the tree of cons cells rooted at TREE. Leaves in the
returned list are in the same order as in TREE.
\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7))
=> (1 2 3 4 5 6 7)"
(let (elems)
(while (consp tree)
(let ((elem (pop tree)))
(while (consp elem)
(push (cdr elem) tree)
(setq elem (car elem)))
(if elem (push elem elems))))
(if tree (push tree elems))
(nreverse elems)))
(compat-defun xor (cond1 cond2) "Return the boolean exclusive-or of COND1 and COND2.
If only one of the arguments is non-nil, return it; otherwise
return nil."
(declare (pure t) (side-effect-free error-free))
(cond ((not cond1) cond2)
((not cond2) cond1)))
(compat-defvar regexp-unmatchable "\\`a\\`" "Standard regexp guaranteed not to match any string at all."
:constant t)
(compat-defun assoc-delete-all (key alist &optional test) "Handle optional argument TEST."
:extended "26.2"
(unless test (setq test #'equal))
(while (and (consp (car alist))
(funcall test (caar alist) key))
(setq alist (cdr alist)))
(let ((tail alist) tail-cdr)
(while (setq tail-cdr (cdr tail))
(if (and (consp (car tail-cdr))
(funcall test (caar tail-cdr) key))
(setcdr tail (cdr tail-cdr))
(setq tail tail-cdr))))
alist)
(compat-defvar major-mode--suspended nil "Suspended major mode."
:local permanent)
(compat-defun major-mode-suspend () "Exit current major mode, remembering it."
(let* ((prev-major-mode (or major-mode--suspended
(unless (eq major-mode 'fundamental-mode)
major-mode))))
(kill-all-local-variables)
(setq-local major-mode--suspended prev-major-mode)))
(compat-defun major-mode-restore (&optional avoided-modes) "Restore major mode earlier suspended with `major-mode-suspend'.
If there was no earlier suspended major mode, then fallback to `normal-mode',
though trying to avoid AVOIDED-MODES."
(if major-mode--suspended
(funcall (prog1 major-mode--suspended
(kill-local-variable 'major-mode--suspended)))
(let ((auto-mode-alist
(let ((alist (copy-sequence auto-mode-alist)))
(dolist (mode avoided-modes)
(setq alist (rassq-delete-all mode alist)))
alist))
(magic-fallback-mode-alist
(let ((alist (copy-sequence magic-fallback-mode-alist)))
(dolist (mode avoided-modes)
(setq alist (rassq-delete-all mode alist)))
alist)))
(normal-mode))))
(compat-defun read-char-from-minibuffer-insert-char () "Insert the character you type into the minibuffer and exit minibuffer.
Discard all previous input before inserting and exiting the minibuffer."
(interactive)
(when (minibufferp)
(delete-minibuffer-contents)
(insert last-command-event)
(exit-minibuffer)))
(compat-defun read-char-from-minibuffer-insert-other () "Reject a disallowed character typed into the minibuffer.
This command is intended to be bound to keys that users are not
allowed to type into the minibuffer. When the user types any
such key, this command discard all minibuffer input and displays
an error message."
(interactive)
(when (minibufferp)
(delete-minibuffer-contents)
(ding)
(discard-input)
(minibuffer-message "Wrong answer")
(sit-for 2)))
(compat-defvar read-char-history nil "The default history for the `read-char-from-minibuffer' function.")
(compat-defvar read-char-from-minibuffer-map (let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(define-key map [remap self-insert-command] #'read-char-from-minibuffer-insert-char)
(define-key map [remap exit-minibuffer] #'read-char-from-minibuffer-insert-other)
map)
"Keymap for the `read-char-from-minibuffer' function.")
(compat-defvar read-char-from-minibuffer-map-hash (make-hash-table :test 'equal)
"Hash table of keymaps used by `read-char-from-minibuffer'."
:constant t)
(compat-defun read-char-from-minibuffer (prompt &optional chars history) "Read a character from the minibuffer, prompting for it with PROMPT.
Like `read-char', but uses the minibuffer to read and return a character.
Optional argument CHARS, if non-nil, should be a list of characters;
the function will ignore any input that is not one of CHARS.
Optional argument HISTORY, if non-nil, should be a symbol that
specifies the history list variable to use for navigating in input
history using \\`M-p' and \\`M-n', with \\`RET' to select a character from
history.
If you bind the variable `help-form' to a non-nil value
while calling this function, then pressing `help-char'
causes it to evaluate `help-form' and display the result.
There is no need to explicitly add `help-char' to CHARS;
`help-char' is bound automatically to `help-form-show'."
(let* ((map (if (consp chars)
(or (gethash (list help-form (cons help-char chars))
read-char-from-minibuffer-map-hash)
(let ((map (make-sparse-keymap))
(msg help-form))
(set-keymap-parent map read-char-from-minibuffer-map)
(when help-form
(define-key map (vector help-char)
(lambda ()
(interactive)
(let ((help-form msg)) (help-form-show)))))
(dolist (char chars)
(define-key map (vector char)
#'read-char-from-minibuffer-insert-char))
(define-key map [remap self-insert-command]
#'read-char-from-minibuffer-insert-other)
(puthash (list help-form (cons help-char chars))
map read-char-from-minibuffer-map-hash)
map))
read-char-from-minibuffer-map))
(this-command this-command)
(result (read-from-minibuffer prompt nil map nil (or history t)))
(char
(if (> (length result) 0)
(elt result 0)
(when history (push "\r" (symbol-value history)))
?\r)))
(message "%s%s" prompt (char-to-string char))
char))
(compat-guard (not (fboundp 'decoded-time-second)) (cl-defstruct (decoded-time
(:constructor nil)
(:copier nil)
(:type list))
(second nil :documentation "\
This is an integer or a Lisp timestamp (TICKS . HZ) representing a nonnegative
number of seconds less than 61. (If not less than 60, it is a leap second,
which only some operating systems support.)")
(minute nil :documentation "This is an integer between 0 and 59 (inclusive).")
(hour nil :documentation "This is an integer between 0 and 23 (inclusive).")
(day nil :documentation "This is an integer between 1 and 31 (inclusive).")
(month nil :documentation "\
This is an integer between 1 and 12 (inclusive). January is 1.")
(year nil :documentation "This is a four digit integer.")
(weekday nil :documentation "\
This is a number between 0 and 6, and 0 is Sunday.")
(dst -1 :documentation "\
This is t if daylight saving time is in effect, nil if it is not
in effect, and -1 if daylight saving information is not available.
Also see `decoded-time-dst'.")
(zone nil :documentation "\
This is an integer indicating the UTC offset in seconds, i.e.,
the number of seconds east of Greenwich.")))
(compat-defun minibuffer-history-value () "Return the value of the minibuffer input history list.
If `minibuffer-history-variable' points to a buffer-local variable and
the minibuffer is active, return the buffer-local value for the buffer
that was current when the minibuffer was activated."
(buffer-local-value minibuffer-history-variable
(window-buffer (minibuffer-selected-window))))
(compat-defmacro with-minibuffer-selected-window (&rest body) "Execute the forms in BODY from the minibuffer in its original window.
When used in a minibuffer window, select the window selected just before
the minibuffer was activated, and execute the forms."
(declare (indent 0) (debug t))
`(when-let ((window (minibuffer-selected-window)))
(with-selected-window window
,@body)))
(compat-defmacro with-suppressed-warnings (_warnings &rest body) "Like `progn', but prevents compiler WARNINGS in BODY.
NOTE: The compatibility version behaves like `with-no-warnings'."
`(with-no-warnings ,@body))
(compat-defun image--set-property (image property value) "Set PROPERTY in IMAGE to VALUE, internal use only."
:extended "26.1"
:feature image
(if (null value)
(while (cdr image)
(if (eq (cadr image) property)
(setcdr image (cdddr image))
(setq image (cddr image))))
(setcdr image (plist-put (cdr image) property value)))
value)
(compat-guard (or (= emacs-major-version 26) (not (get 'image-property 'gv-expander)))
:feature image
(gv-define-setter image-property (value image prop)
`(,(if (< emacs-major-version 26) 'image--set-property 'compat--image--set-property)
,image ,prop ,value)))
(compat-defun file-name-quoted-p (name &optional top) "Handle optional argument TOP."
:extended "26.1"
(let ((file-name-handler-alist (unless top file-name-handler-alist)))
(string-prefix-p "/:" (file-local-name name))))
(compat-defun file-name-quote (name &optional top) "Handle optional argument TOP."
:extended "26.1"
(let* ((file-name-handler-alist (unless top file-name-handler-alist))
(localname (file-local-name name)))
(if (string-prefix-p "/:" localname)
name
(concat (file-remote-p name) "/:" localname))))
(compat-defun file-name-unquote (name &optional top) "Handle optional argument TOP."
:extended "26.1"
(let* ((file-name-handler-alist (unless top file-name-handler-alist))
(localname (file-local-name name)))
(when (string-prefix-p "/:" localname)
(setq localname (if (= (length localname) 2) "/" (substring localname 2))))
(concat (file-remote-p name) localname)))
(compat-defun file-size-human-readable (file-size &optional flavor space unit) "Handle the optional arguments SPACE and UNIT."
:extended t
(let ((power (if (or (null flavor) (eq flavor 'iec))
1024.0
1000.0))
(prefixes '("" "k" "M" "G" "T" "P" "E" "Z" "Y")))
(while (and (>= file-size power) (cdr prefixes))
(setq file-size (/ file-size power)
prefixes (cdr prefixes)))
(let* ((prefix (car prefixes))
(prefixed-unit (if (eq flavor 'iec)
(concat
(if (string= prefix "k") "K" prefix)
(if (string= prefix "") "" "i")
(or unit "B"))
(concat prefix unit))))
(format (if (and (>= (mod file-size 1.0) 0.05)
(< (mod file-size 1.0) 0.95))
"%.1f%s%s"
"%.0f%s%s")
file-size
(if (string= prefixed-unit "") "" (or space ""))
prefixed-unit))))
(compat-defun file-size-human-readable-iec (size) "Human-readable string for SIZE bytes, using IEC prefixes."
(compat--file-size-human-readable size 'iec " "))
(compat-defun exec-path () "Return list of directories to search programs to run in remote subprocesses.
The remote host is identified by `default-directory'. For remote
hosts that do not support subprocesses, this returns nil.
If `default-directory' is a local directory, this function returns
the value of the variable `exec-path'."
(let ((handler (find-file-name-handler default-directory 'exec-path)))
(or (and handler (ignore-errors (funcall handler 'exec-path)))
(if (file-remote-p default-directory)
'("/bin" "/usr/bin" "/sbin" "/usr/sbin" "/usr/local/bin" "/usr/local/sbin")
exec-path))))
(compat-defun executable-find (command &optional remote) "Handle optional argument REMOTE."
:extended t
(if (and remote (file-remote-p default-directory))
(let ((res (locate-file
command
(mapcar
(apply-partially
#'concat (file-remote-p default-directory))
(exec-path))
exec-suffixes 'file-executable-p)))
(when (stringp res) (file-local-name res)))
(executable-find command)))
(compat-defun make-empty-file (filename &optional parents) "Create an empty file FILENAME.
Optional arg PARENTS, if non-nil then creates parent dirs as needed."
(when (and (file-exists-p filename) (null parents))
(signal 'file-already-exists (list "File exists" filename)))
(let ((paren-dir (file-name-directory filename)))
(when (and paren-dir (not (file-exists-p paren-dir)))
(make-directory paren-dir parents)))
(write-region "" nil filename nil 0))
(compat-defun regexp-opt (strings &optional paren) "Handle an empty list of STRINGS."
:extended t
(if (null strings)
(let ((re "\\`a\\`"))
(cond ((null paren)
(concat "\\(?:" re "\\)"))
((stringp paren)
(concat paren re "\\)"))
((eq paren 'words)
(concat "\\<\\(" re "\\)\\>"))
((eq paren 'symbols)
(concat "\\_\\(<" re "\\)\\_>"))
((concat "\\(" re "\\)"))))
(regexp-opt strings paren)))
(declare-function lm-header "lisp-mnt")
(declare-function macroexp-file-name nil)
(compat-defun package-get-version () "Return the version number of the package in which this is used.
Assumes it is used from an Elisp file placed inside the top-level directory
of an installed ELPA package.
The return value is a string (or nil in case we can’t find it)."
(declare (pure t))
(let ((file (or (macroexp-file-name) buffer-file-name)))
(cond
((null file) nil)
((string-match
"/[^/]+-\\([0-9]\\(?:[0-9.]\\|pre\\|beta\\|alpha\\|snapshot\\)+\\)/[^/]+\\'"
file)
(match-string 1 file))
((let* ((pkgdir (file-name-directory file))
(pkgname (file-name-nondirectory (directory-file-name pkgdir)))
(mainfile (expand-file-name (concat pkgname ".el") pkgdir)))
(when (file-readable-p mainfile)
(require 'lisp-mnt)
(with-temp-buffer
(insert-file-contents mainfile)
(or (lm-header "package-version")
(lm-header "version")))))))))
(compat-defun dired-get-marked-files
(&optional localp arg filter distinguish-one-marked error)
"Obsolete function."
:obsolete "The compatibility function has been made obsolete."
:feature dired
:extended t
(let ((result (dired-get-marked-files localp arg filter distinguish-one-marked)))
(if (and (null result) error)
(user-error (if (stringp error) error "No files specified"))
result)))
(compat-defun make-decoded-time (&key second minute hour day month year (dst -1) zone)
"Return a `decoded-time' structure with only the keywords given filled out."
:feature time-date
(list second minute hour day month year nil dst zone))
(compat-defun date-days-in-month (year month) "The number of days in MONTH in YEAR."
:feature time-date
(unless (and (numberp month)
(<= 1 month)
(<= month 12))
(error "Month %s is invalid" month))
(if (= month 2)
(if (date-leap-year-p year)
29
28)
(if (memq month '(1 3 5 7 8 10 12))
31
30)))
(compat-defun date-ordinal-to-time (year ordinal) "Convert a YEAR/ORDINAL to the equivalent `decoded-time' structure.
ORDINAL is the number of days since the start of the year, with
January 1st being 1."
(let ((month 1))
(while (> ordinal (date-days-in-month year month))
(setq ordinal (- ordinal (date-days-in-month year month))
month (1+ month)))
(list nil nil nil ordinal month year nil nil nil)))
(declare-function make-prop-match nil)
(compat-guard (not (fboundp 'make-prop-match)) (cl-defstruct (prop-match) beginning end value))
(compat-defun text-property-search-forward (property &optional value predicate not-current)
"Search for the next region of text where PREDICATE is true.
PREDICATE is used to decide whether a value of PROPERTY should be
considered as matching VALUE.
If PREDICATE is a function, it will be called with two arguments:
VALUE and the value of PROPERTY. The function should return
non-nil if these two values are to be considered a match.
Two special values of PREDICATE can also be used:
If PREDICATE is t, that means a value must `equal' VALUE to be
considered a match.
If PREDICATE is nil (which is the default value), a value will
match if is not `equal' to VALUE. Furthermore, a nil PREDICATE
means that the match region is ended if the value changes. For
instance, this means that if you loop with
(while (setq prop (text-property-search-forward \\='face))
...)
you will get all distinct regions with non-nil `face' values in
the buffer, and the `prop' object will have the details about the
match. See the manual for more details and examples about how
VALUE and PREDICATE interact.
If NOT-CURRENT is non-nil, the function will search for the first
region that doesn't include point and has a value of PROPERTY
that matches VALUE.
If no matches can be found, return nil and don't move point.
If found, move point to the end of the region and return a
`prop-match' object describing the match. To access the details
of the match, use `prop-match-beginning' and `prop-match-end' for
the buffer positions that limit the region, and
`prop-match-value' for the value of PROPERTY in the region."
(let* ((match-p
(lambda (prop-value)
(funcall
(cond
((eq predicate t)
#'equal)
((eq predicate nil)
(lambda (val p-val)
(not (equal val p-val))))
(predicate))
value prop-value)))
(find-end
(lambda (start)
(let (end)
(if (and value
(null predicate))
(let ((ended nil))
(while (not ended)
(setq end (next-single-property-change (point) property))
(if (not end)
(progn
(goto-char (point-max))
(setq end (point)
ended t))
(goto-char end)
(unless (funcall match-p (get-text-property (point) property))
(setq ended t)))))
(setq end (next-single-property-change (point) property nil (point-max)))
(goto-char end))
(make-prop-match
:beginning start
:end end
:value (get-text-property start property))))))
(cond
((eobp)
nil)
((and (funcall match-p (get-text-property (point) property))
(not not-current))
(funcall find-end (point)))
(t
(let ((origin (point))
(ended nil)
pos)
(while (not ended)
(setq pos (next-single-property-change (point) property))
(if (not pos)
(progn
(goto-char origin)
(setq ended t))
(goto-char pos)
(if (funcall match-p (get-text-property (point) property))
(setq ended (funcall find-end (point)))
(setq pos (next-single-property-change (point) property))
(unless pos
(goto-char origin)
(setq ended t)))))
(and (not (eq ended t))
ended))))))
(compat-defun text-property-search-backward (property &optional value predicate not-current)
"Search for the previous region of text whose PROPERTY matches VALUE.
Like `text-property-search-forward', which see, but searches backward,
and if a matching region is found, place point at the start of the region."
(let* ((match-p
(lambda (prop-value)
(funcall
(cond
((eq predicate t)
#'equal)
((eq predicate nil)
(lambda (val p-val)
(not (equal val p-val))))
(predicate))
value prop-value)))
(find-end
(lambda (start)
(let (end)
(if (and value
(null predicate))
(let ((ended nil))
(while (not ended)
(setq end (previous-single-property-change (point) property))
(if (not end)
(progn
(goto-char (point-min))
(setq end (point)
ended t))
(goto-char (1- end))
(unless (funcall match-p (get-text-property (point) property))
(goto-char end)
(setq ended t)))))
(setq end (previous-single-property-change
(point) property nil (point-min)))
(goto-char end))
(make-prop-match
:beginning end
:end (1+ start)
:value (get-text-property end property))))))
(cond
((bobp)
nil)
((funcall match-p (get-text-property (1- (point)) property))
(let ((origin (point))
(match (funcall find-end (1- (point)) property value predicate)))
(if (and not-current
(equal (get-text-property (point) property)
(get-text-property origin property)))
(text-property-search-backward property value predicate)
match)))
(t
(let ((origin (point))
(ended nil)
pos)
(while (not ended)
(setq pos (previous-single-property-change (point) property))
(if (not pos)
(progn
(goto-char origin)
(setq ended t))
(goto-char (1- pos))
(if (funcall match-p (get-text-property (point) property))
(setq ended
(funcall find-end (point)))
(setq pos (previous-single-property-change (point) property))
(unless pos
(goto-char origin)
(setq ended t)))))
(and (not (eq ended t))
ended))))))
(compat-defun ring-resize (ring size) "Set the size of RING to SIZE.
If the new size is smaller, then the oldest items in the ring are
discarded."
:feature ring
(when (integerp size)
(let ((length (ring-length ring))
(new-vec (make-vector size nil)))
(if (= length 0)
(setcdr ring (cons 0 new-vec))
(let* ((hd (car ring))
(old-size (ring-size ring))
(old-vec (cddr ring))
(copy-length (min size length))
(copy-hd (mod (+ hd (- length copy-length)) length)))
(setcdr ring (cons copy-length new-vec))
(dotimes (j copy-length)
(aset new-vec j (aref old-vec (mod (+ copy-hd j) old-size))))
(setcar ring 0))))))
(compat-version "26.2")
(compat-defvar read-answer-short 'auto "If non-nil, the `read-answer' function accepts single-character answers.
If t, accept short (single key-press) answers to the question.
If nil, require long answers. If `auto', accept short answers if
`use-short-answers' is non-nil, or the function cell of `yes-or-no-p'
is set to `y-or-n-p'.
Note that this variable does not affect calls to the more
commonly-used `yes-or-no-p' function; it only affects calls to
the `read-answer' function. To control whether `yes-or-no-p'
requires a long or a short answer, see the `use-short-answers'
variable.")
(compat-defun read-answer (question answers) "Read an answer either as a complete word or its character abbreviation.
Ask user a question and accept an answer from the list of possible answers.
QUESTION should end in a space; this function adds a list of answers to it.
ANSWERS is an alist with elements in the following format:
(LONG-ANSWER SHORT-ANSWER HELP-MESSAGE)
where
LONG-ANSWER is a complete answer,
SHORT-ANSWER is an abbreviated one-character answer,
HELP-MESSAGE is a string describing the meaning of the answer.
SHORT-ANSWER is not necessarily a single character answer. It can be
also a function key like F1, a character event such as C-M-h, or
a control character like C-h.
Example:
\\='((\"yes\" ?y \"perform the action\")
(\"no\" ?n \"skip to the next\")
(\"all\" ?! \"accept all remaining without more questions\")
(\"help\" ?h \"show help\")
(\"quit\" ?q \"exit\"))
When `read-answer-short' is non-nil, accept short answers.
Return a long answer even in case of accepting short ones.
When `use-dialog-box' is t, pop up a dialog window to get user input."
(cadr (read-multiple-choice
(string-trim-right question)
(delq nil
(mapcar (lambda (x) (unless (equal "help" (car x))
(list (cadr x) (car x) (caddr x))))
answers)))))
(provide 'compat-27)