Mercurial > emacs
comparison lisp/subr.el @ 99632:73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Sun, 16 Nov 2008 21:02:05 +0000 |
| parents | a1ebcf06b544 |
| children | 9e18920d7076 |
comparison
equal
deleted
inserted
replaced
| 99631:ba528e468910 | 99632:73ea1a22b6f4 |
|---|---|
| 1809 ;; the object that was passed in by the caller. | 1809 ;; the object that was passed in by the caller. |
| 1810 (prompt (copy-sequence prompt)) | 1810 (prompt (copy-sequence prompt)) |
| 1811 (c 0) | 1811 (c 0) |
| 1812 (echo-keystrokes 0) | 1812 (echo-keystrokes 0) |
| 1813 (cursor-in-echo-area t) | 1813 (cursor-in-echo-area t) |
| 1814 (message-log-max nil)) | 1814 (message-log-max nil) |
| 1815 (stop-keys (list 'return ?\r ?\n ?\e)) | |
| 1816 (rubout-keys (list 'backspace ?\b ?\177))) | |
| 1815 (add-text-properties 0 (length prompt) | 1817 (add-text-properties 0 (length prompt) |
| 1816 minibuffer-prompt-properties prompt) | 1818 minibuffer-prompt-properties prompt) |
| 1817 (while (progn (message "%s%s" | 1819 (while (progn (message "%s%s" |
| 1818 prompt | 1820 prompt |
| 1819 (make-string (length pass) ?.)) | 1821 (make-string (length pass) ?.)) |
| 1820 (setq c (read-char-exclusive nil t)) | 1822 ;; We used to use read-char-exclusive, that that |
| 1821 (and (/= c ?\r) (/= c ?\n) (/= c ?\e))) | 1823 ;; gives funny behavior when the user presses, |
| 1824 ;; e.g., the arrow keys. | |
| 1825 (setq c (read-event nil t)) | |
| 1826 (not (memq c stop-keys))) | |
| 1822 (clear-this-command-keys) | 1827 (clear-this-command-keys) |
| 1823 (cond ((= c ?\C-u) ; kill line | 1828 (cond ((memq c rubout-keys) ; rubout |
| 1829 (when (> (length pass) 0) | |
| 1830 (let ((new-pass (substring pass 0 -1))) | |
| 1831 (and (arrayp pass) (clear-string pass)) | |
| 1832 (setq pass new-pass)))) | |
| 1833 ((not (numberp c))) | |
| 1834 ((= c ?\C-u) ; kill line | |
| 1824 (and (arrayp pass) (clear-string pass)) | 1835 (and (arrayp pass) (clear-string pass)) |
| 1825 (setq pass "")) | 1836 (setq pass "")) |
| 1826 ((= c ?\C-y) ; yank | 1837 ((= c ?\C-y) ; yank |
| 1827 (let* ((str (condition-case nil | 1838 (let* ((str (condition-case nil |
| 1828 (current-kill 0) | 1839 (current-kill 0) |
| 1833 (concat pass | 1844 (concat pass |
| 1834 (substring-no-properties str))) | 1845 (substring-no-properties str))) |
| 1835 (and (arrayp pass) (clear-string pass)) | 1846 (and (arrayp pass) (clear-string pass)) |
| 1836 (setq c ?\0) | 1847 (setq c ?\0) |
| 1837 (setq pass new-pass)))) | 1848 (setq pass new-pass)))) |
| 1838 ((and (/= c ?\b) (/= c ?\177)) ; insert char | 1849 ((characterp c) ; insert char |
| 1839 (let* ((new-char (char-to-string c)) | 1850 (let* ((new-char (char-to-string c)) |
| 1840 (new-pass (concat pass new-char))) | 1851 (new-pass (concat pass new-char))) |
| 1841 (and (arrayp pass) (clear-string pass)) | 1852 (and (arrayp pass) (clear-string pass)) |
| 1842 (clear-string new-char) | 1853 (clear-string new-char) |
| 1843 (setq c ?\0) | 1854 (setq c ?\0) |
| 1844 (setq pass new-pass))) | |
| 1845 ((> (length pass) 0) ; rubout | |
| 1846 (let ((new-pass (substring pass 0 -1))) | |
| 1847 (and (arrayp pass) (clear-string pass)) | |
| 1848 (setq pass new-pass))))) | 1855 (setq pass new-pass))))) |
| 1849 (message nil) | 1856 (message nil) |
| 1850 (or pass default ""))))) | 1857 (or pass default ""))))) |
| 1851 | 1858 |
| 1852 ;; This should be used by `call-interactively' for `n' specs. | 1859 ;; This should be used by `call-interactively' for `n' specs. |