;; 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.
(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))
(substitute-key-definition olddef newdef keymap
inner-def
prefix1)))))
- (setq i (1+ i))))))
+ (setq i (1+ i))))
+ (if (char-table-p (car scan))
+ (map-char-table
+ (function (lambda (char defn)
+ (let ()
+ ;; The inside of this let duplicates exactly
+ ;; the inside of the previous let,
+ ;; except that it uses set-char-table-range
+ ;; instead of define-key.
+ (aset vec1 0 char)
+ (aset prefix1 (length prefix) char)
+ (let (inner-def skipped)
+ ;; Skip past menu-prompt.
+ (while (stringp (car-safe defn))
+ (setq skipped (cons (car defn) skipped))
+ (setq defn (cdr defn)))
+ (and (consp defn) (consp (car defn))
+ (setq defn (cdr defn)))
+ (setq inner-def defn)
+ (while (and (symbolp inner-def)
+ (fboundp inner-def))
+ (setq inner-def (symbol-function inner-def)))
+ (if (or (eq defn olddef)
+ (and (or (stringp defn) (vectorp defn))
+ (equal defn olddef)))
+ (define-key keymap prefix1
+ (nconc (nreverse skipped) newdef))
+ (if (and (keymapp defn)
+ (let ((elt (lookup-key keymap prefix1)))
+ (or (null elt)
+ (keymapp elt)))
+ (not (memq inner-def
+ key-substitution-in-progress)))
+ (substitute-key-definition olddef newdef keymap
+ inner-def
+ prefix1)))))))
+ (car scan)))))
(setq scan (cdr scan)))))
(defun define-key-after (keymap key definition after)
\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)
- (logand 255 code))))
+ code)))
(defun force-mode-line-update (&optional all)
"Force the mode-line of the current buffer to be redisplayed.
(defun make-syntax-table (&optional oldtable)
"Return a new syntax table.
-It inherits all letters and control characters from the standard
-syntax table; other characters are copied from the standard syntax table."
+If OLDTABLE is non-nil, copy OLDTABLE.
+Otherwise, create a syntax table which inherits
+all letters and control characters from the standard syntax table;
+other characters are copied from the standard syntax table."
(if oldtable
(copy-syntax-table oldtable)
(let ((table (copy-syntax-table))
(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))))
HCoop / bpt / emacs.git / blobdiff