[Emacs-diffs] Changes to emacs/lisp/subr.el

[Stefan Monnier]

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)