Mercurial > hg > xemacs-beta

comparison lisp/prim/keymap.el @ 203:850242ba4a81 r20-3b28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b28
author cvs
date Mon, 13 Aug 2007 10:02:21 +0200
parents 3d6bfa290dbd
children e45d5e7c476e
comparison
equal deleted inserted replaced
202:61eefc8fc970 203:850242ba4a81
40 (let ((string (make-string 1 ?0))) 40 (let ((string (make-string 1 ?0)))
41 (define-key map "-" 'negative-argument) 41 (define-key map "-" 'negative-argument)
42 ;; Make plain numbers do numeric args. 42 ;; Make plain numbers do numeric args.
43 (while (<= (aref string 0) ?9) 43 (while (<= (aref string 0) ?9)
44 (define-key map string 'digit-argument) 44 (define-key map string 'digit-argument)
45 (aset string 0 (1+ (aref string 0))))))) 45 (incf (aref string 0))))))
46 46
47 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix) 47 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
48 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. 48 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
49 In other words, OLDDEF is replaced with NEWDEF wherever it appears. 49 In other words, OLDDEF is replaced with NEWDEF wherever it appears.
50 Prefix keymaps are checked recursively. If optional fourth argument OLDMAP 50 Prefix keymaps are checked recursively. If optional fourth argument OLDMAP
79 (vconcat prefix (list key)) 79 (vconcat prefix (list key))
80 newdef)))) 80 newdef))))
81 map) 81 map)
82 ))) 82 )))
83 83
84 ;; from Bill Dubuque <wgd@martigny.ai.mit.edu> 84
85 ;; From Bill Dubuque <wgd@martigny.ai.mit.edu>
86
87 ;; This used to wrap forms into an interactive lambda. It is unclear
88 ;; to me why this is needed in this function. Anyway,
89 ;; `key-or-menu-binding' doesn't do it, so this function no longer
90 ;; does it, either.
85 (defun insert-key-binding (key) ; modeled after describe-key 91 (defun insert-key-binding (key) ; modeled after describe-key
92 "Insert the command bound to KEY."
86 (interactive "kInsert command bound to key: ") 93 (interactive "kInsert command bound to key: ")
87 (let (defn) 94 (let ((defn (key-or-menu-binding key)))
88 ;; If the key typed was really a menu selection, grab the form out
89 ;; of the event object and intuit the function that would be called,
90 ;; and describe that instead.
91 (if (and (vectorp key) (= 1 (length key))
92 (or (misc-user-event-p (aref key 0))
93 (eq (car-safe (aref key 0)) 'menu-selection)))
94 (let ((event (aref key 0)))
95 (setq defn (if (eventp event)
96 (list (event-function event) (event-object event))
97 (cdr event)))
98 (if (eq (car defn) 'eval)
99 (setq defn (` (lambda ()
100 (interactive)
101 (, (car (cdr defn)))))))
102 (if (eq (car-safe defn) 'call-interactively)
103 (setq defn (car (cdr defn))))
104 (if (and (consp defn) (null (cdr defn)))
105 (setq defn (car defn))))
106 (setq defn (key-binding key)))
107 (if (or (null defn) (integerp defn)) 95 (if (or (null defn) (integerp defn))
108 (error "%s is undefined" (key-description key)) 96 (error "%s is undefined" (key-description key))
109 (if (or (stringp defn) (vectorp defn)) 97 (if (or (stringp defn) (vectorp defn))
110 (setq defn (key-binding defn))) ;; a keyboard macro 98 (setq defn (key-binding defn))) ;; a keyboard macro
111 (insert (format "%s" defn))))) 99 (insert (format "%s" defn)))))
112 100
113 ;; from Bill Dubuque <wgd@martigny.ai.mit.edu> 101 ;; From Bill Dubuque <wgd@martigny.ai.mit.edu>
114 (defun read-command-or-command-sexp (prompt) 102 (defun read-command-or-command-sexp (prompt)
115 "Read a command symbol or command sexp. 103 "Read a command symbol or command sexp.
116 A command sexp is wrapped in an interactive lambda if needed. 104 A command sexp is wrapped in an interactive lambda if needed.
117 Prompts with PROMPT." 105 Prompts with PROMPT."
118 ;; Todo: it would be better if we could reject symbols that are not 106 ;; Todo: it would be better if we could reject symbols that are not
120 ;; because we must supply arg4 = require-match = nil for sexp case. 108 ;; because we must supply arg4 = require-match = nil for sexp case.
121 (let ((result (car (read-from-string 109 (let ((result (car (read-from-string
122 (completing-read prompt obarray 'commandp))))) 110 (completing-read prompt obarray 'commandp)))))
123 (if (and (consp result) 111 (if (and (consp result)
124 (not (eq (car result) 'lambda))) 112 (not (eq (car result) 'lambda)))
125 (` (lambda () 113 `(lambda ()
126 (interactive) 114 (interactive)
127 (, result))) 115 ,result)
128 result))) 116 result)))
129 117
130 (defun local-key-binding (keys) 118 (defun local-key-binding (keys)
131 "Return the binding for command KEYS in current local keymap only. 119 "Return the binding for command KEYS in current local keymap only.
132 KEYS is a string, a vector of events, or a vector of key-description lists 120 KEYS is a string, a vector of events, or a vector of key-description lists
225 (setq v (indirect-function (cdr a))) 213 (setq v (indirect-function (cdr a)))
226 (setq v (lookup-key v key accept-default)) 214 (setq v (lookup-key v key accept-default))
227 ;; Terminate loop, with v set to non-nil value 215 ;; Terminate loop, with v set to non-nil value
228 (setq tail nil))) 216 (setq tail nil)))
229 v)) 217 v))
230 218
231 219
232 (defun current-minor-mode-maps () 220 (defun current-minor-mode-maps ()
233 "Return a list of keymaps for the minor modes of the current buffer." 221 "Return a list of keymaps for the minor modes of the current buffer."
234 (let ((l '()) 222 (let ((l '())
235 (tail minor-mode-map-alist) 223 (tail minor-mode-map-alist)
254 If second optional argument MAPVAR is not specified, 242 If second optional argument MAPVAR is not specified,
255 COMMAND's value (as well as its function definition) is set to the keymap. 243 COMMAND's value (as well as its function definition) is set to the keymap.
256 If a second optional argument MAPVAR is given and is not `t', 244 If a second optional argument MAPVAR is given and is not `t',
257 the map is stored as its value. 245 the map is stored as its value.
258 Regardless of MAPVAR, COMMAND's function-value is always set to the keymap." 246 Regardless of MAPVAR, COMMAND's function-value is always set to the keymap."
259 (let ((map (make-sparse-keymap))) 247 (let ((map (make-sparse-keymap name)))
260 (set-keymap-name map name)
261 (fset name map) 248 (fset name map)
262 (cond ((not mapvar) 249 (cond ((not mapvar)
263 (set name map)) 250 (set name map))
264 ((eq mapvar 't) 251 ((eq mapvar 't)
265 ) 252 )
270 257
271 ;;; Converting vectors of events to a read-equivalent form. 258 ;;; Converting vectors of events to a read-equivalent form.
272 ;;; This is used both by call-interactively (for the command history) 259 ;;; This is used both by call-interactively (for the command history)
273 ;;; and by macros.el (for saving keyboard macros to a file). 260 ;;; and by macros.el (for saving keyboard macros to a file).
274 261
262 ;; ### why does (events-to-keys [backspace]) return "\C-h"?
263 ;; BTW, this function is a mess, and macros.el does *not* use it, in
264 ;; spite of the above comment. `format-kbd-macro' is used to save
265 ;; keyboard macros to a file.
275 (defun events-to-keys (events &optional no-mice) 266 (defun events-to-keys (events &optional no-mice)
276 "Given a vector of event objects, returns a vector of key descriptors, 267 "Given a vector of event objects, returns a vector of key descriptors,
277 or a string (if they all fit in the ASCII range). 268 or a string (if they all fit in the ASCII range).
278 Optional arg NO-MICE means that button events are not allowed." 269 Optional arg NO-MICE means that button events are not allowed."
279 (if (and events (symbolp events)) (setq events (vector events))) 270 (if (and events (symbolp events)) (setq events (vector events)))
380 "Return the next key event, with a modifier flag applied. 371 "Return the next key event, with a modifier flag applied.
381 SYMBOL is the name of this modifier, as a symbol." 372 SYMBOL is the name of this modifier, as a symbol."
382 (let (event) 373 (let (event)
383 (while (not (key-press-event-p (setq event (next-command-event)))) 374 (while (not (key-press-event-p (setq event (next-command-event))))
384 (dispatch-event event)) 375 (dispatch-event event))
385 (vector (append (list symbol) 376 (vconcat (list symbol)
386 (delq symbol (event-modifiers event)) 377 (delq symbol (event-modifiers event))
387 (list (event-key event)))))) 378 (list (event-key event)))))
388 379
380 ;; This looks dirty. The following code should maybe go to another
381 ;; file, and `create-console-hook' should maybe default to nil.
389 (add-hook 382 (add-hook
390 'create-console-hook 383 'create-console-hook
391 (lambda (console) 384 (lambda (console)
392 (letf (((selected-console) console)) 385 (letf (((selected-console) console))
393 (define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier) 386 (define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)