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"