Mercurial > hg > xemacs-beta

comparison lisp/utils/edmacro.el @ 118:7d55a9ba150c r20-1b11

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b11
author cvs
date Mon, 13 Aug 2007 09:24:17 +0200
parents 4103f0995bd7
children 34a5b81f86ba
comparison
equal deleted inserted replaced
117:578fd4947a72 118:7d55a9ba150c
3 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. 3 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
4 4
5 ;; Author: Dave Gillespie <daveg@synaptics.com> 5 ;; Author: Dave Gillespie <daveg@synaptics.com>
6 ;; Hrvoje Niksic <hniksic@srce.hr> -- XEmacs port 6 ;; Hrvoje Niksic <hniksic@srce.hr> -- XEmacs port
7 ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr> 7 ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
8 ;; Version: 3.05 8 ;; Version: 3.07
9 ;; Keywords: abbrev 9 ;; Keywords: abbrev
10 10
11 ;; This file is part of XEmacs. 11 ;; This file is part of XEmacs.
12 12
13 ;; XEmacs is free software; you can redistribute it and/or modify 13 ;; XEmacs is free software; you can redistribute it and/or modify
51 ;; 51 ;;
52 ;; Also, the `read-kbd-macro' command parses the region as 52 ;; Also, the `read-kbd-macro' command parses the region as
53 ;; a keyboard macro, and installs it as the "current" macro. 53 ;; a keyboard macro, and installs it as the "current" macro.
54 ;; This and `format-kbd-macro' can also be called directly as 54 ;; This and `format-kbd-macro' can also be called directly as
55 ;; Lisp functions. 55 ;; Lisp functions.
56
57 ;; The `kbd' macro calls `read-kbd-macro', but it is evaluated at
58 ;; compile-time. It is good to use in your programs and
59 ;; initializations, as you needn't know the internal keysym
60 ;; representation. For example:
61 ;;
62 ;; (define-key foo-mode-map (kbd "C-c <up>") 'foo-up)
63 ;; is the equivalent of
64 ;; (define-key foo-mode-map [(control ?c) up] 'foo-up)
56 65
57 ;; Type `C-h m', or see the documentation for `edmacro-mode' below, 66 ;; Type `C-h m', or see the documentation for `edmacro-mode' below,
58 ;; for information about the format of written keyboard macros. 67 ;; for information about the format of written keyboard macros.
59 68
60 ;; `edit-kbd-macro' formats the macro with one command per line, 69 ;; `edit-kbd-macro' formats the macro with one command per line,
204 Second argument NEED-VECTOR means to return an event vector always." 213 Second argument NEED-VECTOR means to return an event vector always."
205 (interactive "r") 214 (interactive "r")
206 (if (stringp start) 215 (if (stringp start)
207 (edmacro-parse-keys start end) 216 (edmacro-parse-keys start end)
208 (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))))) 217 (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end)))))
218
219 ;;;###autoload
220 (defmacro kbd (keys)
221 "Convert KEYS to the internal Emacs key representation."
222 `(eval-when-compile
223 (read-kbd-macro ,keys)))
209 224
210 ;;;###autoload 225 ;;;###autoload
211 (defun format-kbd-macro (&optional macro verbose) 226 (defun format-kbd-macro (&optional macro verbose)
212 "Return the keyboard macro MACRO as a human-readable string. 227 "Return the keyboard macro MACRO as a human-readable string.
213 This string is suitable for passing to `read-kbd-macro'. 228 This string is suitable for passing to `read-kbd-macro'.
421 (?\n . "LFD") 436 (?\n . "LFD")
422 (?\t . "TAB") 437 (?\t . "TAB")
423 (?\e . "ESC") 438 (?\e . "ESC")
424 (?\ . "SPC") 439 (?\ . "SPC")
425 (?\C-? . "DEL"))) 440 (?\C-? . "DEL")))
441 (modifier-prefix-alist '(("C" . control)
442 ("M" . meta)
443 ("S" . shift)
444 ("Sh" . shift)
445 ("A" . alt)
446 ("H" . hyper)
447 ("s" . super)))
426 ;; string-to-symbol-or-char converter 448 ;; string-to-symbol-or-char converter
427 (conv #'(lambda (arg) 449 (conv #'(lambda (arg)
428 (if (= (length arg) 1) 450 (if (= (length arg) 1)
429 (aref arg 0) 451 (aref arg 0)
430 (if (string-match "^<\\([^>]+\\)>$" arg) 452 (if (string-match "^<\\([^>]+\\)>$" arg)
482 ((string-match "^\\^" word) 504 ((string-match "^\\^" word)
483 ;; ^X == C-x 505 ;; ^X == C-x
484 (if (/= (length word) 2) 506 (if (/= (length word) 2)
485 (error "^ must be followed by one character")) 507 (error "^ must be followed by one character"))
486 (setq add (list 'control (aref word 0)))) 508 (setq add (list 'control (aref word 0))))
487 ((string-match "^[MCSsAH]-" word) 509 ((string-match "^\\([MCSsAH]\\|Sh\\)-" word)
488 ;; Parse C-* 510 ;; Parse C-* and stuff
489 (setq 511 (setq
490 add 512 add
491 (list 513 (list
492 (let ((pos1 0) 514 (let ((pos1 0)
493 (r1 nil) 515 (r1 nil)
494 follow) 516 follow curpart prefix)
495 (while (string-match "^[MCSsAH]-" (substring word pos1)) 517 (while (progn (setq curpart (substring word pos1))
496 (setq r1 (nconc 518 (string-match "^\\([MCSsAH]\\|Sh\\)-"
497 r1 519 curpart))
498 (list 520 (setq prefix (assoc (match-string 1 curpart)
499 (cdr (assq (aref word pos1) 521 modifier-prefix-alist))
500 '((?C . control) 522 (setq r1 (nconc r1 (list (cdr prefix))))
501 (?M . meta) 523 (callf + pos1 (1+ (length (car prefix)))))
502 (?S . shift)
503 (?A . alt)
504 (?H . hyper)
505 (?s . super)))))))
506 (setq pos1 (+ pos1 2)))
507 (setq follow (substring word pos1)) 524 (setq follow (substring word pos1))
508 (if (equal follow "") 525 (if (equal follow "")
509 (error "%s must precede a string" 526 (error "%s must precede a string"
510 (substring word 0 pos1))) 527 (substring word 0 pos1)))
511 (nconc r1 (list (funcall conv follow))))))) 528 (nconc r1 (list (funcall conv follow)))))))