Commit 3ef01959 authored by Chong Yidong's avatar Chong Yidong

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.
parent 72427c46
......@@ -662,6 +662,9 @@ sc.el, x-menu.el, rnews.el, rnewspost.el
* 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'.
......
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)
......
......@@ -821,8 +821,8 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.")
(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 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.")
(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)
......
......@@ -3562,7 +3562,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
;;;;;; 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 @@ Not documented
\(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.
Format PROMPT with ARGS, query user, and store the result in SYM.
The return value is either nil or t.
\(fn QS-VAR QS-PROMPT &rest QS-ARGS)" nil nil)
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.
......
......@@ -1555,8 +1555,8 @@ killed."
(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 @@ When nil, never request confirmation."
"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 @@ DIR-NAME is a directory name if these settings come from
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 @@ the old visited file has been renamed to the new name FILENAME."
(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 @@ Interactively, confirmation is required unless you supply a prefix argument."
(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 @@ BACKUPNAME is the backup file name, which is the old file renamed."
(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 @@ Before and after saving the buffer, this function runs
;; 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 @@ Before and after saving the buffer, this function runs
(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 @@ Before and after saving the buffer, this function runs
(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 @@ Before and after saving the buffer, this function runs
(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 @@ change the additional actions you can take on files."
(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 @@ given. With a prefix argument, TRASH is nil."
(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 @@ non-nil, it is called instead of rereading visited file contents."
(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 @@ non-nil, it is called instead of rereading visited file contents."
;; 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 @@ This command is used in the special Dired buffer created by
(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)
......
......@@ -1970,6 +1970,35 @@ The value of DEFAULT is inserted into PROMPT."
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.
......
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