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. |
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)) |