xemacs-beta: lisp/utils/edmacro.el comparison

comparison lisp/utils/edmacro.el @ 187:b405438285a2 r20-3b20

Import from CVS: tag r20-3b20

author	cvs
date	Mon, 13 Aug 2007 09:56:28 +0200
parents	8eaf7971accc
children

comparison

equal deleted inserted replaced

-:24ac94803b48
+:b405438285a2
 ;;; edmacro.el --- keyboard macro editor
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1997 Free Software Foundation, Inc.
 ;; Author: Dave Gillespie <daveg@synaptics.com>
-;;         Hrvoje Niksic <hniksic@srce.hr>  -- XEmacs port
+;;         Hrvoje Niksic <hniksic@srce.hr>  -- XEmacs rewrite
 ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
-;; Version: 3.17
+;; Version: 3.19
-;; Keywords: abbrev
+;; Keywords: abbrev, internal
 ;; This file is part of XEmacs.
 ;; XEmacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;; 02111-1307, USA.
 ;;; Synched up with: FSF 19.34.
-;;; The important parts of this file have been rewritten for XEmacs,
+;;; Most of this file has been rewritten for XEmacs, so the
-;;; so it's completely different from the FSF version.  The original
+;;; implementations are out of synch.  The original version depended
-;;; could not be used because it worked with the Emacs key
+;;; too closely on GNU Emacs key representation and the equivalence of
-;;; representation, and it mixed characters and integers too freely.
+;;; characters and integers to be usable.
 ;;; Commentary:
 ;;; Usage:
 ;;
 ;; characters, the command-name comments will be wrong but that
 ;; won't hurt anything.
 ;; With a prefix argument, `edit-kbd-macro' will format the
 ;; macro in a more concise way that omits the comments.
-;; This package requires GNU Emacs 19 or later, and daveg's CL
-;; package 2.02 or later.  (CL 2.02 comes standard starting with
-;; Emacs 19.18.)  This package does not work with Emacs 18 or
-;; Lucid Emacs.
-;; Ported to XEmacs.  This code will not run on GNU Emacs 19.  -hniksic
 ;;; Code:
 (eval-when-compile
 (require 'cl))
 (insert ";; Original keys: " fmt "\n")
 (unless store-hook
 	(insert "\nCommand: " (if cmd (symbol-name cmd) "none") "\n")
 	(let ((keys (where-is-internal (or cmd mac))))
 	  (if keys
-	      (insert "Key: " (edmacro-format-keys (car keys)) "\n")
+	      (dolist (key keys)
+		(insert "Key: " (edmacro-format-keys key) "\n"))
 	    (insert "Key: none\n"))))
 (insert "\nMacro:\n\n")
 (save-excursion
 	(insert fmtv "\n"))
 (recenter '(4))
 ;;;###autoload
 (defun read-kbd-macro (start &optional end)
 "Read the region as a keyboard macro definition.
 The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
 See documentation for `edmacro-mode' for details.
-Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored.
 The resulting macro is installed as the \"current\" keyboard macro.
 In Lisp, may also be called with a single STRING argument in which case
 the result is returned rather than being installed as the current macro.
-The result will be a string if possible, otherwise an event vector.
+The result will be a vector of keystrokes."
-Second argument NEED-VECTOR means to return an event vector always."
 (interactive "r")
 (if (stringp start)
 (edmacro-parse-keys start)
 (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end)))))
 ;;;###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'.
 Second argument VERBOSE means to put one command per line with comments.
