(setq i (1+ i))))))
(setq scan (cdr scan)))))
+(defun define-key-after (keymap key definition after)
+ "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
+This is like `define-key' except that the binding for KEY is placed
+just after the binding for the event AFTER, instead of at the beginning
+of the map.
+The order matters when the keymap is used as a menu.
+KEY must contain just one event type--it must be a string or vector
+of length 1."
+ (or (keymapp keymap)
+ (signal 'wrong-type-argument (list 'keymapp keymap)))
+ (if (> (length key) 0)
+ (error "multi-event key specified in `define-key-after'"))
+ (let ((tail keymap) done inserted
+ (first (aref key 0)))
+ (while (and (not done) tail)
+ ;; Delete any earlier bindings for the same key.
+ (if (eq (car-safe (car (cdr tail))) first)
+ (setcdr tail (cdr (cdr tail))))
+ ;; When we reach AFTER's binding, insert the new binding after.
+ ;; If we reach an inherited keymap, insert just before that.
+ ;; If we reach the end of this keymap, insert at the end.
+ (if (or (eq (car-safe (car tail)) after)
+ (eq (car (cdr tail)) 'keymap)
+ (null (cdr tail)))
+ (progn
+ ;; Stop the scan only if we find a parent keymap.
+ ;; Keep going past the inserted element
+ ;; so we can delete any duplications that come later.
+ (if (eq (car (cdr tail)) 'keymap)
+ (setq done t))
+ ;; Don't insert more than once.
+ (or inserted
+ (setcdr tail (cons (cons (aref key 0) definition) (cdr tail))))
+ (setq inserted t)))
+ (setq tail (cdr tail)))))
+
(defun keyboard-translate (from to)
"Translate character FROM to TO at a low level.
This function creates a `keyboard-translate-table' if necessary
(defvar ctl-x-4-map (make-sparse-keymap)
"Keymap for subcommands of C-x 4")
-(fset 'ctl-x-4-prefix ctl-x-4-map)
+(defalias 'ctl-x-4-prefix ctl-x-4-map)
(define-key ctl-x-map "4" 'ctl-x-4-prefix)
(defvar ctl-x-5-map (make-sparse-keymap)
"Keymap for frame commands.")
-(fset 'ctl-x-5-prefix ctl-x-5-map)
+(defalias 'ctl-x-5-prefix ctl-x-5-map)
(define-key ctl-x-map "5" 'ctl-x-5-prefix)
\f
;;;; Event manipulation functions.
+;; This code exists specifically to make sure that the
+;; resulting number does not appear in the .elc file.
+;; The number is negative on most machines, but not on all!
+(defconst listify-key-sequence-1
+ (lsh 1 7))
+(setq listify-key-sequence-1 (logior (lsh 1 23) listify-key-sequence-1))
+
(defun listify-key-sequence (key)
"Convert a key sequence to a list of events."
(if (vectorp key)
(append key nil)
(mapcar (function (lambda (c)
(if (> c 127)
- (logxor c 8388736)
+ (logxor c listify-key-sequence-1)
c)))
(append key nil))))
(defun event-modifiers (event)
"Returns a list of symbols representing the modifier keys in event EVENT.
The elements of the list may include `meta', `control',
-`shift', `hyper', `super', `alt'.
-See also the function `event-modifier-bits'."
+`shift', `hyper', `super', `alt', `click', `drag', and `down'."
(let ((type event))
(if (listp type)
(setq type (car type)))
(defun event-basic-type (event)
"Returns the basic type of the given event (all modifiers removed).
The value is an ASCII printing character (not upper case) or a symbol."
+ (if (consp event)
+ (setq event (car event)))
(if (symbolp event)
(car (get event 'event-symbol-elements))
(let ((base (logand event (1- (lsh 1 18)))))
The return value is of the form
(WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
The `posn-' functions access elements of such lists."
- (nth (1- (length event)) event))
+ (nth (if (consp (nth 2 event)) 2 1) event))
(defsubst posn-window (position)
"Return the window in POSITION.
POSITION should be a list of the form
(WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
as returned by the `event-start' and `event-end' functions."
- (nth 1 position))
+ (if (consp (nth 1 position))
+ (car (nth 1 position))
+ (nth 1 position)))
(defsubst posn-col-row (position)
"Return the row and column in POSITION.
"Return the timestamp of POSITION.
POSITION should be a list of the form
(WINDOW BUFFER-POSITION (COL . ROW) TIMESTAMP)
-nas returned by the `event-start' and `event-end' functions."
+as returned by the `event-start' and `event-end' functions."
(nth 3 position))
-\f
-;;;; Overlay dissection functions.
-
-(defsubst overlay-start (overlay)
- "Return the position at which OVERLAY starts."
- (marker-position (car (car overlay))))
-
-(defsubst overlay-end (overlay)
- "Return the position at which OVERLAY ends."
- (marker-position (cdr (car overlay))))
-
-(defsubst overlay-buffer (overlay)
- "Return the buffer OVERLAY belongs to."
- (marker-buffer (overlay-start overlay)))
-
\f
;;;; Obsolescent names for functions.
-(fset 'make-syntax-table 'copy-syntax-table)
-(fset 'dot 'point)
-(fset 'dot-marker 'point-marker)
-(fset 'dot-min 'point-min)
-(fset 'dot-max 'point-max)
-(fset 'window-dot 'window-point)
-(fset 'set-window-dot 'set-window-point)
-(fset 'read-input 'read-string)
-(fset 'send-string 'process-send-string)
-(fset 'send-region 'process-send-region)
-(fset 'show-buffer 'set-window-buffer)
-(fset 'buffer-flush-undo 'buffer-disable-undo)
-(fset 'eval-current-buffer 'eval-buffer)
-(fset 'compiled-function-p 'byte-code-function-p)
+(defalias 'make-syntax-table 'copy-syntax-table)
+(defalias 'dot 'point)
+(defalias 'dot-marker 'point-marker)
+(defalias 'dot-min 'point-min)
+(defalias 'dot-max 'point-max)
+(defalias 'window-dot 'window-point)
+(defalias 'set-window-dot 'set-window-point)
+(defalias 'read-input 'read-string)
+(defalias 'send-string 'process-send-string)
+(defalias 'send-region 'process-send-region)
+(defalias 'show-buffer 'set-window-buffer)
+(defalias 'buffer-flush-undo 'buffer-disable-undo)
+(defalias 'eval-current-buffer 'eval-buffer)
+(defalias 'compiled-function-p 'byte-code-function-p)
;;; This name isn't mentioned in the manual, and we've been hoping to
;;; phase it out, but there's still a lot of code out there, even for
;;; Emacs 18.59, which uses mod. I'm going to let the byte compiler's
;;; make-obsolete function to poke people a little more, and leave the
;;; `mod' name around for a while longer.
-(fset 'mod '%)
+(defalias 'mod '%)
;; Some programs still use this as a function.
(defun baud-rate ()
- "Obsolete function returning the value of the `baud-rate' variable."
+ "Obsolete function returning the value of the `baud-rate' variable.
+Please convert your programs to use the variable `baud-rate' directly."
baud-rate)
\f
;;;; Alternate names for functions - these are not being phased out.
-(fset 'string= 'string-equal)
-(fset 'string< 'string-lessp)
-(fset 'move-marker 'set-marker)
-(fset 'eql 'eq)
-(fset 'not 'null)
-(fset 'rplaca 'setcar)
-(fset 'rplacd 'setcdr)
-(fset 'beep 'ding) ;preserve lingual purtity
-(fset 'indent-to-column 'indent-to)
-(fset 'backward-delete-char 'delete-backward-char)
-(fset 'search-forward-regexp (symbol-function 're-search-forward))
-(fset 'search-backward-regexp (symbol-function 're-search-backward))
-(fset 'int-to-string 'number-to-string)
+(defalias 'string= 'string-equal)
+(defalias 'string< 'string-lessp)
+(defalias 'move-marker 'set-marker)
+(defalias 'eql 'eq)
+(defalias 'not 'null)
+(defalias 'rplaca 'setcar)
+(defalias 'rplacd 'setcdr)
+(defalias 'beep 'ding) ;preserve lingual purity
+(defalias 'indent-to-column 'indent-to)
+(defalias 'backward-delete-char 'delete-backward-char)
+(defalias 'search-forward-regexp (symbol-function 're-search-forward))
+(defalias 'search-backward-regexp (symbol-function 're-search-backward))
+(defalias 'int-to-string 'number-to-string)
;;; Should this be an obsolete name? If you decide it should, you get
;;; to go through all the sources and change them.
-(fset 'string-to-int 'string-to-number)
+(defalias 'string-to-int 'string-to-number)
\f
;;;; Hook manipulation functions.