[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/subr.el
From: |
Stefan Monnier |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/subr.el |
Date: |
Wed, 13 Oct 2004 13:21:17 -0400 |
Index: emacs/lisp/subr.el
diff -c emacs/lisp/subr.el:1.417 emacs/lisp/subr.el:1.418
*** emacs/lisp/subr.el:1.417 Mon Oct 11 22:02:16 2004
--- emacs/lisp/subr.el Wed Oct 13 17:05:55 2004
***************
*** 367,381 ****
(define-key map (char-to-string loop) 'digit-argument)
(setq loop (1+ loop))))))
- ;Moved to keymap.c
- ;(defun copy-keymap (keymap)
- ; "Return a copy of KEYMAP"
- ; (while (not (keymapp keymap))
- ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
- ; (if (vectorp keymap)
- ; (copy-sequence keymap)
- ; (copy-alist keymap)))
-
(defvar key-substitution-in-progress nil
"Used internally by substitute-key-definition.")
--- 367,372 ----
***************
*** 396,521 ****
;; original key, with PREFIX added at the front.
(or prefix (setq prefix ""))
(let* ((scan (or oldmap keymap))
! (vec1 (vector nil))
! (prefix1 (vconcat prefix vec1))
(key-substitution-in-progress
(cons scan key-substitution-in-progress)))
;; Scan OLDMAP, finding each char or event-symbol that
;; has any definition, and act on it with hack-key.
! (while (consp scan)
! (if (consp (car scan))
! (let ((char (car (car scan)))
! (defn (cdr (car scan))))
! ;; The inside of this let duplicates exactly
! ;; the inside of the following let that handles array elements.
! (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)))
! ;; Skip past cached key-equivalence data for menu items.
! (and (consp defn) (consp (car defn))
! (setq defn (cdr defn)))
! (setq inner-def defn)
! ;; Look past a symbol that names a keymap.
! (while (and (symbolp inner-def)
! (fboundp inner-def))
! (setq inner-def (symbol-function inner-def)))
! (if (or (eq defn olddef)
! ;; Compare with equal if definition is a key sequence.
! ;; That is useful for operating on function-key-map.
! (and (or (stringp defn) (vectorp defn))
! (equal defn olddef)))
! (define-key keymap prefix1 (nconc (nreverse skipped) newdef))
! (if (and (keymapp defn)
! ;; Avoid recursively scanning
! ;; where KEYMAP does not have a submap.
! (let ((elt (lookup-key keymap prefix1)))
! (or (null elt)
! (keymapp elt)))
! ;; Avoid recursively rescanning keymap being scanned.
! (not (memq inner-def
! key-substitution-in-progress)))
! ;; If this one isn't being scanned already,
! ;; scan it now.
! (substitute-key-definition olddef newdef keymap
! inner-def
! prefix1)))))
! (if (vectorp (car scan))
! (let* ((array (car scan))
! (len (length array))
! (i 0))
! (while (< i len)
! (let ((char i) (defn (aref array i)))
! ;; The inside of this let duplicates exactly
! ;; the inside of the previous let.
! (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)))))
! (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 &optional after)
"Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
--- 387,440 ----
;; original key, with PREFIX added at the front.
(or prefix (setq prefix ""))
(let* ((scan (or oldmap keymap))
! (prefix1 (vconcat prefix [nil]))
(key-substitution-in-progress
(cons scan key-substitution-in-progress)))
;; Scan OLDMAP, finding each char or event-symbol that
;; has any definition, and act on it with hack-key.
! (map-keymap
! (lambda (char defn)
! (aset prefix1 (length prefix) char)
! (substitute-key-definition-key defn olddef newdef prefix1 keymap))
! scan)))
!
! (defun substitute-key-definition-key (defn olddef newdef prefix keymap)
! (let (inner-def skipped menu-item)
! ;; Find the actual command name within the binding.
! (if (eq (car-safe defn) 'menu-item)
! (setq menu-item defn defn (nth 2 defn))
! ;; Skip past menu-prompt.
! (while (stringp (car-safe defn))
! (push (pop defn) skipped))
! ;; Skip past cached key-equivalence data for menu items.
! (if (consp (car-safe defn))
! (setq defn (cdr defn))))
! (if (or (eq defn olddef)
! ;; Compare with equal if definition is a key sequence.
! ;; That is useful for operating on function-key-map.
! (and (or (stringp defn) (vectorp defn))
! (equal defn olddef)))
! (define-key keymap prefix
! (if menu-item
! (let ((copy (copy-sequence menu-item)))
! (setcar (nthcdr 2 copy) newdef)
! copy)
! (nconc (nreverse skipped) newdef)))
! ;; Look past a symbol that names a keymap.
! (setq inner-def
! (condition-case nil (indirect-function defn) (error defn)))
! ;; For nested keymaps, we use `inner-def' rather than `defn' so as to
! ;; avoid autoloading a keymap. This is mostly done to preserve the
! ;; original non-autoloading behavior of pre-map-keymap times.
! (if (and (keymapp inner-def)
! ;; Avoid recursively scanning
! ;; where KEYMAP does not have a submap.
! (let ((elt (lookup-key keymap prefix)))
! (or (null elt) (natnump elt) (keymapp elt)))
! ;; Avoid recursively rescanning keymap being scanned.
! (not (memq inner-def key-substitution-in-progress)))
! ;; If this one isn't being scanned already, scan it now.
! (substitute-key-definition olddef newdef keymap inner-def prefix)))))
(defun define-key-after (keymap key definition &optional after)
"Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
***************
*** 661,679 ****
(char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@
?\H-\^@ ?\s-\^@ ?\A-\^@)))))
(if (not (zerop (logand type ?\M-\^@)))
! (setq list (cons 'meta list)))
(if (or (not (zerop (logand type ?\C-\^@)))
(< char 32))
! (setq list (cons 'control list)))
(if (or (not (zerop (logand type ?\S-\^@)))
(/= char (downcase char)))
! (setq list (cons 'shift list)))
(or (zerop (logand type ?\H-\^@))
! (setq list (cons 'hyper list)))
(or (zerop (logand type ?\s-\^@))
! (setq list (cons 'super list)))
(or (zerop (logand type ?\A-\^@))
! (setq list (cons 'alt list)))
list))))
(defun event-basic-type (event)
--- 580,598 ----
(char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@
?\H-\^@ ?\s-\^@ ?\A-\^@)))))
(if (not (zerop (logand type ?\M-\^@)))
! (push 'meta list))
(if (or (not (zerop (logand type ?\C-\^@)))
(< char 32))
! (push 'control list))
(if (or (not (zerop (logand type ?\S-\^@)))
(/= char (downcase char)))
! (push 'shift list))
(or (zerop (logand type ?\H-\^@))
! (push 'hyper list))
(or (zerop (logand type ?\s-\^@))
! (push 'super list))
(or (zerop (logand type ?\A-\^@))
! (push 'alt list))
list))))
(defun event-basic-type (event)
***************
*** 691,698 ****
(defsubst mouse-movement-p (object)
"Return non-nil if OBJECT is a mouse movement event."
! (and (consp object)
! (eq (car object) 'mouse-movement)))
(defsubst event-start (event)
"Return the starting position of EVENT.
--- 610,616 ----
(defsubst mouse-movement-p (object)
"Return non-nil if OBJECT is a mouse movement event."
! (eq (car-safe object) 'mouse-movement))
(defsubst event-start (event)
"Return the starting position of EVENT.
***************
*** 1883,1890 ****
See also `with-temp-file' and `with-output-to-string'."
(declare (indent 0) (debug t))
(let ((temp-buffer (make-symbol "temp-buffer")))
! `(let ((,temp-buffer
! (get-buffer-create (generate-new-buffer-name " *temp*"))))
(unwind-protect
(with-current-buffer ,temp-buffer
,@body)
--- 1801,1807 ----
See also `with-temp-file' and `with-output-to-string'."
(declare (indent 0) (debug t))
(let ((temp-buffer (make-symbol "temp-buffer")))
! `(let ((,temp-buffer (generate-new-buffer " *temp*")))
(unwind-protect
(with-current-buffer ,temp-buffer
,@body)
- [Emacs-diffs] Changes to emacs/lisp/subr.el, Eli Zaretskii, 2004/10/08
- [Emacs-diffs] Changes to emacs/lisp/subr.el, Kim F . Storm, 2004/10/09
- [Emacs-diffs] Changes to emacs/lisp/subr.el, Kim F . Storm, 2004/10/11
- [Emacs-diffs] Changes to emacs/lisp/subr.el,
Stefan Monnier <=
- [Emacs-diffs] Changes to emacs/lisp/subr.el, Richard M . Stallman, 2004/10/16
- [Emacs-diffs] Changes to emacs/lisp/subr.el, Richard M . Stallman, 2004/10/17
- [Emacs-diffs] Changes to emacs/lisp/subr.el, Simon Josefsson, 2004/10/25
- [Emacs-diffs] Changes to emacs/lisp/subr.el, Stefan Monnier, 2004/10/28
- [Emacs-diffs] Changes to emacs/lisp/subr.el, Simon Josefsson, 2004/10/29