367 |
(define-key map (char-to-string loop) 'digit-argument) |
(define-key map (char-to-string loop) 'digit-argument) |
368 |
(setq loop (1+ loop)))))) |
(setq loop (1+ loop)))))) |
369 |
|
|
|
;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))) |
|
|
|
|
370 |
(defvar key-substitution-in-progress nil |
(defvar key-substitution-in-progress nil |
371 |
"Used internally by substitute-key-definition.") |
"Used internally by substitute-key-definition.") |
372 |
|
|
387 |
;; original key, with PREFIX added at the front. |
;; original key, with PREFIX added at the front. |
388 |
(or prefix (setq prefix "")) |
(or prefix (setq prefix "")) |
389 |
(let* ((scan (or oldmap keymap)) |
(let* ((scan (or oldmap keymap)) |
390 |
(vec1 (vector nil)) |
(prefix1 (vconcat prefix [nil])) |
|
(prefix1 (vconcat prefix vec1)) |
|
391 |
(key-substitution-in-progress |
(key-substitution-in-progress |
392 |
(cons scan key-substitution-in-progress))) |
(cons scan key-substitution-in-progress))) |
393 |
;; Scan OLDMAP, finding each char or event-symbol that |
;; Scan OLDMAP, finding each char or event-symbol that |
394 |
;; has any definition, and act on it with hack-key. |
;; has any definition, and act on it with hack-key. |
395 |
(while (consp scan) |
(map-keymap |
396 |
(if (consp (car scan)) |
(lambda (char defn) |
397 |
(let ((char (car (car scan))) |
(aset prefix1 (length prefix) char) |
398 |
(defn (cdr (car scan)))) |
(substitute-key-definition-key defn olddef newdef prefix1 keymap)) |
399 |
;; The inside of this let duplicates exactly |
scan))) |
400 |
;; the inside of the following let that handles array elements. |
|
401 |
(aset vec1 0 char) |
(defun substitute-key-definition-key (defn olddef newdef prefix keymap) |
402 |
(aset prefix1 (length prefix) char) |
(let (inner-def skipped menu-item) |
403 |
(let (inner-def skipped) |
;; Find the actual command name within the binding. |
404 |
;; Skip past menu-prompt. |
(if (eq (car-safe defn) 'menu-item) |
405 |
(while (stringp (car-safe defn)) |
(setq menu-item defn defn (nth 2 defn)) |
406 |
(setq skipped (cons (car defn) skipped)) |
;; Skip past menu-prompt. |
407 |
(setq defn (cdr defn))) |
(while (stringp (car-safe defn)) |
408 |
;; Skip past cached key-equivalence data for menu items. |
(push (pop defn) skipped)) |
409 |
(and (consp defn) (consp (car defn)) |
;; Skip past cached key-equivalence data for menu items. |
410 |
(setq defn (cdr defn))) |
(if (consp (car-safe defn)) |
411 |
(setq inner-def defn) |
(setq defn (cdr defn)))) |
412 |
;; Look past a symbol that names a keymap. |
(if (or (eq defn olddef) |
413 |
(while (and (symbolp inner-def) |
;; Compare with equal if definition is a key sequence. |
414 |
(fboundp inner-def)) |
;; That is useful for operating on function-key-map. |
415 |
(setq inner-def (symbol-function inner-def))) |
(and (or (stringp defn) (vectorp defn)) |
416 |
(if (or (eq defn olddef) |
(equal defn olddef))) |
417 |
;; Compare with equal if definition is a key sequence. |
(define-key keymap prefix |
418 |
;; That is useful for operating on function-key-map. |
(if menu-item |
419 |
(and (or (stringp defn) (vectorp defn)) |
(let ((copy (copy-sequence menu-item))) |
420 |
(equal defn olddef))) |
(setcar (nthcdr 2 copy) newdef) |
421 |
(define-key keymap prefix1 (nconc (nreverse skipped) newdef)) |
copy) |
422 |
(if (and (keymapp defn) |
(nconc (nreverse skipped) newdef))) |
423 |
;; Avoid recursively scanning |
;; Look past a symbol that names a keymap. |
424 |
;; where KEYMAP does not have a submap. |
(setq inner-def |
425 |
(let ((elt (lookup-key keymap prefix1))) |
(condition-case nil (indirect-function defn) (error defn))) |
426 |
(or (null elt) |
;; For nested keymaps, we use `inner-def' rather than `defn' so as to |
427 |
(keymapp elt))) |
;; avoid autoloading a keymap. This is mostly done to preserve the |
428 |
;; Avoid recursively rescanning keymap being scanned. |
;; original non-autoloading behavior of pre-map-keymap times. |
429 |
(not (memq inner-def |
(if (and (keymapp inner-def) |
430 |
key-substitution-in-progress))) |
;; Avoid recursively scanning |
431 |
;; If this one isn't being scanned already, |
;; where KEYMAP does not have a submap. |
432 |
;; scan it now. |
(let ((elt (lookup-key keymap prefix))) |
433 |
(substitute-key-definition olddef newdef keymap |
(or (null elt) (natnump elt) (keymapp elt))) |
434 |
inner-def |
;; Avoid recursively rescanning keymap being scanned. |
435 |
prefix1))))) |
(not (memq inner-def key-substitution-in-progress))) |
436 |
(if (vectorp (car scan)) |
;; If this one isn't being scanned already, scan it now. |
437 |
(let* ((array (car scan)) |
(substitute-key-definition olddef newdef keymap inner-def prefix))))) |
|
(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))))) |
|
438 |
|
|
439 |
(defun define-key-after (keymap key definition &optional after) |
(defun define-key-after (keymap key definition &optional after) |
440 |
"Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding. |
"Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding. |
580 |
(char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@ |
(char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@ |
581 |
?\H-\^@ ?\s-\^@ ?\A-\^@))))) |
?\H-\^@ ?\s-\^@ ?\A-\^@))))) |
582 |
(if (not (zerop (logand type ?\M-\^@))) |
(if (not (zerop (logand type ?\M-\^@))) |
583 |
(setq list (cons 'meta list))) |
(push 'meta list)) |
584 |
(if (or (not (zerop (logand type ?\C-\^@))) |
(if (or (not (zerop (logand type ?\C-\^@))) |
585 |
(< char 32)) |
(< char 32)) |
586 |
(setq list (cons 'control list))) |
(push 'control list)) |
587 |
(if (or (not (zerop (logand type ?\S-\^@))) |
(if (or (not (zerop (logand type ?\S-\^@))) |
588 |
(/= char (downcase char))) |
(/= char (downcase char))) |
589 |
(setq list (cons 'shift list))) |
(push 'shift list)) |
590 |
(or (zerop (logand type ?\H-\^@)) |
(or (zerop (logand type ?\H-\^@)) |
591 |
(setq list (cons 'hyper list))) |
(push 'hyper list)) |
592 |
(or (zerop (logand type ?\s-\^@)) |
(or (zerop (logand type ?\s-\^@)) |
593 |
(setq list (cons 'super list))) |
(push 'super list)) |
594 |
(or (zerop (logand type ?\A-\^@)) |
(or (zerop (logand type ?\A-\^@)) |
595 |
(setq list (cons 'alt list))) |
(push 'alt list)) |
596 |
list)))) |
list)))) |
597 |
|
|
598 |
(defun event-basic-type (event) |
(defun event-basic-type (event) |
610 |
|
|
611 |
(defsubst mouse-movement-p (object) |
(defsubst mouse-movement-p (object) |
612 |
"Return non-nil if OBJECT is a mouse movement event." |
"Return non-nil if OBJECT is a mouse movement event." |
613 |
(and (consp object) |
(eq (car-safe object) 'mouse-movement)) |
|
(eq (car object) 'mouse-movement))) |
|
614 |
|
|
615 |
(defsubst event-start (event) |
(defsubst event-start (event) |
616 |
"Return the starting position of EVENT. |
"Return the starting position of EVENT. |
1801 |
See also `with-temp-file' and `with-output-to-string'." |
See also `with-temp-file' and `with-output-to-string'." |
1802 |
(declare (indent 0) (debug t)) |
(declare (indent 0) (debug t)) |
1803 |
(let ((temp-buffer (make-symbol "temp-buffer"))) |
(let ((temp-buffer (make-symbol "temp-buffer"))) |
1804 |
`(let ((,temp-buffer |
`(let ((,temp-buffer (generate-new-buffer " *temp*"))) |
|
(get-buffer-create (generate-new-buffer-name " *temp*")))) |
|
1805 |
(unwind-protect |
(unwind-protect |
1806 |
(with-current-buffer ,temp-buffer |
(with-current-buffer ,temp-buffer |
1807 |
,@body) |
,@body) |