Mercurial > emacs
changeset 112163:b30a0deacfdf
New function read-char-choice for reading a restricted set of chars.
* lisp/subr.el (read-char-choice): New function, factored out from
dired-query and hack-local-variables-confirm.
* lisp/dired-aux.el (dired-query):
* lisp/files.el (hack-local-variables-confirm): Use it.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Sat, 08 Jan 2011 14:17:23 -0500 |
| parents | 54ade079a863 |
| children | afa244de82cd |
| files | etc/NEWS lisp/ChangeLog lisp/dired-aux.el lisp/dired.el lisp/files.el lisp/subr.el |
| diffstat | 6 files changed, 190 insertions(+), 170 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/NEWS Sat Jan 08 11:03:31 2011 -0800 +++ b/etc/NEWS Sat Jan 08 14:17:23 2011 -0500 @@ -662,6 +662,9 @@ * Lisp changes in Emacs 24.1 +** New function `read-char-choice' reads a restricted set of characters, +discarding any inputs not inside the set. + ** `y-or-n-p' and `yes-or-no-p' now accept format string arguments. ** `image-library-alist' is renamed to `dynamic-library-alist'.
--- a/lisp/ChangeLog Sat Jan 08 11:03:31 2011 -0800 +++ b/lisp/ChangeLog Sat Jan 08 14:17:23 2011 -0500 @@ -1,3 +1,18 @@ +2011-01-08 Chong Yidong <cyd@stupidchicken.com> + + * subr.el (read-char-choice): New function, factored out from + dired-query and hack-local-variables-confirm. + + * dired-aux.el (dired-query): + * files.el (hack-local-variables-confirm): Use it. + + * dired-aux.el (dired-compress-file): + * files.el (abort-if-file-too-large, find-alternate-file) + (set-visited-file-name, write-file, backup-buffer) + (basic-save-buffer, basic-save-buffer-2, save-some-buffers) + (delete-directory, revert-buffer, recover-file, kill-buffer-ask): + Use new format string args for y-or-n-p and yes-or-no-p. + 2011-01-08 Andreas Schwab <schwab@linux-m68k.org> * progmodes/compile.el (compilation-error-regexp-alist-alist)
--- a/lisp/dired-aux.el Sat Jan 08 11:03:31 2011 -0800 +++ b/lisp/dired-aux.el Sat Jan 08 14:17:23 2011 -0500 @@ -821,8 +821,8 @@ (let ((out-name (concat file ".gz"))) (and (or (not (file-exists-p out-name)) (y-or-n-p - (format "File %s already exists. Really compress? " - out-name))) + "File %s already exists. Really compress? " + out-name)) (not (dired-check-process (concat "Compressing " file) "gzip" "-f" file)) (or (file-exists-p out-name) @@ -889,55 +889,35 @@ (downcase string) count total (dired-plural-s total)) failures))))) -(defvar dired-query-alist - '((?y . y) (?\040 . y) ; `y' or SPC means accept once - (?n . n) (?\177 . n) ; `n' or DEL skips once - (?! . yes) ; `!' accepts rest - (?q . no) (?\e . no) ; `q' or ESC skips rest - ;; None of these keys quit - use C-g for that. - )) +;;;###autoload +(defun dired-query (sym prompt &rest args) + "Format PROMPT with ARGS, query user, and store the result in SYM. +The return value is either nil or t. + +The user may type y or SPC to accept once; n or DEL to skip once; +! to accept this and subsequent queries; or q or ESC to decline +this and subsequent queries. -;;;###autoload -(defun dired-query (qs-var qs-prompt &rest qs-args) - "Query user and return nil or t. -Store answer in symbol VAR (which must initially be bound to nil). -Format PROMPT with ARGS. -Binding variable `help-form' will help the user who types the help key." - (let* ((char (symbol-value qs-var)) - (action (cdr (assoc char dired-query-alist)))) - (cond ((eq 'yes action) - t) ; accept, and don't ask again - ((eq 'no action) - nil) ; skip, and don't ask again - (t;; no lasting effects from last time we asked - ask now - (let ((cursor-in-echo-area t) - (executing-kbd-macro executing-kbd-macro) - (qprompt (concat qs-prompt - (if help-form - (format " [Type yn!q or %s] " - (key-description - (char-to-string help-char))) - " [Type y, n, q or !] "))) - done result elt) - (while (not done) - (apply 'message qprompt qs-args) - (setq char (set qs-var (read-event))) - (if (numberp char) - (cond ((and executing-kbd-macro (= char -1)) - ;; read-event returns -1 if we are in a kbd - ;; macro and there are no more events in the - ;; macro. Attempt to get an event - ;; interactively. - (setq executing-kbd-macro nil)) - ((eq (key-binding (vector char)) 'keyboard-quit) - (keyboard-quit)) - (t - (setq done (setq elt (assoc char - dired-query-alist))))))) - ;; Display the question with the answer. - (message "%s" (concat (apply 'format qprompt qs-args) - (char-to-string char))) - (memq (cdr elt) '(t y yes))))))) +If SYM is already bound to a non-nil value, this function may +return automatically without querying the user. If SYM is !, +return t; if SYM is q or ESC, return nil." + (let* ((char (symbol-value sym)) + (char-choices '(?y ?\s ?n ?\177 ?! ?q ?\e))) + (cond ((eq char ?!) + t) ; accept, and don't ask again + ((memq char '(?q ?\e)) + nil) ; skip, and don't ask again + (t ; no previous answer - ask now + (setq prompt + (concat (apply 'format prompt args) + (if help-form + (format " [Type yn!q or %s] " + (key-description + (char-to-string help-char))) + " [Type y, n, q or !] "))) + (set sym (setq char (read-char-choice prompt char-choices))) + (if (memq char '(?y ?\s ?!)) t))))) + ;;;###autoload (defun dired-do-compress (&optional arg)
--- a/lisp/dired.el Sat Jan 08 11:03:31 2011 -0800 +++ b/lisp/dired.el Sat Jan 08 14:17:23 2011 -0500 @@ -3562,7 +3562,7 @@ ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "2e8658304f56098052e312d01c8763a2") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "db61da0d98435f468e41e92c12f99d3b") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -3723,12 +3723,18 @@ \(fn FILE)" nil nil) (autoload 'dired-query "dired-aux" "\ -Query user and return nil or t. -Store answer in symbol VAR (which must initially be bound to nil). -Format PROMPT with ARGS. -Binding variable `help-form' will help the user who types the help key. - -\(fn QS-VAR QS-PROMPT &rest QS-ARGS)" nil nil) +Format PROMPT with ARGS, query user, and store the result in SYM. +The return value is either nil or t. + +The user may type y or SPC to accept once; n or DEL to skip once; +! to accept this and subsequent queries; or q or ESC to decline +this and subsequent queries. + +If SYM is already bound to a non-nil value, this function may +return automatically without querying the user. If SYM is !, +return t; if SYM is q or ESC, return nil. + +\(fn SYM PROMPT &rest ARGS)" nil nil) (autoload 'dired-do-compress "dired-aux" "\ Compress or uncompress marked (or next ARG) files.
--- a/lisp/files.el Sat Jan 08 11:03:31 2011 -0800 +++ b/lisp/files.el Sat Jan 08 14:17:23 2011 -0500 @@ -1555,8 +1555,8 @@ (unless (run-hook-with-args-until-failure 'kill-buffer-query-functions) (error "Aborted")) (when (and (buffer-modified-p) buffer-file-name) - (if (yes-or-no-p (format "Buffer %s is modified; save it first? " - (buffer-name))) + (if (yes-or-no-p "Buffer %s is modified; save it first? " + (buffer-name)) (save-buffer) (unless (yes-or-no-p "Kill and replace the buffer without saving it? ") (error "Aborted")))) @@ -1758,12 +1758,11 @@ "If file SIZE larger than `large-file-warning-threshold', allow user to abort. OP-TYPE specifies the file operation being performed (for message to user)." (when (and large-file-warning-threshold size - (> size large-file-warning-threshold) - (not (y-or-n-p - (format "File %s is large (%dMB), really %s? " - (file-name-nondirectory filename) - (/ size 1048576) op-type)))) - (error "Aborted"))) + (> size large-file-warning-threshold) + (not (y-or-n-p "File %s is large (%dMB), really %s? " + (file-name-nondirectory filename) + (/ size 1048576) op-type))) + (error "Aborted"))) (defun find-file-noselect (filename &optional nowarn rawfile wildcards) "Read file FILENAME into a buffer and return the buffer. @@ -2906,91 +2905,80 @@ directory-local variables, or nil otherwise." (if noninteractive nil - (let ((name (or dir-name - (if buffer-file-name - (file-name-nondirectory buffer-file-name) - (concat "buffer " (buffer-name))))) - (offer-save (and (eq enable-local-variables t) unsafe-vars)) - prompt char) - (save-window-excursion - (let ((buf (get-buffer-create "*Local Variables*"))) - (pop-to-buffer buf) - (set (make-local-variable 'cursor-type) nil) - (erase-buffer) - (if unsafe-vars - (insert "The local variables list in " name - "\ncontains values that may not be safe (*)" - (if risky-vars - ", and variables that are risky (**)." - ".")) - (if risky-vars - (insert "The local variables list in " name - "\ncontains variables that are risky (**).") - (insert "A local variables list is specified in " name "."))) - (insert "\n\nDo you want to apply it? You can type + (save-window-excursion + (let* ((name (or dir-name + (if buffer-file-name + (file-name-nondirectory buffer-file-name) + (concat "buffer " (buffer-name))))) + (offer-save (and (eq enable-local-variables t) + unsafe-vars)) + (exit-chars + (if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g))) + (buf (pop-to-buffer "*Local Variables*")) + prompt char) + (set (make-local-variable 'cursor-type) nil) + (erase-buffer) + (cond + (unsafe-vars + (insert "The local variables list in " name + "\ncontains values that may not be safe (*)" + (if risky-vars + ", and variables that are risky (**)." + "."))) + (risky-vars + (insert "The local variables list in " name + "\ncontains variables that are risky (**).")) + (t + (insert "A local variables list is specified in " name "."))) + (insert "\n\nDo you want to apply it? You can type y -- to apply the local variables list. n -- to ignore the local variables list.") - (if offer-save - (insert " + (if offer-save + (insert " ! -- to apply the local variables list, and permanently mark these values (*) as safe (in the future, they will be set automatically.)\n\n") - (insert "\n\n")) - (dolist (elt all-vars) - (cond ((member elt unsafe-vars) - (insert " * ")) - ((member elt risky-vars) - (insert " ** ")) - (t - (insert " "))) - (princ (car elt) buf) - (insert " : ") - ;; Make strings with embedded whitespace easier to read. - (let ((print-escape-newlines t)) - (prin1 (cdr elt) buf)) - (insert "\n")) - (setq prompt - (format "Please type %s%s: " - (if offer-save "y, n, or !" "y or n") - (if (< (line-number-at-pos) (window-body-height)) - "" - ", or C-v to scroll"))) - (goto-char (point-min)) - (let ((cursor-in-echo-area t) - (executing-kbd-macro executing-kbd-macro) - (exit-chars - (if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g))) - done) - (while (not done) - (message "%s" prompt) - (setq char (read-event)) - (if (numberp char) - (cond ((eq char ?\C-v) - (condition-case nil - (scroll-up) - (error (goto-char (point-min))))) - ;; read-event returns -1 if we are in a kbd - ;; macro and there are no more events in the - ;; macro. In that case, attempt to get an - ;; event interactively. - ((and executing-kbd-macro (= char -1)) - (setq executing-kbd-macro nil)) - (t (setq done (memq (downcase char) exit-chars))))))) - (setq char (downcase char)) - (when (and offer-save (= char ?!) unsafe-vars) - (dolist (elt unsafe-vars) - (add-to-list 'safe-local-variable-values elt)) - ;; When this is called from desktop-restore-file-buffer, - ;; coding-system-for-read may be non-nil. Reset it before - ;; writing to .emacs. - (if (or custom-file user-init-file) - (let ((coding-system-for-read nil)) - (customize-save-variable - 'safe-local-variable-values - safe-local-variable-values)))) - (kill-buffer buf) - (or (= char ?!) - (= char ?\s) - (= char ?y))))))) + (insert "\n\n")) + (dolist (elt all-vars) + (cond ((member elt unsafe-vars) + (insert " * ")) + ((member elt risky-vars) + (insert " ** ")) + (t + (insert " "))) + (princ (car elt) buf) + (insert " : ") + ;; Make strings with embedded whitespace easier to read. + (let ((print-escape-newlines t)) + (prin1 (cdr elt) buf)) + (insert "\n")) + (setq prompt + (format "Please type %s%s: " + (if offer-save "y, n, or !" "y or n") + (if (< (line-number-at-pos) (window-body-height)) + "" + (push ?\C-v exit-chars) + ", or C-v to scroll"))) + (goto-char (point-min)) + (while (null char) + (setq char (read-char-choice prompt exit-chars t)) + (when (eq char ?\C-v) + (condition-case nil + (scroll-up) + (error (goto-char (point-min)))) + (setq char nil))) + (kill-buffer buf) + (when (and offer-save (= char ?!) unsafe-vars) + (dolist (elt unsafe-vars) + (add-to-list 'safe-local-variable-values elt)) + ;; When this is called from desktop-restore-file-buffer, + ;; coding-system-for-read may be non-nil. Reset it before + ;; writing to .emacs. + (if (or custom-file user-init-file) + (let ((coding-system-for-read nil)) + (customize-save-variable + 'safe-local-variable-values + safe-local-variable-values)))) + (memq char '(?! ?\s ?y)))))) (defun hack-local-variables-prop-line (&optional mode-only) "Return local variables specified in the -*- line. @@ -3593,8 +3581,8 @@ (let ((buffer (and filename (find-buffer-visiting filename)))) (and buffer (not (eq buffer (current-buffer))) (not no-query) - (not (y-or-n-p (format "A buffer is visiting %s; proceed? " - filename))) + (not (y-or-n-p "A buffer is visiting %s; proceed? " + filename)) (error "Aborted"))) (or (equal filename buffer-file-name) (progn @@ -3705,7 +3693,7 @@ (or buffer-file-name (buffer-name)))))) (and confirm (file-exists-p filename) - (or (y-or-n-p (format "File `%s' exists; overwrite? " filename)) + (or (y-or-n-p "File `%s' exists; overwrite? " filename) (error "Canceled"))) (set-visited-file-name filename (not confirm)))) (set-buffer-modified-p t) @@ -3759,8 +3747,8 @@ (and targets (or (eq delete-old-versions t) (eq delete-old-versions nil)) (or delete-old-versions - (y-or-n-p (format "Delete excess backup versions of %s? " - real-file-name))))) + (y-or-n-p "Delete excess backup versions of %s? " + real-file-name)))) (modes (file-modes buffer-file-name)) (context (file-selinux-context buffer-file-name))) ;; Actually write the back up file. @@ -4334,8 +4322,8 @@ ;; Signal an error if the user specified the name of an ;; existing directory. (error "%s is a directory" filename) - (unless (y-or-n-p (format "File `%s' exists; overwrite? " - filename)) + (unless (y-or-n-p "File `%s' exists; overwrite? " + filename) (error "Canceled"))) ;; Signal an error if the specified name refers to a ;; non-existing directory. @@ -4348,8 +4336,8 @@ (or (verify-visited-file-modtime (current-buffer)) (not (file-exists-p buffer-file-name)) (yes-or-no-p - (format "%s has changed since visited or saved. Save anyway? " - (file-name-nondirectory buffer-file-name))) + "%s has changed since visited or saved. Save anyway? " + (file-name-nondirectory buffer-file-name)) (error "Save not confirmed")) (save-restriction (widen) @@ -4363,8 +4351,8 @@ (eq require-final-newline 'visit-save) (and require-final-newline (y-or-n-p - (format "Buffer %s does not end in newline. Add one? " - (buffer-name))))) + "Buffer %s does not end in newline. Add one? " + (buffer-name)))) (save-excursion (goto-char (point-max)) (insert ?\n)))) @@ -4426,9 +4414,9 @@ (if (not (file-exists-p buffer-file-name)) (error "Directory %s write-protected" dir) (if (yes-or-no-p - (format "File %s is write-protected; try to save anyway? " - (file-name-nondirectory - buffer-file-name))) + "File %s is write-protected; try to save anyway? " + (file-name-nondirectory + buffer-file-name)) (setq tempsetmodes t) (error "Attempt to save to a file which you aren't allowed to write")))))) (or buffer-backed-up @@ -4619,8 +4607,7 @@ (progn (if (or arg (eq save-abbrevs 'silently) - (y-or-n-p (format "Save abbrevs in %s? " - abbrev-file-name))) + (y-or-n-p "Save abbrevs in %s? " abbrev-file-name)) (write-abbrev-file nil)) ;; Don't keep bothering user if he says no. (setq abbrevs-changed nil) @@ -4795,8 +4782,8 @@ (list dir (if (directory-files dir nil directory-files-no-dot-files-regexp) (y-or-n-p - (format "Directory `%s' is not empty, really %s? " - dir (if trashing "trash" "delete"))) + "Directory `%s' is not empty, really %s? " + dir (if trashing "trash" "delete")) nil) (null current-prefix-arg)))) ;; If default-directory is a remote directory, make sure we find its @@ -4995,8 +4982,8 @@ (dolist (regexp revert-without-query) (when (string-match regexp file-name) (throw 'found t))))) - (yes-or-no-p (format "Revert buffer from file %s? " - file-name))) + (yes-or-no-p "Revert buffer from file %s? " + file-name)) (run-hooks 'before-revert-hook) ;; If file was backed up but has changed since, ;; we should make another backup. @@ -5116,7 +5103,7 @@ ;; to emulate what `ls' did in that case. (insert-directory-safely file switches) (insert-directory-safely file-name switches)))) - (yes-or-no-p (format "Recover auto save file %s? " file-name))) + (yes-or-no-p "Recover auto save file %s? " file-name)) (switch-to-buffer (find-file-noselect file t)) (let ((inhibit-read-only t) ;; Keep the current buffer-file-coding-system. @@ -5237,9 +5224,9 @@ (defun kill-buffer-ask (buffer) "Kill BUFFER if confirmed." (when (yes-or-no-p - (format "Buffer %s %s. Kill? " (buffer-name buffer) - (if (buffer-modified-p buffer) - "HAS BEEN EDITED" "is unmodified"))) + "Buffer %s %s. Kill? " (buffer-name buffer) + (if (buffer-modified-p buffer) + "HAS BEEN EDITED" "is unmodified")) (kill-buffer buffer))) (defun kill-some-buffers (&optional list)
--- a/lisp/subr.el Sat Jan 08 11:03:31 2011 -0800 +++ b/lisp/subr.el Sat Jan 08 14:17:23 2011 -0500 @@ -1970,6 +1970,35 @@ t))) n)) +(defun read-char-choice (prompt chars &optional inhibit-keyboard-quit) + "Read and return one of CHARS, prompting for PROMPT. +Any input that is not one of CHARS is ignored. + +If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore +keyboard-quit events while waiting for a valid input." + (unless (consp chars) + (error "Called `read-char-choice' without valid char choices")) + (let ((cursor-in-echo-area t) + (executing-kbd-macro executing-kbd-macro) + char done) + (while (not done) + (unless (get-text-property 0 'face prompt) + (setq prompt (propertize prompt 'face 'minibuffer-prompt))) + (setq char (let ((inhibit-quit inhibit-keyboard-quit)) + (read-event prompt))) + (cond + ((not (numberp char))) + ((memq char chars) + (setq done t)) + ((and executing-kbd-macro (= char -1)) + ;; read-event returns -1 if we are in a kbd macro and + ;; there are no more events in the macro. Attempt to + ;; get an event interactively. + (setq executing-kbd-macro nil)))) + ;; Display the question with the answer. + (message "%s%s" prompt (char-to-string char)) + char)) + (defun sit-for (seconds &optional nodisp obsolete) "Perform redisplay, then wait for SECONDS seconds or until input is available. SECONDS may be a floating-point value.