diff options
| -rw-r--r-- | lisp/ChangeLog | 4 | ||||
| -rw-r--r-- | lisp/subr.el | 114 |
2 files changed, 47 insertions, 71 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 26f37a7298a..09c5654e767 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2012-04-11 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * subr.el (read-passwd): Use read-string. | ||
| 4 | |||
| 1 | 2012-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org> | 5 | 2012-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 2 | 6 | ||
| 3 | * vcursor.el (vcursor-move): Increase the priority of the overlay | 7 | * vcursor.el (vcursor-move): Increase the priority of the overlay |
diff --git a/lisp/subr.el b/lisp/subr.el index a6ad67283be..0cd00995f45 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -871,6 +871,7 @@ The normal global definition of the character C-x indirects to this keymap.") | |||
| 871 | (defsubst eventp (obj) | 871 | (defsubst eventp (obj) |
| 872 | "True if the argument is an event object." | 872 | "True if the argument is an event object." |
| 873 | (or (and (integerp obj) | 873 | (or (and (integerp obj) |
| 874 | ;; FIXME: Why bother? | ||
| 874 | ;; Filter out integers too large to be events. | 875 | ;; Filter out integers too large to be events. |
| 875 | ;; M is the biggest modifier. | 876 | ;; M is the biggest modifier. |
| 876 | (zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1))))) | 877 | (zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1))))) |
| @@ -1989,6 +1990,10 @@ obey the input decoding and translations usually done by `read-key-sequence'. | |||
| 1989 | So escape sequences and keyboard encoding are taken into account. | 1990 | So escape sequences and keyboard encoding are taken into account. |
| 1990 | When there's an ambiguity because the key looks like the prefix of | 1991 | When there's an ambiguity because the key looks like the prefix of |
| 1991 | some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." | 1992 | some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." |
| 1993 | ;; This overriding-terminal-local-map binding also happens to | ||
| 1994 | ;; disable quail's input methods, so although read-key-sequence | ||
| 1995 | ;; always inherits the input method, in practice read-key does not | ||
| 1996 | ;; inherit the input method (at least not if it's based on quail). | ||
| 1992 | (let ((overriding-terminal-local-map read-key-empty-map) | 1997 | (let ((overriding-terminal-local-map read-key-empty-map) |
| 1993 | (overriding-local-map nil) | 1998 | (overriding-local-map nil) |
| 1994 | (echo-keystrokes 0) | 1999 | (echo-keystrokes 0) |
| @@ -2093,77 +2098,45 @@ Optional DEFAULT is a default password to use instead of empty input. | |||
| 2093 | 2098 | ||
| 2094 | This function echoes `.' for each character that the user types. | 2099 | This function echoes `.' for each character that the user types. |
| 2095 | 2100 | ||
| 2096 | The user ends with RET, LFD, or ESC. DEL or C-h rubs out. | ||
| 2097 | C-y yanks the current kill. C-u kills line. | ||
| 2098 | C-g quits; if `inhibit-quit' was non-nil around this function, | ||
| 2099 | then it returns nil if the user types C-g, but `quit-flag' remains set. | ||
| 2100 | |||
| 2101 | Once the caller uses the password, it can erase the password | 2101 | Once the caller uses the password, it can erase the password |
| 2102 | by doing (clear-string STRING)." | 2102 | by doing (clear-string STRING)." |
| 2103 | (with-local-quit | 2103 | (if confirm |
| 2104 | (if confirm | 2104 | (let (success) |
| 2105 | (let (success) | 2105 | (while (not success) |
| 2106 | (while (not success) | 2106 | (let ((first (read-passwd prompt nil default)) |
| 2107 | (let ((first (read-passwd prompt nil default)) | 2107 | (second (read-passwd "Confirm password: " nil default))) |
| 2108 | (second (read-passwd "Confirm password: " nil default))) | 2108 | (if (equal first second) |
| 2109 | (if (equal first second) | 2109 | (progn |
| 2110 | (progn | 2110 | (and (arrayp second) (clear-string second)) |
| 2111 | (and (arrayp second) (clear-string second)) | 2111 | (setq success first)) |
| 2112 | (setq success first)) | 2112 | (and (arrayp first) (clear-string first)) |
| 2113 | (and (arrayp first) (clear-string first)) | 2113 | (and (arrayp second) (clear-string second)) |
| 2114 | (and (arrayp second) (clear-string second)) | 2114 | (message "Password not repeated accurately; please start over") |
| 2115 | (message "Password not repeated accurately; please start over") | 2115 | (sit-for 1)))) |
| 2116 | (sit-for 1)))) | 2116 | success) |
| 2117 | success) | 2117 | (let (minibuf) |
| 2118 | (let ((pass nil) | 2118 | (minibuffer-with-setup-hook |
| 2119 | ;; Copy it so that add-text-properties won't modify | 2119 | (lambda () |
| 2120 | ;; the object that was passed in by the caller. | 2120 | (setq minibuf (current-buffer)) |
| 2121 | (prompt (copy-sequence prompt)) | 2121 | ;; Turn off electricity. |
| 2122 | (c 0) | 2122 | (set (make-local-variable 'post-self-insert-hook) nil) |
| 2123 | (echo-keystrokes 0) | 2123 | (add-hook 'after-change-functions |
| 2124 | (cursor-in-echo-area t) | 2124 | (lambda (beg end len) |
| 2125 | (message-log-max nil) | 2125 | (clear-this-command-keys) |
| 2126 | (stop-keys (list 'return ?\r ?\n ?\e)) | 2126 | (setq beg (min end (max (minibuffer-prompt-end) |
| 2127 | (rubout-keys (list 'backspace ?\b ?\177))) | 2127 | beg))) |
| 2128 | (add-text-properties 0 (length prompt) | 2128 | (dotimes (i (- end beg)) |
| 2129 | minibuffer-prompt-properties prompt) | 2129 | (put-text-property (+ i beg) (+ 1 i beg) |
| 2130 | (while (progn (message "%s%s" | 2130 | 'display (string ?.)))) |
| 2131 | prompt | 2131 | nil t)) |
| 2132 | (make-string (length pass) ?.)) | 2132 | (unwind-protect |
| 2133 | (setq c (read-key)) | 2133 | (read-string prompt nil |
| 2134 | (not (memq c stop-keys))) | 2134 | (let ((sym (make-symbol "forget-history"))) |
| 2135 | (clear-this-command-keys) | 2135 | (set sym nil) |
| 2136 | (cond ((memq c rubout-keys) ; rubout | 2136 | sym) |
| 2137 | (when (> (length pass) 0) | 2137 | default) |
| 2138 | (let ((new-pass (substring pass 0 -1))) | 2138 | (when (buffer-live-p minibuf) |
| 2139 | (and (arrayp pass) (clear-string pass)) | 2139 | (with-current-buffer minibuf (erase-buffer)))))))) |
| 2140 | (setq pass new-pass)))) | ||
| 2141 | ((eq c ?\C-g) (keyboard-quit)) | ||
| 2142 | ((not (numberp c))) | ||
| 2143 | ((= c ?\C-u) ; kill line | ||
| 2144 | (and (arrayp pass) (clear-string pass)) | ||
| 2145 | (setq pass "")) | ||
| 2146 | ((= c ?\C-y) ; yank | ||
| 2147 | (let* ((str (condition-case nil | ||
| 2148 | (current-kill 0) | ||
| 2149 | (error nil))) | ||
| 2150 | new-pass) | ||
| 2151 | (when str | ||
| 2152 | (setq new-pass | ||
| 2153 | (concat pass | ||
| 2154 | (substring-no-properties str))) | ||
| 2155 | (and (arrayp pass) (clear-string pass)) | ||
| 2156 | (setq c ?\0) | ||
| 2157 | (setq pass new-pass)))) | ||
| 2158 | ((characterp c) ; insert char | ||
| 2159 | (let* ((new-char (char-to-string c)) | ||
| 2160 | (new-pass (concat pass new-char))) | ||
| 2161 | (and (arrayp pass) (clear-string pass)) | ||
| 2162 | (clear-string new-char) | ||
| 2163 | (setq c ?\0) | ||
| 2164 | (setq pass new-pass))))) | ||
| 2165 | (message nil) | ||
| 2166 | (or pass default ""))))) | ||
| 2167 | 2140 | ||
| 2168 | ;; This should be used by `call-interactively' for `n' specs. | 2141 | ;; This should be used by `call-interactively' for `n' specs. |
| 2169 | (defun read-number (prompt &optional default) | 2142 | (defun read-number (prompt &optional default) |
| @@ -3557,8 +3530,7 @@ of STRING. | |||
| 3557 | To replace only the first match (if any), make REGEXP match up to \\' | 3530 | To replace only the first match (if any), make REGEXP match up to \\' |
| 3558 | and replace a sub-expression, e.g. | 3531 | and replace a sub-expression, e.g. |
| 3559 | (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1) | 3532 | (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1) |
| 3560 | => \" bar foo\" | 3533 | => \" bar foo\"" |
| 3561 | " | ||
| 3562 | 3534 | ||
| 3563 | ;; To avoid excessive consing from multiple matches in long strings, | 3535 | ;; To avoid excessive consing from multiple matches in long strings, |
| 3564 | ;; don't just call `replace-match' continually. Walk down the | 3536 | ;; don't just call `replace-match' continually. Walk down the |