-If VERBOSE is `1', put everything on one line.  If VERBOSE is omitted
+If VERBOSE is nil, put everything on one line."
-or nil, use a compact 80-column format."
 (and macro (symbolp macro) (setq macro (symbol-function macro)))
 (edmacro-format-keys (or macro last-kbd-macro) verbose))
 ;;; Commands for *Edit Macro* buffer.
 ("H" . hyper)
 ("s" . super)))
 ;;; Parsing a human-readable keyboard macro.
-;; Changes for XEmacs -- these two functions re-written from scratch.
+;; In XEmacs version of edmacro, edmacro-parse-keys always returns a
-;; edmacro-parse-keys always returns a vector.  edmacro-format-keys
+;; vector.  edmacro-format-keys accepts a vector (but works with a
-;; accepts a vector (but works with a string too).  Vector may contain
+;; string too).
-;; keypress events.      -hniksic
 (defun edmacro-parse-keys (string)
 (let* ((pos 0)
 	 (case-fold-search nil)
 	 res)
 (while (and (< pos (length string))
 	    ;; Comment (discard to EOL) .
 	    (setq pos (string-match "$" string pos))
 	  (push (edmacro-parse-word word) res))))
 (mapvector 'identity (apply 'nconc (nreverse res)))))
-;; Parse a word.
+;; Parse a "word".
 (defun edmacro-parse-word (word)
 (let ((force-sym nil)
 	(times 1)
 	abbr)
 (when (string-match "\\([0-9]+\\)\\*." word)
 	     ((setq abbr (assoc word word-to-sym))
 	      ;; Convert to symbol.
 	      (list (cdr abbr)))
 	     ((string-match "^\\^" word)
 	      ;; ^X == C-x
-	      (if (/= (length word) 2)
+	      (if (= (length word) 2)
-		  (error "^ must be followed by one character"))
+		  `((control ,(aref word 1)))
-	      `((control ,(aref word 1))))
+		(mapcar 'identity word)))
 	     ((string-match "^M--?[0-9]+$" word)
 	      ;; Special case: M- followed by an optional hyphen and
 	      ;; one or more digits
 	      (mapcar (lambda (digit)
 			(list 'meta digit))
 		      (substring word 2)))
 	     ((string-match "^\\([MCSsAH]\\|Sh\\)-" word)
 	      ;; Parse C-* and stuff
-	      (list
+	      (let ((pos1 0)
-	       (let ((pos1 0)
+		    (r1 nil)
-		     (r1 nil)
+		    follow curpart prefix)
-		     follow curpart prefix)
+		(while (progn (setq curpart (substring word pos1))
-		 (while (progn (setq curpart (substring word pos1))
+			      (string-match "^\\([MCSsAH]\\|Sh\\)-"
-			       (string-match "^\\([MCSsAH]\\|Sh\\)-"
+					    curpart))
-					     curpart))
+		  (setq prefix (assoc (match-string 1 curpart)
-		   (setq prefix (assoc (match-string 1 curpart)
+				      edmacro-modifiers))
-				       edmacro-modifiers))
+		  (push (cdr prefix) r1)
-		   (push (cdr prefix) r1)
+		  (incf pos1 (1+ (length (car prefix)))))
-		   (incf pos1 (1+ (length (car prefix)))))
+		(setq follow (substring word pos1))
-		 (setq follow (substring word pos1))
+		(if (equal follow "")
-		 (if (equal follow "")
+		    ;; we've got something like "C-M-" -- just let it be,
-		     (error "%s must precede a string"
+		    ;; because of the way `edmacro-format-keys' works.
-			    (substring word 0 pos1)))
+		    (mapcar 'identity word)
-		 (nconc (nreverse r1) (list (funcall conv follow))))))
+		  (list (nconc (nreverse r1) (list (funcall conv follow)))))))
 	     (force-sym
 	      ;; This must be a symbol
 	      (list (intern word)))
 	     (t
 	      ;; Characters
 	   (loop repeat times do (setq new (append add new)))
 	   new)))
 ;; Convert the keypress events in vector x to keys, and return a
 ;; vector of keys.  If a list element is not a keypress event, ignore
-;; it.
+;; it.  `events-to-keys' won't quite cut it here, as it is buggy.
 (defun edmacro-events-to-keys (x &optional list)
 (let (new)
 (mapc (lambda (el)
 	    (cond ((key-press-event-p el)
 		   (push (let ((mods (event-modifiers el)))
 (setq new (nreverse new))
 (if list
 	new
 (mapvector 'identity new))))
-;; Collapse a list of keys into a list of function keys, where
+;; Collapse a list of keys into a list of function keys, if any.
-;; applicable.
 (defun edmacro-fkeys (keys)
 (let (new k lookup)
 (while keys
 (setq k (nconc k (list (car keys))))
 (setq lookup (lookup-key function-key-map (mapvector 'identity k)))
 (pop keys))
 (when (keymapp lookup)
 	(push k new))
 (apply 'nconc (nreverse new))))
-;; Convert a character or symbol to string
+;; Convert a character or symbol to string.
 (defun edmacro-conv (char-or-sym add-<>)
 (let ((char-to-word '((?\0 . "NUL")
 			(?\r . "RET")
 			(?\n . "LFD")
 			(?\t . "TAB")
 (defun edmacro-format-1 (keys command times togetherp)
 (let ((res "")
 	(start keys)
 	el)
 (while keys
-(when (or (eq (car keys) ?-)
+(when (not (or togetherp (eq start keys)))
-		(eq (car keys) '-)
-		(eq (car keys) ?>)
-		(not (or togetherp (eq start keys))))
 	(callf concat res " "))
 (if (> times 1)
 	  (setq res (concat (format "%d*" times) res)))
 (setq el (car keys))
 (callf concat res
 		      (> times 1))
 		     (concat "<" my ">")
 		   my)))
 	      (t
 	       (cdr (edmacro-conv el t)))))
+(and (cdr keys)
+	   (memq (car keys) '(?- '- ?> ?^))
+	   (callf concat res " "))
 (pop keys))
 (if command
 	(callf concat res
 	  (make-string (max (- 3 (/ (length res) tab-width)) 1) ?\t)
 	  ";; "
 (not seq1))
 ;;; Formatting a keyboard macro as human-readable text.
 (defun edmacro-format-keys (macro &optional verbose)
-;; XEmacs:
 ;; If we're dealing with events, convert them to symbols first;
-;; also, deal with Fkeys.
+;; Then, collapse them into function keys, if possible.
 (setq macro (edmacro-fkeys (edmacro-events-to-keys macro t)))
 (let ((res ""))
 (while macro
 (let (key lookup (times 1) self-insert-p)
 	(loop

Mercurial > hg > xemacs-beta

comparison lisp/utils/edmacro.el @ 187:b405438285a2 r20-3b20