diff options
| author | Chong Yidong | 2011-01-07 12:34:02 -0500 |
|---|---|---|
| committer | Chong Yidong | 2011-01-07 12:34:02 -0500 |
| commit | 8c51d2a2c2dcae4e54a7e5aa7543a3ecb8d7d886 (patch) | |
| tree | 46b8e5d3a0becbf28e17c17ed3ae58208585dd3c /lisp | |
| parent | 3162010355ae4934296cf3e4e7fcd20197e9887a (diff) | |
| download | emacs-8c51d2a2c2dcae4e54a7e5aa7543a3ecb8d7d886.tar.gz emacs-8c51d2a2c2dcae4e54a7e5aa7543a3ecb8d7d886.zip | |
Allow format args for y-or-n-p and yes-or-no-p.
* lisp/subr.el (y-or-n-p): Accept format string args.
* src/fns.c (Fyes_or_no_p): Accept format string args.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 4 | ||||
| -rw-r--r-- | lisp/subr.el | 99 |
2 files changed, 53 insertions, 50 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index faec22993fa..22b0818b2bb 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2011-01-07 Chong Yidong <cyd@stupidchicken.com> | ||
| 2 | |||
| 3 | * subr.el (y-or-n-p): Accept format string args. | ||
| 4 | |||
| 1 | 2011-01-07 Glenn Morris <rgm@gnu.org> | 5 | 2011-01-07 Glenn Morris <rgm@gnu.org> |
| 2 | 6 | ||
| 3 | * Makefile.in (EMACSOPT): Add --no-site-lisp. | 7 | * Makefile.in (EMACSOPT): Add --no-site-lisp. |
diff --git a/lisp/subr.el b/lisp/subr.el index 8a8e4410ce6..ce0149a477b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -2011,6 +2011,55 @@ floating point support." | |||
| 2011 | (push read unread-command-events) | 2011 | (push read unread-command-events) |
| 2012 | nil)))))) | 2012 | nil)))))) |
| 2013 | (set-advertised-calling-convention 'sit-for '(seconds &optional nodisp) "22.1") | 2013 | (set-advertised-calling-convention 'sit-for '(seconds &optional nodisp) "22.1") |
| 2014 | |||
| 2015 | (defun y-or-n-p (prompt &rest args) | ||
| 2016 | "Ask user a \"y or n\" question. Return t if answer is \"y\". | ||
| 2017 | The argument PROMPT is the string to display to ask the question. | ||
| 2018 | It should end in a space; `y-or-n-p' adds `(y or n) ' to it. | ||
| 2019 | No confirmation of the answer is requested; a single character is enough. | ||
| 2020 | Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses | ||
| 2021 | the bindings in `query-replace-map'; see the documentation of that variable | ||
| 2022 | for more information. In this case, the useful bindings are `act', `skip', | ||
| 2023 | `recenter', and `quit'.\) | ||
| 2024 | |||
| 2025 | Under a windowing system a dialog box will be used if `last-nonmenu-event' | ||
| 2026 | is nil and `use-dialog-box' is non-nil." | ||
| 2027 | ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state | ||
| 2028 | ;; where all the keys were unbound (i.e. it somehow got triggered | ||
| 2029 | ;; within read-key, apparently). I had to kill it. | ||
| 2030 | (let ((answer 'recenter)) | ||
| 2031 | (if (and (display-popup-menus-p) | ||
| 2032 | (listp last-nonmenu-event) | ||
| 2033 | use-dialog-box) | ||
| 2034 | (setq answer | ||
| 2035 | (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip)))) | ||
| 2036 | (setq prompt (concat (apply 'format prompt args) | ||
| 2037 | (if (eq ?\s (aref prompt (1- (length prompt)))) | ||
| 2038 | "" " ") | ||
| 2039 | "(y or n) ")) | ||
| 2040 | (while | ||
| 2041 | (let* ((key | ||
| 2042 | (let ((cursor-in-echo-area t)) | ||
| 2043 | (when minibuffer-auto-raise | ||
| 2044 | (raise-frame (window-frame (minibuffer-window)))) | ||
| 2045 | (read-key (propertize (if (eq answer 'recenter) | ||
| 2046 | prompt | ||
| 2047 | (concat "Please answer y or n. " | ||
| 2048 | prompt)) | ||
| 2049 | 'face 'minibuffer-prompt))))) | ||
| 2050 | (setq answer (lookup-key query-replace-map (vector key) t)) | ||
| 2051 | (cond | ||
| 2052 | ((memq answer '(skip act)) nil) | ||
| 2053 | ((eq answer 'recenter) (recenter) t) | ||
| 2054 | ((memq answer '(exit-prefix quit)) (signal 'quit nil) t) | ||
| 2055 | (t t))) | ||
| 2056 | (ding) | ||
| 2057 | (discard-input))) | ||
| 2058 | (let ((ret (eq answer 'act))) | ||
| 2059 | (unless noninteractive | ||
| 2060 | (message "%s %s" prompt (if ret "y" "n"))) | ||
| 2061 | ret))) | ||
| 2062 | |||
| 2014 | 2063 | ||
| 2015 | ;;; Atomic change groups. | 2064 | ;;; Atomic change groups. |
| 2016 | 2065 | ||
| @@ -3305,56 +3354,6 @@ clone should be incorporated in the clone." | |||
| 3305 | (overlay-put ol2 'evaporate t) | 3354 | (overlay-put ol2 'evaporate t) |
| 3306 | (overlay-put ol2 'text-clones dups))) | 3355 | (overlay-put ol2 'text-clones dups))) |
| 3307 | 3356 | ||
| 3308 | ;;;; Misc functions moved over from the C side. | ||
| 3309 | |||
| 3310 | (defun y-or-n-p (prompt) | ||
| 3311 | "Ask user a \"y or n\" question. Return t if answer is \"y\". | ||
| 3312 | The argument PROMPT is the string to display to ask the question. | ||
| 3313 | It should end in a space; `y-or-n-p' adds `(y or n) ' to it. | ||
| 3314 | No confirmation of the answer is requested; a single character is enough. | ||
| 3315 | Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses | ||
| 3316 | the bindings in `query-replace-map'; see the documentation of that variable | ||
| 3317 | for more information. In this case, the useful bindings are `act', `skip', | ||
| 3318 | `recenter', and `quit'.\) | ||
| 3319 | |||
| 3320 | Under a windowing system a dialog box will be used if `last-nonmenu-event' | ||
| 3321 | is nil and `use-dialog-box' is non-nil." | ||
| 3322 | ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state | ||
| 3323 | ;; where all the keys were unbound (i.e. it somehow got triggered | ||
| 3324 | ;; within read-key, apparently). I had to kill it. | ||
| 3325 | (let ((answer 'recenter)) | ||
| 3326 | (if (and (display-popup-menus-p) | ||
| 3327 | (listp last-nonmenu-event) | ||
| 3328 | use-dialog-box) | ||
| 3329 | (setq answer | ||
| 3330 | (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip)))) | ||
| 3331 | (setq prompt (concat prompt | ||
| 3332 | (if (eq ?\s (aref prompt (1- (length prompt)))) | ||
| 3333 | "" " ") | ||
| 3334 | "(y or n) ")) | ||
| 3335 | (while | ||
| 3336 | (let* ((key | ||
| 3337 | (let ((cursor-in-echo-area t)) | ||
| 3338 | (when minibuffer-auto-raise | ||
| 3339 | (raise-frame (window-frame (minibuffer-window)))) | ||
| 3340 | (read-key (propertize (if (eq answer 'recenter) | ||
| 3341 | prompt | ||
| 3342 | (concat "Please answer y or n. " | ||
| 3343 | prompt)) | ||
| 3344 | 'face 'minibuffer-prompt))))) | ||
| 3345 | (setq answer (lookup-key query-replace-map (vector key) t)) | ||
| 3346 | (cond | ||
| 3347 | ((memq answer '(skip act)) nil) | ||
| 3348 | ((eq answer 'recenter) (recenter) t) | ||
| 3349 | ((memq answer '(exit-prefix quit)) (signal 'quit nil) t) | ||
| 3350 | (t t))) | ||
| 3351 | (ding) | ||
| 3352 | (discard-input))) | ||
| 3353 | (let ((ret (eq answer 'act))) | ||
| 3354 | (unless noninteractive | ||
| 3355 | (message "%s %s" prompt (if ret "y" "n"))) | ||
| 3356 | ret))) | ||
| 3357 | |||
| 3358 | ;;;; Mail user agents. | 3357 | ;;;; Mail user agents. |
| 3359 | 3358 | ||
| 3360 | ;; Here we include just enough for other packages to be able | 3359 | ;; Here we include just enough for other packages to be able |