emacs: lisp/emulation/viper-macs.el comparison

comparison lisp/emulation/viper-macs.el @ 49598:0d8b17d428b5

Trailing whitepace deleted.

author	Juanma Barranquero <lekktu@gmail.com>
date	Tue, 04 Feb 2003 13:24:35 +0000
parents	633233bf2bbf
children	695cf19ef79e d7ddb3e565de

comparison

equal deleted inserted replaced

-:e88404e8f2cf
+:0d8b17d428b5
 ;;; Variables
 ;; Register holding last macro.
 (defvar viper-last-macro-reg nil)
 ;; format of the elements of kbd alists:
 ;; (name ((buf . macr)...(buf . macr)) ((maj-mode . macr)...) (t . macr))
 ;; kbd macro alist for Vi state
 (defvar viper-vi-kbd-macro-alist nil)
 ;; same for insert/replace state
 (defvar viper-insert-kbd-macro-alist nil)
 (define-key viper-emacs-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro)
 (message "Mapping %S in %s state.  Hit `C-x )' to complete the mapping"
 	       (viper-display-macro macro-name)
 	       (if ins "Insert" "Vi")))
 ))
 ;; Ex unmap
 (defun ex-unmap ()
 (let ((mod-char "")
 	temp macro-name ins)
 (setq temp (viper-fixup-macro (vconcat macro-name))) ;; copy and fixup
 (ex-fixup-history (format "unmap%s %S" mod-char
 			      (viper-display-macro temp)))
 (viper-unrecord-kbd-macro macro-name (if ins 'insert-state 'vi-state))
 ))
 ;; read arguments for ex-map
 (defun ex-map-read-args (variant)
 (let ((cursor-in-echo-area t)
 	(key-seq [])
 	temp key event message
 	macro-name macro-body args)
 (condition-case nil
 	(setq args (concat (ex-get-inline-cmd-args ".*map[!]*[ \t]?" "\n\C-m")
 			   " nil nil ")
 	      temp (read-from-string args)
 	      macro-name (car temp)
 	      macro-body (car (read-from-string args (cdr temp))))
 (error
 (signal
 	'error
 	'("map: Macro name and body must be a quoted string or a vector"))))
 ;; We expect macro-name to be a vector, a string, or a quoted string.
 ;; In the second case, it will emerge as a symbol when read from
 ;; the above read-from-string.  So we need to convert it into a string
 (if macro-name
 (cond ((vectorp macro-name) nil)
 	      ((stringp macro-name)
 	       (setq macro-name (vconcat macro-name)))
 	      (t (setq macro-name (vconcat (prin1-to-string macro-name)))))
 (message ":map%s <Name>" variant)(sit-for 2)
 (while
 	  (not (member key
 		    (sit-for 2)
 		    nil)
 		(viper-event-key event)))
 	)
 (setq macro-name key-seq))
 (if (= (length macro-name) 0)
 	(error "Can't map an empty macro name"))
 (setq macro-name (viper-fixup-macro macro-name))
 (if (viper-char-array-p macro-name)
 	(setq macro-name (viper-char-array-to-macro macro-name)))
 (if macro-body
 	(cond ((viper-char-array-p macro-body)
 	       (setq macro-body (viper-char-array-to-macro macro-body)))
 	      ((vectorp macro-body) nil)
 	      (t (error "map: Invalid syntax in macro definition"))))
 (setq cursor-in-echo-area nil)(sit-for 0) ; this overcomes xemacs tty bug
 (cons macro-name macro-body)))
 ;; read arguments for ex-unmap
 (defun ex-unmap-read-args (variant)
 (let ((cursor-in-echo-area t)
 	viper-vi-intercept-minor-mode viper-insert-intercept-minor-mode
 	viper-emacs-intercept-minor-mode
 	event message
 	key key-seq macro-name)
 (setq macro-name (ex-get-inline-cmd-args ".*unma?p?[!]*[ \t]*"))
 (if (> (length macro-name) 0)
 	()
 (message ":unmap%s <Name>" variant) (sit-for 2)
 (while
 	  (not
 		key
 		'(?\b ?\d '^? '^H (control h) (control \?) backspace delete))
 	       (setq key-seq (subseq key-seq 0 (- (length key-seq) 2))))
 	      ((member key '(tab (control i) ?\t))
 	       (setq key-seq (subseq key-seq 0 (1- (length key-seq))))
 	       (setq message
 		     (format
 		      ":unmap%s %s"
 		      variant (if (> (length key-seq) 0)
 				  (prin1-to-string
 				   (viper-display-macro key-seq))
 				"")))
 	       (setq key-seq
 		     (viper-do-sequence-completion key-seq macro-alist message))
 	       ))
 	(setq message
 	      (format
 	       ":unmap%s %s"
 	       variant (if (> (length key-seq) 0)
 			   (prin1-to-string
 			    (viper-display-macro key-seq))
 	)
 (setq macro-name key-seq))
 (if (= (length macro-name) 0)
 	(error "Can't unmap an empty macro name"))
 ;; convert macro names into vector, if starts with a `['
 (if (memq (elt macro-name 0) '(?\[ ?\"))
 	(car (read-from-string macro-name))
 (vconcat macro-name))
 ))
 ;; Terminate a Vi kbd macro.
 ;; optional argument IGNORE, if t, indicates that we are dealing with an
 ;; existing macro that needs to be registered, but there is no need to
 ;; terminate a kbd macro.
 (defun viper-end-mapping-kbd-macro (&optional ignore)
 	  (end-kbd-macro nil)
 	  (setq macro-body (viper-events-to-macro last-kbd-macro))
 	  ;; always go back to Vi, since this is where we started
 	  ;; defining macro
 	  (viper-change-state-to-vi)))
 (viper-record-kbd-macro macro-name
 			  (if ins 'insert-state 'vi-state)
 			  (viper-display-macro macro-body))
 (ex-fixup-history (format "map%s %S %S" mod-char
 			      (viper-display-macro macro-name)
 			      (viper-display-macro macro-body)))
 ))
 either `vi-state' or `insert-state'.  It specifies the Viper state in which to
 define the macro.  MACRO-BODY is a string that represents the keyboard macro.
 Optional SCOPE says whether the macro should be global \(t\), mode-specific
 \(a major-mode symbol\), or buffer-specific \(buffer name, a string\).
 If SCOPE is nil, the user is asked to specify the scope."
 (let* (state-name keymap
 	 (macro-alist-var
 	  (cond ((eq state 'vi-state)
 		 (setq state-name "Vi state"
 		       keymap viper-vi-kbd-map)
 		 'viper-vi-kbd-macro-alist)
 		       keymap viper-emacs-kbd-map)
 		 'viper-emacs-kbd-macro-alist)
 		 ))
 	 new-elt old-elt old-sub-elt msg
 	 temp lis lis2)
 (if (= (length macro-name) 0)
 	(error "Can't map an empty macro name"))
 ;; Macro-name is usually a vector.  However, command history or macros
 ;; recorded in ~/.viper may be recorded as strings.  So, convert to
 ;; vectors.
 (setq macro-name (viper-fixup-macro macro-name))
 (if (viper-char-array-p macro-name)
 	(setq macro-name (viper-char-array-to-macro macro-name)))
 (setq macro-body (viper-fixup-macro macro-body))
 (if (viper-char-array-p macro-body)
 	(setq macro-body (viper-char-array-to-macro macro-body)))
 ;; don't ask if scope is given and is of the right type
 (or (eq scope t)
 	(stringp scope)
 	(and scope (symbolp scope))
 	(progn
 			 state-name))
 		  t)))
 	  (if (y-or-n-p
 	       (format "Save this macro in %s? "
 		       (viper-abbreviate-file-name viper-custom-file-name)))
 	      (viper-save-string-in-file
 	       (format "\n(viper-record-kbd-macro %S '%S %s '%S)"
 		       (viper-display-macro macro-name)
 		       state
 		       ;; if we don't let vector macro-body through %S,
 		       ;; the symbols `\.' `\[' etc will be converted into
 		       ;; I am not sure is macro-body can still be a string at
 		       ;; this point, but I am preserving this option anyway.
 		       (if (vectorp macro-body)
 			   (format "%S" macro-body)
 			 macro-body)
 		       scope)
 	       viper-custom-file-name))
 	  (message msg)
 	  ))
 (setq new-elt
 	  (cons macro-name
 		(cond ((eq scope t) (list nil nil (cons t nil)))
 		      ((symbolp scope)
 		       (list nil (list (cons scope nil)) (cons t nil)))
 	    (setq lis (eval macro-alist-var))
 	    (while (and lis (string< (viper-array-to-string (car (car lis)))
 				     (viper-array-to-string macro-name)))
 	      (setq lis2 (cons (car lis) lis2))
 	      (setq lis (cdr lis)))
 	    (setq lis2 (reverse lis2))
 	    (set macro-alist-var (append lis2 (cons new-elt lis)))
 	    (setq old-elt new-elt)))
 (setq old-sub-elt
 	  (cond ((eq scope t) (viper-kbd-global-pair old-elt))
 		((symbolp scope) (assoc scope (viper-kbd-mode-alist old-elt)))
 		((stringp scope) (assoc scope (viper-kbd-buf-alist old-elt)))))
 (if old-sub-elt
 	(setcdr old-sub-elt macro-body)
 (cond ((symbolp scope) (setcar (cdr (cdr old-elt))
 				     (cons (cons scope macro-body)
 					   (viper-kbd-mode-alist old-elt))))
 	    ((stringp scope) (setcar (cdr old-elt)
 				     (cons (cons scope macro-body)
 					   (viper-kbd-buf-alist old-elt))))))
 ))
 ;; macro name must be a vector of viper-style keys
 (defun viper-unrecord-kbd-macro (macro-name state)
 "Delete macro MACRO-NAME from Viper STATE.
 MACRO-NAME must be a vector of viper-style keys.  This command is used by Viper
 internally, but the user can also use it in ~/.viper to delete pre-defined
 macros supplied with Viper.  The best way to avoid mistakes in macro names to
 be passed to this function is to use viper-describe-kbd-macros and copy the
 name from there."
 (let* (state-name keymap
 	 (macro-alist-var
 	  (cond ((eq state 'vi-state)
 		 (setq state-name "Vi state"
 		       keymap viper-vi-kbd-map)
 		 'viper-vi-kbd-macro-alist)
 		       keymap viper-emacs-kbd-map)
 		 'viper-emacs-kbd-macro-alist)
 		))
 	 buf-mapping mode-mapping global-mapping
 	 macro-pair macro-entry)
 ;; Macro-name is usually a vector.  However, command history or macros
 ;; recorded in ~/.viper may appear as strings.  So, convert to vectors.
 (setq macro-name (viper-fixup-macro macro-name))
 (if (viper-char-array-p macro-name)
 	(setq macro-name (viper-char-array-to-macro macro-name)))
 	(error "Can't unmap an empty macro name"))
 (if (null macro-entry)
 	(error "%S is not mapped to a macro for %s in `%s'"
 	       (viper-display-macro macro-name)
 	       state-name (buffer-name)))
 (setq buf-mapping (viper-kbd-buf-pair macro-entry)
 	  mode-mapping (viper-kbd-mode-pair macro-entry)
 	  global-mapping (viper-kbd-global-pair macro-entry))
 (cond ((and (cdr buf-mapping)
 		(or (and (not (cdr mode-mapping)) (not (cdr global-mapping)))
 		    (y-or-n-p
 		     (format "Unmap %S for `%s' only? "
 			     (viper-display-macro macro-name)
 			     (buffer-name)))))
 	   (setq macro-pair buf-mapping)
 	   (message "%S is unmapped for %s in `%s'"
 		    (viper-display-macro macro-name)
 		    state-name (buffer-name)))
 	  ((and (cdr mode-mapping)
 		(or (not (cdr global-mapping))
 		    (y-or-n-p
 (or (cdr buf-mapping)
 	(cdr mode-mapping)
 	(cdr global-mapping)
 	(progn
 	  (set macro-alist-var (delq macro-entry (eval macro-alist-var)))
 	  (if (viper-can-release-key (aref macro-name 0)
 				   (eval macro-alist-var))
 	      (define-key
 		keymap
 		(vector (viper-key-to-emacs-key (aref macro-name 0)))
 		nil))
 	  ))
 ))
 ;; Check if MACRO-ALIST has an entry for a macro name starting with
 ;; CHAR.  If not, this indicates that the binding for this char
 ;; in viper-vi/insert-kbd-map can be released.
 (defun viper-can-release-key (char macro-alist)
 (let ((lis macro-alist)
 	(can-release t)
 	macro-name)
 (while (and lis can-release)
 (setq macro-name (car (car lis)))
 (if (eq char (aref macro-name 0))
 	  (setq can-release nil))
 (setq lis (cdr lis)))
 	viper-vi-kbd-minor-mode viper-insert-kbd-minor-mode
 	viper-emacs-kbd-minor-mode
 	next-best-match keyseq event-seq
 	macro-first-char macro-alist-elt macro-body
 	command)
 (setq macro-first-char last-command-event
 	  event-seq (viper-read-fast-keysequence macro-first-char macro-alist)
 	  keyseq (viper-events-to-macro event-seq)
 	  macro-alist-elt (assoc keyseq macro-alist)
 	  next-best-match (viper-find-best-matching-macro macro-alist keyseq))
 (if (null macro-alist-elt)
 	(setq macro-alist-elt (car next-best-match)
 	      unmatched-suffix (subseq event-seq (cdr next-best-match))))
 (cond ((null macro-alist-elt))
 	  ((setq macro-body (viper-kbd-buf-definition macro-alist-elt)))
 	  ((setq macro-body (viper-kbd-mode-definition macro-alist-elt)))
 	  ((setq macro-body (viper-kbd-global-definition macro-alist-elt))))
 ;; when defining keyboard macro, don't use the macro mappings
 (if (and macro-body (not defining-kbd-macro))
 	;; block cmd executed as part of a macro from entering command history
 	(let ((command-history command-history))
 	  (setq viper-this-kbd-macro (car macro-alist-elt))
 (viper-set-unread-command-events event-seq)
 ;; if the user typed arg, then use it if prefix arg is not set by
 ;; some other command (setting prefix arg can happen if we do, say,
 ;; 2dw and there is a macro starting with 2.  Then control will go to
 ;; this routine
 (or prefix-arg (setq  prefix-arg count))
 (setq command (key-binding (read-key-sequence nil)))
 (if (commandp command)
 	  (command-execute command)
 	(beep 1)))
 ))
 ;;; Displaying and completing macros
 (defun viper-describe-kbd-macros ()
 "Show currently defined keyboard macros."
 (interactive)
 (with-output-to-temp-buffer " *viper-info*"
 (princ "Macros in Vi state:\n===================\n")
 (princ "\n\nMacros in Insert and Replace states:\n====================================\n")
 (mapcar 'viper-describe-one-macro viper-insert-kbd-macro-alist)
 (princ "\n\nMacros in Emacs state:\n======================\n")
 (mapcar 'viper-describe-one-macro viper-emacs-kbd-macro-alist)
 ))
 (defun viper-describe-one-macro (macro)
 (princ (format "\n  *** Mappings for %S:\n      ------------\n"
 		 (viper-display-macro (car macro))))
 (princ "   ** Buffer-specific:")
 (if (viper-kbd-buf-alist macro)
 (princ "\n   ** Global:")
 (if (viper-kbd-global-definition macro)
 (princ (format "\n           %S" (cdr (viper-kbd-global-pair macro))))
 (princ "  none"))
 (princ "\n"))
 (defun viper-describe-one-macro-elt (elt)
 (let ((name (car elt))
 	(defn (cdr elt)))
 (princ (format "\n       * %S:\n           %S\n" name defn))))
 ;; check if SEQ is a prefix of some car of an element in ALIST
 (defun viper-keyseq-is-a-possible-macro (seq alist)
 (let ((converted-seq (viper-events-to-macro seq)))
 (eval (cons 'or
 		(mapcar
 		 (lambda (elt) (viper-prefix-subseq-p converted-seq elt))
 		 (viper-this-buffer-macros alist))))))
 ;; whether SEQ1 is a prefix of SEQ2
 (defun viper-prefix-subseq-p (seq1 seq2)
 (let ((len1 (length seq1))
 	(len2 (length seq2)))
 (if (<= len1 len2)
 	(equal seq1 (subseq seq2 0 len1)))))
 ;; find the longest common prefix
 (defun viper-common-seq-prefix (&rest seqs)
 (let* ((first (car seqs))
 	 (rest (cdr seqs))
 	 (pref [])
 	 len)
 (if (= (length seqs) 0)
 	(setq len 0)
 (setq len (apply 'min (mapcar 'length seqs))))
 (while (< idx len)
 (if (eval (cons 'and
 		      (mapcar (lambda (s) (equal (elt first idx) (elt s idx)))
 			      rest)))
 	  (setq pref (vconcat pref (vector (elt first idx)))))
 (setq idx (1+ idx)))
 pref))
 ;; get all sequences that match PREFIX from a given A-LIST
 (defun viper-extract-matching-alist-members (pref alist)
 (delq nil (mapcar (lambda (elt) (if (viper-prefix-subseq-p pref elt) elt))
 		    (viper-this-buffer-macros alist))))
 (defun viper-do-sequence-completion (seq alist compl-message)
 (let* ((matches (viper-extract-matching-alist-members seq alist))
 	 (new-seq (apply 'viper-common-seq-prefix matches))
 	 )
 (cond ((and (equal seq new-seq) (= (length matches) 1))
 	   (message "%s (Sole completion)" compl-message)
 	   (sit-for 2))
 	  ((null matches)
 	   (message "%s (No match)" compl-message)
 	   (sit-for 2)
 	   (setq new-seq seq))
 	  ((member seq matches)
 	   (message "%s (Complete, but not unique)" compl-message)
 	   (sit-for 2)
 	   (viper-display-vector-completions matches))
 	  ((equal seq new-seq)
 	   (viper-display-vector-completions matches)))
 new-seq))
 (defun viper-display-vector-completions (list)
 (with-output-to-temp-buffer "*Completions*"
 (display-completion-list
 (mapcar 'prin1-to-string
 	     (mapcar 'viper-display-macro list)))))
 ;; alist is the alist of macros
 ;; str is the fast key sequence entered
 ;; returns: (matching-macro-def . unmatched-suffix-start-index)
 (defun viper-find-best-matching-macro (alist str)
 (let ((lis alist)
 		  (viper-kbd-mode-definition macro-def)
 		  (viper-kbd-global-definition macro-def))
 	      (setq found t))
 	)
 (setq lis (cdr lis)))
 (if found
 	(setq match macro-def
 	      unmatched-start-idx def-len)
 (setq match nil
 	    unmatched-start-idx 0))
 (cons match unmatched-start-idx)))
 ;; returns a list of names of macros defined for the current buffer
 (defun viper-this-buffer-macros (macro-alist)
 (let (candidates)
 (setq candidates
 	  (mapcar (lambda (elt)
 			    (viper-kbd-mode-definition elt)
 			    (viper-kbd-global-definition elt))
 			(car elt)))
 		  macro-alist))
 (setq candidates (delq nil candidates))))
 ;; if seq of Viper key symbols (representing a macro) can be converted to a
 ;; string--do so.  Otherwise, do nothing.
 (defun viper-display-macro (macro-name-or-body)
 (cond ((viper-char-symbol-sequence-p macro-name-or-body)
 	 (mapconcat 'symbol-name macro-name-or-body ""))
 	((viper-char-array-p macro-name-or-body)
 	 (mapconcat 'char-to-string macro-name-or-body ""))
 	(t macro-name-or-body)))
 ;; convert sequence of events (that came presumably from emacs kbd macro) into
 ;; Viper's macro, which is a vector of the form
 ;; [ desc desc ... ]
 ;; Each desc is either a symbol of (meta symb), (shift symb), etc.
 ;; Here we purge events that happen to be lists.  In most cases, these events
 (defun viper-events-to-macro (event-seq)
 (vconcat (delq nil (mapcar (lambda (elt) (if (consp elt)
 					       nil
 					     (viper-event-key elt)))
 			     event-seq))))
 ;; convert strings or arrays of characters to Viper macro form
 (defun viper-char-array-to-macro (array)
 (let ((vec (vconcat array))
 	macro)
 (if viper-xemacs-p
 	(setq macro (mapcar 'character-to-event vec))
 (setq macro vec))
 (vconcat (mapcar 'viper-event-key macro))))
 ;; For macros bodies and names, goes over MACRO and checks if all members are
 ;; names of keys (actually, it only checks if they are symbols or lists
 ;; if a digit is found, it is converted into a symbol (e.g., 0 -> \0, etc).
 ;; If MACRO is not a list or vector -- doesn't change MACRO.
 (defun viper-fixup-macro (macro)
 		((listp elt)
 		 (viper-fixup-macro elt))
 		((symbolp elt) nil)
 		(t (setq break t)))
 	  (setq idx (1+ idx))))
 (if break
 	  (error "Wrong type macro component, symbol-or-listp, %S" elt)
 	macro)))
 (defun viper-macro-to-events (macro-body)
 (vconcat (mapcar 'viper-key-to-emacs-key macro-body)))
 ;;; Reading fast key sequences
 ;; Assuming that CHAR was the first character in a fast succession of key
 ;; strokes, read the rest.  Return the vector of keys that was entered in
 ;; this fast succession of key strokes.
 ;; A fast keysequence is one that is terminated by a pause longer than
 ;; viper-fast-keyseq-timeout.
 	       (progn
 		 (end-kbd-macro)
 		 (viper-set-register-macro reg))
 	     (execute-kbd-macro (get-register reg) count)))
 	  ((or (= ?@ reg) (= ?\^j reg) (= ?\^m reg))
 	   (if viper-last-macro-reg
 	       nil
 	       (error "No previous kbd macro"))
 	   (execute-kbd-macro (get-register viper-last-macro-reg) count))
 	  ((= ?\# reg)
 	   (start-kbd-macro count))
 	       (progn
 	       (setq viper-last-macro-reg reg)
 	       (viper-set-register-macro reg))))
 	  (t
 	   (error "`%c': Unknown register" reg)))))
 (defun viper-global-execute ()
 "Call last keyboad macro for each line in the region."
 (if (> (point) (mark t)) (exchange-point-and-mark))
 (beginning-of-line)

Mercurial > emacs

comparison lisp/emulation/viper-macs.el @ 49598:0d8b17d428b5