/[emacs]/emacs/lisp/subr.el
ViewVC logotype

Diff of /emacs/lisp/subr.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.346 by handa, Thu Apr 3 02:49:16 2003 UTC revision 1.347 by rms, Thu Apr 3 23:13:38 2003 UTC
# Line 1104  any other terminator is used itself as i Line 1104  any other terminator is used itself as i
1104  The optional argument PROMPT specifies a string to use to prompt the user.  The optional argument PROMPT specifies a string to use to prompt the user.
1105  The variable `read-quoted-char-radix' controls which radix to use  The variable `read-quoted-char-radix' controls which radix to use
1106  for numeric input."  for numeric input."
1107    (let ((message-log-max nil) done (first t) (code 0) char)    (let ((message-log-max nil) done (first t) (code 0) char translated)
1108      (while (not done)      (while (not done)
1109        (let ((inhibit-quit first)        (let ((inhibit-quit first)
1110              ;; Don't let C-h get the help message--only help function keys.              ;; Don't let C-h get the help message--only help function keys.
# Line 1121  any other non-digit terminates the chara Line 1121  any other non-digit terminates the chara
1121        ;; We could try and use read-key-sequence instead, but then C-q ESC        ;; We could try and use read-key-sequence instead, but then C-q ESC
1122        ;; or C-q C-x might not return immediately since ESC or C-x might be        ;; or C-q C-x might not return immediately since ESC or C-x might be
1123        ;; bound to some prefix in function-key-map or key-translation-map.        ;; bound to some prefix in function-key-map or key-translation-map.
1124        (and char        (setq translated char)
1125             (let ((translated (lookup-key function-key-map (vector char))))        (let ((translation (lookup-key function-key-map (vector char))))
1126               (if (arrayp translated)          (if (arrayp translation)
1127                   (setq char (aref translated 0)))))              (setq translated (aref translation 0))))
1128        (cond ((null char))        (cond ((null translated))
1129              ((not (integerp char))              ((not (integerp translated))
1130               (setq unread-command-events (listify-key-sequence (this-single-command-raw-keys))               (setq unread-command-events (list char)
1131                     done t))                     done t))
1132              ((/= (logand char ?\M-\^@) 0)              ((/= (logand translated ?\M-\^@) 0)
1133               ;; Turn a meta-character into a character with the 0200 bit set.               ;; Turn a meta-character into a character with the 0200 bit set.
1134               (setq code (logior (logand char (lognot ?\M-\^@)) 128)               (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
1135                     done t))                     done t))
1136              ((and (<= ?0 char) (< char (+ ?0 (min 10 read-quoted-char-radix))))              ((and (<= ?0 translated) (< translated (+ ?0 (min 10 read-quoted-char-radix))))
1137               (setq code (+ (* code read-quoted-char-radix) (- char ?0)))               (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
1138               (and prompt (setq prompt (message "%s %c" prompt char))))               (and prompt (setq prompt (message "%s %c" prompt translated))))
1139              ((and (<= ?a (downcase char))              ((and (<= ?a (downcase translated))
1140                    (< (downcase char) (+ ?a -10 (min 26 read-quoted-char-radix))))                    (< (downcase translated) (+ ?a -10 (min 26 read-quoted-char-radix))))
1141               (setq code (+ (* code read-quoted-char-radix)               (setq code (+ (* code read-quoted-char-radix)
1142                             (+ 10 (- (downcase char) ?a))))                             (+ 10 (- (downcase translated) ?a))))
1143               (and prompt (setq prompt (message "%s %c" prompt char))))               (and prompt (setq prompt (message "%s %c" prompt translated))))
1144              ((and (not first) (eq char ?\C-m))              ((and (not first) (eq translated ?\C-m))
1145               (setq done t))               (setq done t))
1146              ((not first)              ((not first)
1147               (setq unread-command-events (listify-key-sequence (this-single-command-raw-keys))               (setq unread-command-events (list char)
1148                     done t))                     done t))
1149              (t (setq code char              (t (setq code translated
1150                       done t)))                       done t)))
1151        (setq first nil))        (setq first nil))
1152      code))      code))

Legend:
Removed from v.1.346  
changed lines
  Added in v.1.347

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26