Mercurial > hg > xemacs-beta
diff lisp/utils/edmacro.el @ 118:7d55a9ba150c r20-1b11
Import from CVS: tag r20-1b11
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:24:17 +0200 |
parents | 4103f0995bd7 |
children | 34a5b81f86ba |
line wrap: on
line diff
--- a/lisp/utils/edmacro.el Mon Aug 13 09:23:08 2007 +0200 +++ b/lisp/utils/edmacro.el Mon Aug 13 09:24:17 2007 +0200 @@ -5,7 +5,7 @@ ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Hrvoje Niksic <hniksic@srce.hr> -- XEmacs port ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr> -;; Version: 3.05 +;; Version: 3.07 ;; Keywords: abbrev ;; This file is part of XEmacs. @@ -54,6 +54,15 @@ ;; This and `format-kbd-macro' can also be called directly as ;; Lisp functions. +;; The `kbd' macro calls `read-kbd-macro', but it is evaluated at +;; compile-time. It is good to use in your programs and +;; initializations, as you needn't know the internal keysym +;; representation. For example: +;; +;; (define-key foo-mode-map (kbd "C-c <up>") 'foo-up) +;; is the equivalent of +;; (define-key foo-mode-map [(control ?c) up] 'foo-up) + ;; Type `C-h m', or see the documentation for `edmacro-mode' below, ;; for information about the format of written keyboard macros. @@ -208,6 +217,12 @@ (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end))))) ;;;###autoload +(defmacro kbd (keys) + "Convert KEYS to the internal Emacs key representation." + `(eval-when-compile + (read-kbd-macro ,keys))) + +;;;###autoload (defun format-kbd-macro (&optional macro verbose) "Return the keyboard macro MACRO as a human-readable string. This string is suitable for passing to `read-kbd-macro'. @@ -423,6 +438,13 @@ (?\e . "ESC") (?\ . "SPC") (?\C-? . "DEL"))) + (modifier-prefix-alist '(("C" . control) + ("M" . meta) + ("S" . shift) + ("Sh" . shift) + ("A" . alt) + ("H" . hyper) + ("s" . super))) ;; string-to-symbol-or-char converter (conv #'(lambda (arg) (if (= (length arg) 1) @@ -484,26 +506,21 @@ (if (/= (length word) 2) (error "^ must be followed by one character")) (setq add (list 'control (aref word 0)))) - ((string-match "^[MCSsAH]-" word) - ;; Parse C-* + ((string-match "^\\([MCSsAH]\\|Sh\\)-" word) + ;; Parse C-* and stuff (setq add (list (let ((pos1 0) (r1 nil) - follow) - (while (string-match "^[MCSsAH]-" (substring word pos1)) - (setq r1 (nconc - r1 - (list - (cdr (assq (aref word pos1) - '((?C . control) - (?M . meta) - (?S . shift) - (?A . alt) - (?H . hyper) - (?s . super))))))) - (setq pos1 (+ pos1 2))) + follow curpart prefix) + (while (progn (setq curpart (substring word pos1)) + (string-match "^\\([MCSsAH]\\|Sh\\)-" + curpart)) + (setq prefix (assoc (match-string 1 curpart) + modifier-prefix-alist)) + (setq r1 (nconc r1 (list (cdr prefix)))) + (callf + pos1 (1+ (length (car prefix))))) (setq follow (substring word pos1)) (if (equal follow "") (error "%s must precede a string"