[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r102792: New function read-char-choic
|
From: |
Chong Yidong |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r102792: New function read-char-choice for reading a restricted set of chars. |
|
Date: |
Sat, 08 Jan 2011 14:17:23 -0500 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 102792
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sat 2011-01-08 14:17:23 -0500
message:
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.
modified:
etc/NEWS
lisp/ChangeLog
lisp/dired-aux.el
lisp/dired.el
lisp/files.el
lisp/subr.el
=== modified file 'etc/NEWS'
--- a/etc/NEWS 2011-01-07 17:34:02 +0000
+++ b/etc/NEWS 2011-01-08 19:17:23 +0000
@@ -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'.
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2011-01-08 13:32:31 +0000
+++ b/lisp/ChangeLog 2011-01-08 19:17:23 +0000
@@ -1,3 +1,18 @@
+2011-01-08 Chong Yidong <address@hidden>
+
+ * 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 <address@hidden>
* progmodes/compile.el (compilation-error-regexp-alist-alist)
=== modified file 'lisp/dired-aux.el'
--- a/lisp/dired-aux.el 2010-12-13 15:27:36 +0000
+++ b/lisp/dired-aux.el 2011-01-08 19:17:23 +0000
@@ -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 (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)))))))
+(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.
+
+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)
=== modified file 'lisp/dired.el'
--- a/lisp/dired.el 2010-12-14 04:35:33 +0000
+++ b/lisp/dired.el 2011-01-08 19:17:23 +0000
@@ -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.
=== modified file 'lisp/files.el'
--- a/lisp/files.el 2011-01-02 20:28:40 +0000
+++ b/lisp/files.el 2011-01-08 19:17:23 +0000
@@ -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)
=== modified file 'lisp/subr.el'
--- a/lisp/subr.el 2011-01-07 17:34:02 +0000
+++ b/lisp/subr.el 2011-01-08 19:17:23 +0000
@@ -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.
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r102792: New function read-char-choice for reading a restricted set of chars.,
Chong Yidong <=