(read-quoted-char): Convert function keys like Return

[bpt/emacs.git] / lisp / subr.el

diff --git a/lisp/subr.el b/lisp/subr.el
index f4a457a..14ae2ba 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -20,7 +20,15 @@
 ;; Boston, MA 02111-1307, USA.
 
 ;;; Code:
-
+(defvar custom-declare-variable-list nil
+  "Record `defcustom' calls made before `custom.el' is loaded to handle them.
+Each element of this list holds the arguments to one call to `defcustom'.")
+
+;; Use this rather that defcustom, in subr.el and other files loaded
+;; before custom.el.
+(defun custom-declare-variable-early (&rest arguments)
+  (setq custom-declare-variable-list
+       (cons arguments custom-declare-variable-list)))
 \f
 ;;;; Lisp language features.
 
@@ -145,7 +153,7 @@ in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP."
                    (substitute-key-definition olddef newdef keymap
                                               inner-def
                                               prefix1)))))
-       (if (arrayp (car scan))
+       (if (vectorp (car scan))
            (let* ((array (car scan))
                   (len (length array))
                   (i 0))
@@ -205,9 +213,8 @@ in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP."
                               (if (or (eq defn olddef)
                                       (and (or (stringp defn) (vectorp defn))
                                            (equal defn olddef)))
-                                  (set-char-table-range (car scan)
-                                                        char
-                                                        (nconc (nreverse skipped) newdef))
+                                  (define-key keymap prefix1
+                                    (nconc (nreverse skipped) newdef))
                                 (if (and (keymapp defn)
                                          (let ((elt (lookup-key keymap prefix1)))
                                            (or (null elt)
@@ -650,30 +657,63 @@ FILE should be the name of a library, with no directory name."
 \f
 ;;;; Input and display facilities.
 
+(defvar read-quoted-char-radix 8
+  "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
+Legitimate radix values are 8, 10 and 16.")
+
+(custom-declare-variable-early
+ 'read-quoted-char-radix 8 
+ "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
+Legitimate radix values are 8, 10 and 16."
+  :type '(choice (const 8) (const 10) (const 16))
+  :group 'editing-basics)
+
 (defun read-quoted-char (&optional prompt)
-  "Like `read-char', except that if the first character read is an octal
-digit, we read up to two more octal digits and return the character
-represented by the octal number consisting of those digits.
-Optional argument PROMPT specifies a string to use to prompt the user."
-  (let ((message-log-max nil) (count 0) (code 0) char)
-    (while (< count 3)
-      (let ((inhibit-quit (zerop count))
+  "Like `read-char', but do not allow quitting.
+Also, if the first character read is an octal digit,
+we read any number of octal digits and return the
+soecified character code.  Any nondigit terminates the sequence.
+If the terminator is RET, it is discarded;
+any other terminator is used itself as input.
+
+The optional argument PROMPT specifies a string to use to prompt the user."
+  (let ((message-log-max nil) done (first t) (code 0) char)
+    (while (not done)
+      (let ((inhibit-quit first)
            ;; Don't let C-h get the help message--only help function keys.
            (help-char nil)
            (help-form
             "Type the special character you want to use,
-or three octal digits representing its character code."))
+or the octal character code.
+RET terminates the character code and is discarded;
+any other non-digit terminates the character code and is then used as input."))
        (and prompt (message "%s-" prompt))
-       (setq char (read-char))
+       (setq char (read-event))
        (if inhibit-quit (setq quit-flag nil)))
+      ;; Translate TAB key into control-I ASCII character, and so on.
+      (and char
+          (let ((translated (lookup-key function-key-map (vector char))))
+            (if translated
+                (setq char (aref translated 0)))))
       (cond ((null char))
-           ((and (<= ?0 char) (<= char ?7))
-            (setq code (+ (* code 8) (- char ?0))
-                  count (1+ count))
+           ((not (integerp char))
+            (setq unread-command-events (list char)
+                  done t))
+           ((and (<= ?0 char) (< char (+ ?0 (min 10 read-quoted-char-radix))))
+            (setq code (+ (* code read-quoted-char-radix) (- char ?0)))
+            (and prompt (setq prompt (message "%s %c" prompt char))))
+           ((and (<= ?a (downcase char))
+                 (< (downcase char) (+ ?a -10 (min 26 read-quoted-char-radix))))
+            (setq code (+ (* code read-quoted-char-radix) (+ 10 (- char ?a))))
             (and prompt (setq prompt (message "%s %c" prompt char))))
-           ((> count 0)
-            (setq unread-command-events (list char) count 259))
-           (t (setq code char count 259))))
+           ((and (not first) (eq char ?\C-m))
+            (setq done t))
+           ((not first)
+            (setq unread-command-events (list char)
+                  done t))
+           (t (setq code char
+                    done t)))
+      (setq first nil))
     ;; Turn a meta-character into a character with the 0200 bit set.
     (logior (if (/= (logand code ?\M-\^@) 0) 128 0)
            code)))
@@ -1021,7 +1061,7 @@ configuration."
        (eq (car object) 'frame-configuration)))
 
 (defun functionp (object)
-  "Non-nil of OBJECT is a type of object that can be called as a function."
+  "Non-nil if OBJECT is a type of object that can be called as a function."
   (or (subrp object) (compiled-function-p object)
       (eq (car-safe object) 'lambda)
       (and (symbolp object) (fboundp object))))