aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog4
-rw-r--r--lisp/subr.el114
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 @@
12012-04-11 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * subr.el (read-passwd): Use read-string.
4
12012-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org> 52012-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'.
1989So escape sequences and keyboard encoding are taken into account. 1990So escape sequences and keyboard encoding are taken into account.
1990When there's an ambiguity because the key looks like the prefix of 1991When there's an ambiguity because the key looks like the prefix of
1991some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." 1992some 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
2094This function echoes `.' for each character that the user types. 2099This function echoes `.' for each character that the user types.
2095 2100
2096The user ends with RET, LFD, or ESC. DEL or C-h rubs out.
2097C-y yanks the current kill. C-u kills line.
2098C-g quits; if `inhibit-quit' was non-nil around this function,
2099then it returns nil if the user types C-g, but `quit-flag' remains set.
2100
2101Once the caller uses the password, it can erase the password 2101Once the caller uses the password, it can erase the password
2102by doing (clear-string STRING)." 2102by 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.
3557To replace only the first match (if any), make REGEXP match up to \\' 3530To replace only the first match (if any), make REGEXP match up to \\'
3558and replace a sub-expression, e.g. 3531and 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