58 |
;; Register holding last macro. |
;; Register holding last macro. |
59 |
(defvar viper-last-macro-reg nil) |
(defvar viper-last-macro-reg nil) |
60 |
|
|
61 |
;; format of the elements of kbd alists: |
;; format of the elements of kbd alists: |
62 |
;; (name ((buf . macr)...(buf . macr)) ((maj-mode . macr)...) (t . macr)) |
;; (name ((buf . macr)...(buf . macr)) ((maj-mode . macr)...) (t . macr)) |
63 |
;; kbd macro alist for Vi state |
;; kbd macro alist for Vi state |
64 |
(defvar viper-vi-kbd-macro-alist nil) |
(defvar viper-vi-kbd-macro-alist nil) |
121 |
(viper-display-macro macro-name) |
(viper-display-macro macro-name) |
122 |
(if ins "Insert" "Vi"))) |
(if ins "Insert" "Vi"))) |
123 |
)) |
)) |
124 |
|
|
125 |
|
|
126 |
;; Ex unmap |
;; Ex unmap |
127 |
(defun ex-unmap () |
(defun ex-unmap () |
141 |
(viper-display-macro temp))) |
(viper-display-macro temp))) |
142 |
(viper-unrecord-kbd-macro macro-name (if ins 'insert-state 'vi-state)) |
(viper-unrecord-kbd-macro macro-name (if ins 'insert-state 'vi-state)) |
143 |
)) |
)) |
144 |
|
|
145 |
|
|
146 |
;; read arguments for ex-map |
;; read arguments for ex-map |
147 |
(defun ex-map-read-args (variant) |
(defun ex-map-read-args (variant) |
149 |
(key-seq []) |
(key-seq []) |
150 |
temp key event message |
temp key event message |
151 |
macro-name macro-body args) |
macro-name macro-body args) |
152 |
|
|
153 |
(condition-case nil |
(condition-case nil |
154 |
(setq args (concat (ex-get-inline-cmd-args ".*map[!]*[ \t]?" "\n\C-m") |
(setq args (concat (ex-get-inline-cmd-args ".*map[!]*[ \t]?" "\n\C-m") |
155 |
" nil nil ") |
" nil nil ") |
158 |
macro-body (car (read-from-string args (cdr temp)))) |
macro-body (car (read-from-string args (cdr temp)))) |
159 |
(error |
(error |
160 |
(signal |
(signal |
161 |
'error |
'error |
162 |
'("map: Macro name and body must be a quoted string or a vector")))) |
'("map: Macro name and body must be a quoted string or a vector")))) |
163 |
|
|
164 |
;; We expect macro-name to be a vector, a string, or a quoted string. |
;; We expect macro-name to be a vector, a string, or a quoted string. |
165 |
;; In the second case, it will emerge as a symbol when read from |
;; In the second case, it will emerge as a symbol when read from |
166 |
;; the above read-from-string. So we need to convert it into a string |
;; the above read-from-string. So we need to convert it into a string |
167 |
(if macro-name |
(if macro-name |
168 |
(cond ((vectorp macro-name) nil) |
(cond ((vectorp macro-name) nil) |
169 |
((stringp macro-name) |
((stringp macro-name) |
170 |
(setq macro-name (vconcat macro-name))) |
(setq macro-name (vconcat macro-name))) |
171 |
(t (setq macro-name (vconcat (prin1-to-string macro-name))))) |
(t (setq macro-name (vconcat (prin1-to-string macro-name))))) |
172 |
(message ":map%s <Name>" variant)(sit-for 2) |
(message ":map%s <Name>" variant)(sit-for 2) |
198 |
(viper-event-key event))) |
(viper-event-key event))) |
199 |
) |
) |
200 |
(setq macro-name key-seq)) |
(setq macro-name key-seq)) |
201 |
|
|
202 |
(if (= (length macro-name) 0) |
(if (= (length macro-name) 0) |
203 |
(error "Can't map an empty macro name")) |
(error "Can't map an empty macro name")) |
204 |
(setq macro-name (viper-fixup-macro macro-name)) |
(setq macro-name (viper-fixup-macro macro-name)) |
205 |
(if (viper-char-array-p macro-name) |
(if (viper-char-array-p macro-name) |
206 |
(setq macro-name (viper-char-array-to-macro macro-name))) |
(setq macro-name (viper-char-array-to-macro macro-name))) |
207 |
|
|
208 |
(if macro-body |
(if macro-body |
209 |
(cond ((viper-char-array-p macro-body) |
(cond ((viper-char-array-p macro-body) |
210 |
(setq macro-body (viper-char-array-to-macro macro-body))) |
(setq macro-body (viper-char-array-to-macro macro-body))) |
212 |
(t (error "map: Invalid syntax in macro definition")))) |
(t (error "map: Invalid syntax in macro definition")))) |
213 |
(setq cursor-in-echo-area nil)(sit-for 0) ; this overcomes xemacs tty bug |
(setq cursor-in-echo-area nil)(sit-for 0) ; this overcomes xemacs tty bug |
214 |
(cons macro-name macro-body))) |
(cons macro-name macro-body))) |
215 |
|
|
216 |
|
|
217 |
|
|
218 |
;; read arguments for ex-unmap |
;; read arguments for ex-unmap |
230 |
event message |
event message |
231 |
key key-seq macro-name) |
key key-seq macro-name) |
232 |
(setq macro-name (ex-get-inline-cmd-args ".*unma?p?[!]*[ \t]*")) |
(setq macro-name (ex-get-inline-cmd-args ".*unma?p?[!]*[ \t]*")) |
233 |
|
|
234 |
(if (> (length macro-name) 0) |
(if (> (length macro-name) 0) |
235 |
() |
() |
236 |
(message ":unmap%s <Name>" variant) (sit-for 2) |
(message ":unmap%s <Name>" variant) (sit-for 2) |
245 |
(setq key-seq (subseq key-seq 0 (- (length key-seq) 2)))) |
(setq key-seq (subseq key-seq 0 (- (length key-seq) 2)))) |
246 |
((member key '(tab (control i) ?\t)) |
((member key '(tab (control i) ?\t)) |
247 |
(setq key-seq (subseq key-seq 0 (1- (length key-seq)))) |
(setq key-seq (subseq key-seq 0 (1- (length key-seq)))) |
248 |
(setq message |
(setq message |
249 |
(format |
(format |
250 |
":unmap%s %s" |
":unmap%s %s" |
251 |
variant (if (> (length key-seq) 0) |
variant (if (> (length key-seq) 0) |
255 |
(setq key-seq |
(setq key-seq |
256 |
(viper-do-sequence-completion key-seq macro-alist message)) |
(viper-do-sequence-completion key-seq macro-alist message)) |
257 |
)) |
)) |
258 |
(setq message |
(setq message |
259 |
(format |
(format |
260 |
":unmap%s %s" |
":unmap%s %s" |
261 |
variant (if (> (length key-seq) 0) |
variant (if (> (length key-seq) 0) |
278 |
|
|
279 |
(if (= (length macro-name) 0) |
(if (= (length macro-name) 0) |
280 |
(error "Can't unmap an empty macro name")) |
(error "Can't unmap an empty macro name")) |
281 |
|
|
282 |
;; convert macro names into vector, if starts with a `[' |
;; convert macro names into vector, if starts with a `[' |
283 |
(if (memq (elt macro-name 0) '(?\[ ?\")) |
(if (memq (elt macro-name 0) '(?\[ ?\")) |
284 |
(car (read-from-string macro-name)) |
(car (read-from-string macro-name)) |
285 |
(vconcat macro-name)) |
(vconcat macro-name)) |
286 |
)) |
)) |
287 |
|
|
288 |
|
|
289 |
;; Terminate a Vi kbd macro. |
;; Terminate a Vi kbd macro. |
290 |
;; optional argument IGNORE, if t, indicates that we are dealing with an |
;; optional argument IGNORE, if t, indicates that we are dealing with an |
291 |
;; existing macro that needs to be registered, but there is no need to |
;; existing macro that needs to be registered, but there is no need to |
311 |
;; always go back to Vi, since this is where we started |
;; always go back to Vi, since this is where we started |
312 |
;; defining macro |
;; defining macro |
313 |
(viper-change-state-to-vi))) |
(viper-change-state-to-vi))) |
314 |
|
|
315 |
(viper-record-kbd-macro macro-name |
(viper-record-kbd-macro macro-name |
316 |
(if ins 'insert-state 'vi-state) |
(if ins 'insert-state 'vi-state) |
317 |
(viper-display-macro macro-body)) |
(viper-display-macro macro-body)) |
318 |
|
|
319 |
(ex-fixup-history (format "map%s %S %S" mod-char |
(ex-fixup-history (format "map%s %S %S" mod-char |
320 |
(viper-display-macro macro-name) |
(viper-display-macro macro-name) |
321 |
(viper-display-macro macro-body))) |
(viper-display-macro macro-body))) |
337 |
Optional SCOPE says whether the macro should be global \(t\), mode-specific |
Optional SCOPE says whether the macro should be global \(t\), mode-specific |
338 |
\(a major-mode symbol\), or buffer-specific \(buffer name, a string\). |
\(a major-mode symbol\), or buffer-specific \(buffer name, a string\). |
339 |
If SCOPE is nil, the user is asked to specify the scope." |
If SCOPE is nil, the user is asked to specify the scope." |
340 |
(let* (state-name keymap |
(let* (state-name keymap |
341 |
(macro-alist-var |
(macro-alist-var |
342 |
(cond ((eq state 'vi-state) |
(cond ((eq state 'vi-state) |
343 |
(setq state-name "Vi state" |
(setq state-name "Vi state" |
354 |
)) |
)) |
355 |
new-elt old-elt old-sub-elt msg |
new-elt old-elt old-sub-elt msg |
356 |
temp lis lis2) |
temp lis lis2) |
357 |
|
|
358 |
(if (= (length macro-name) 0) |
(if (= (length macro-name) 0) |
359 |
(error "Can't map an empty macro name")) |
(error "Can't map an empty macro name")) |
360 |
|
|
361 |
;; Macro-name is usually a vector. However, command history or macros |
;; Macro-name is usually a vector. However, command history or macros |
362 |
;; recorded in ~/.viper may be recorded as strings. So, convert to |
;; recorded in ~/.viper may be recorded as strings. So, convert to |
363 |
;; vectors. |
;; vectors. |
364 |
(setq macro-name (viper-fixup-macro macro-name)) |
(setq macro-name (viper-fixup-macro macro-name)) |
365 |
(if (viper-char-array-p macro-name) |
(if (viper-char-array-p macro-name) |
366 |
(setq macro-name (viper-char-array-to-macro macro-name))) |
(setq macro-name (viper-char-array-to-macro macro-name))) |
367 |
(setq macro-body (viper-fixup-macro macro-body)) |
(setq macro-body (viper-fixup-macro macro-body)) |
368 |
(if (viper-char-array-p macro-body) |
(if (viper-char-array-p macro-body) |
369 |
(setq macro-body (viper-char-array-to-macro macro-body))) |
(setq macro-body (viper-char-array-to-macro macro-body))) |
370 |
|
|
371 |
;; don't ask if scope is given and is of the right type |
;; don't ask if scope is given and is of the right type |
372 |
(or (eq scope t) |
(or (eq scope t) |
373 |
(stringp scope) |
(stringp scope) |
423 |
(if (y-or-n-p |
(if (y-or-n-p |
424 |
(format "Save this macro in %s? " |
(format "Save this macro in %s? " |
425 |
(viper-abbreviate-file-name viper-custom-file-name))) |
(viper-abbreviate-file-name viper-custom-file-name))) |
426 |
(viper-save-string-in-file |
(viper-save-string-in-file |
427 |
(format "\n(viper-record-kbd-macro %S '%S %s '%S)" |
(format "\n(viper-record-kbd-macro %S '%S %s '%S)" |
428 |
(viper-display-macro macro-name) |
(viper-display-macro macro-name) |
429 |
state |
state |
436 |
(if (vectorp macro-body) |
(if (vectorp macro-body) |
437 |
(format "%S" macro-body) |
(format "%S" macro-body) |
438 |
macro-body) |
macro-body) |
439 |
scope) |
scope) |
440 |
viper-custom-file-name)) |
viper-custom-file-name)) |
441 |
|
|
442 |
(message msg) |
(message msg) |
443 |
)) |
)) |
444 |
|
|
445 |
(setq new-elt |
(setq new-elt |
446 |
(cons macro-name |
(cons macro-name |
447 |
(cond ((eq scope t) (list nil nil (cons t nil))) |
(cond ((eq scope t) (list nil nil (cons t nil))) |
463 |
(viper-array-to-string macro-name))) |
(viper-array-to-string macro-name))) |
464 |
(setq lis2 (cons (car lis) lis2)) |
(setq lis2 (cons (car lis) lis2)) |
465 |
(setq lis (cdr lis))) |
(setq lis (cdr lis))) |
466 |
|
|
467 |
(setq lis2 (reverse lis2)) |
(setq lis2 (reverse lis2)) |
468 |
(set macro-alist-var (append lis2 (cons new-elt lis))) |
(set macro-alist-var (append lis2 (cons new-elt lis))) |
469 |
(setq old-elt new-elt))) |
(setq old-elt new-elt))) |
471 |
(cond ((eq scope t) (viper-kbd-global-pair old-elt)) |
(cond ((eq scope t) (viper-kbd-global-pair old-elt)) |
472 |
((symbolp scope) (assoc scope (viper-kbd-mode-alist old-elt))) |
((symbolp scope) (assoc scope (viper-kbd-mode-alist old-elt))) |
473 |
((stringp scope) (assoc scope (viper-kbd-buf-alist old-elt))))) |
((stringp scope) (assoc scope (viper-kbd-buf-alist old-elt))))) |
474 |
(if old-sub-elt |
(if old-sub-elt |
475 |
(setcdr old-sub-elt macro-body) |
(setcdr old-sub-elt macro-body) |
476 |
(cond ((symbolp scope) (setcar (cdr (cdr old-elt)) |
(cond ((symbolp scope) (setcar (cdr (cdr old-elt)) |
477 |
(cons (cons scope macro-body) |
(cons (cons scope macro-body) |
480 |
(cons (cons scope macro-body) |
(cons (cons scope macro-body) |
481 |
(viper-kbd-buf-alist old-elt)))))) |
(viper-kbd-buf-alist old-elt)))))) |
482 |
)) |
)) |
|
|
|
483 |
|
|
484 |
|
|
485 |
|
|
486 |
;; macro name must be a vector of viper-style keys |
;; macro name must be a vector of viper-style keys |
487 |
(defun viper-unrecord-kbd-macro (macro-name state) |
(defun viper-unrecord-kbd-macro (macro-name state) |
488 |
"Delete macro MACRO-NAME from Viper STATE. |
"Delete macro MACRO-NAME from Viper STATE. |
491 |
macros supplied with Viper. The best way to avoid mistakes in macro names to |
macros supplied with Viper. The best way to avoid mistakes in macro names to |
492 |
be passed to this function is to use viper-describe-kbd-macros and copy the |
be passed to this function is to use viper-describe-kbd-macros and copy the |
493 |
name from there." |
name from there." |
494 |
(let* (state-name keymap |
(let* (state-name keymap |
495 |
(macro-alist-var |
(macro-alist-var |
496 |
(cond ((eq state 'vi-state) |
(cond ((eq state 'vi-state) |
497 |
(setq state-name "Vi state" |
(setq state-name "Vi state" |
508 |
)) |
)) |
509 |
buf-mapping mode-mapping global-mapping |
buf-mapping mode-mapping global-mapping |
510 |
macro-pair macro-entry) |
macro-pair macro-entry) |
511 |
|
|
512 |
;; Macro-name is usually a vector. However, command history or macros |
;; Macro-name is usually a vector. However, command history or macros |
513 |
;; recorded in ~/.viper may appear as strings. So, convert to vectors. |
;; recorded in ~/.viper may appear as strings. So, convert to vectors. |
514 |
(setq macro-name (viper-fixup-macro macro-name)) |
(setq macro-name (viper-fixup-macro macro-name)) |
522 |
(error "%S is not mapped to a macro for %s in `%s'" |
(error "%S is not mapped to a macro for %s in `%s'" |
523 |
(viper-display-macro macro-name) |
(viper-display-macro macro-name) |
524 |
state-name (buffer-name))) |
state-name (buffer-name))) |
525 |
|
|
526 |
(setq buf-mapping (viper-kbd-buf-pair macro-entry) |
(setq buf-mapping (viper-kbd-buf-pair macro-entry) |
527 |
mode-mapping (viper-kbd-mode-pair macro-entry) |
mode-mapping (viper-kbd-mode-pair macro-entry) |
528 |
global-mapping (viper-kbd-global-pair macro-entry)) |
global-mapping (viper-kbd-global-pair macro-entry)) |
529 |
|
|
530 |
(cond ((and (cdr buf-mapping) |
(cond ((and (cdr buf-mapping) |
531 |
(or (and (not (cdr mode-mapping)) (not (cdr global-mapping))) |
(or (and (not (cdr mode-mapping)) (not (cdr global-mapping))) |
532 |
(y-or-n-p |
(y-or-n-p |
534 |
(viper-display-macro macro-name) |
(viper-display-macro macro-name) |
535 |
(buffer-name))))) |
(buffer-name))))) |
536 |
(setq macro-pair buf-mapping) |
(setq macro-pair buf-mapping) |
537 |
(message "%S is unmapped for %s in `%s'" |
(message "%S is unmapped for %s in `%s'" |
538 |
(viper-display-macro macro-name) |
(viper-display-macro macro-name) |
539 |
state-name (buffer-name))) |
state-name (buffer-name))) |
540 |
((and (cdr mode-mapping) |
((and (cdr mode-mapping) |
559 |
(cdr global-mapping) |
(cdr global-mapping) |
560 |
(progn |
(progn |
561 |
(set macro-alist-var (delq macro-entry (eval macro-alist-var))) |
(set macro-alist-var (delq macro-entry (eval macro-alist-var))) |
562 |
(if (viper-can-release-key (aref macro-name 0) |
(if (viper-can-release-key (aref macro-name 0) |
563 |
(eval macro-alist-var)) |
(eval macro-alist-var)) |
564 |
(define-key |
(define-key |
565 |
keymap |
keymap |
567 |
nil)) |
nil)) |
568 |
)) |
)) |
569 |
)) |
)) |
570 |
|
|
571 |
;; Check if MACRO-ALIST has an entry for a macro name starting with |
;; Check if MACRO-ALIST has an entry for a macro name starting with |
572 |
;; CHAR. If not, this indicates that the binding for this char |
;; CHAR. If not, this indicates that the binding for this char |
573 |
;; in viper-vi/insert-kbd-map can be released. |
;; in viper-vi/insert-kbd-map can be released. |
575 |
(let ((lis macro-alist) |
(let ((lis macro-alist) |
576 |
(can-release t) |
(can-release t) |
577 |
macro-name) |
macro-name) |
578 |
|
|
579 |
(while (and lis can-release) |
(while (and lis can-release) |
580 |
(setq macro-name (car (car lis))) |
(setq macro-name (car (car lis))) |
581 |
(if (eq char (aref macro-name 0)) |
(if (eq char (aref macro-name 0)) |
602 |
next-best-match keyseq event-seq |
next-best-match keyseq event-seq |
603 |
macro-first-char macro-alist-elt macro-body |
macro-first-char macro-alist-elt macro-body |
604 |
command) |
command) |
605 |
|
|
606 |
(setq macro-first-char last-command-event |
(setq macro-first-char last-command-event |
607 |
event-seq (viper-read-fast-keysequence macro-first-char macro-alist) |
event-seq (viper-read-fast-keysequence macro-first-char macro-alist) |
608 |
keyseq (viper-events-to-macro event-seq) |
keyseq (viper-events-to-macro event-seq) |
609 |
macro-alist-elt (assoc keyseq macro-alist) |
macro-alist-elt (assoc keyseq macro-alist) |
610 |
next-best-match (viper-find-best-matching-macro macro-alist keyseq)) |
next-best-match (viper-find-best-matching-macro macro-alist keyseq)) |
611 |
|
|
612 |
(if (null macro-alist-elt) |
(if (null macro-alist-elt) |
613 |
(setq macro-alist-elt (car next-best-match) |
(setq macro-alist-elt (car next-best-match) |
614 |
unmatched-suffix (subseq event-seq (cdr next-best-match)))) |
unmatched-suffix (subseq event-seq (cdr next-best-match)))) |
617 |
((setq macro-body (viper-kbd-buf-definition macro-alist-elt))) |
((setq macro-body (viper-kbd-buf-definition macro-alist-elt))) |
618 |
((setq macro-body (viper-kbd-mode-definition macro-alist-elt))) |
((setq macro-body (viper-kbd-mode-definition macro-alist-elt))) |
619 |
((setq macro-body (viper-kbd-global-definition macro-alist-elt)))) |
((setq macro-body (viper-kbd-global-definition macro-alist-elt)))) |
620 |
|
|
621 |
;; when defining keyboard macro, don't use the macro mappings |
;; when defining keyboard macro, don't use the macro mappings |
622 |
(if (and macro-body (not defining-kbd-macro)) |
(if (and macro-body (not defining-kbd-macro)) |
623 |
;; block cmd executed as part of a macro from entering command history |
;; block cmd executed as part of a macro from entering command history |
634 |
;; some other command (setting prefix arg can happen if we do, say, |
;; some other command (setting prefix arg can happen if we do, say, |
635 |
;; 2dw and there is a macro starting with 2. Then control will go to |
;; 2dw and there is a macro starting with 2. Then control will go to |
636 |
;; this routine |
;; this routine |
637 |
(or prefix-arg (setq prefix-arg count)) |
(or prefix-arg (setq prefix-arg count)) |
638 |
(setq command (key-binding (read-key-sequence nil))) |
(setq command (key-binding (read-key-sequence nil))) |
639 |
(if (commandp command) |
(if (commandp command) |
640 |
(command-execute command) |
(command-execute command) |
644 |
|
|
645 |
|
|
646 |
;;; Displaying and completing macros |
;;; Displaying and completing macros |
647 |
|
|
648 |
(defun viper-describe-kbd-macros () |
(defun viper-describe-kbd-macros () |
649 |
"Show currently defined keyboard macros." |
"Show currently defined keyboard macros." |
650 |
(interactive) |
(interactive) |
656 |
(princ "\n\nMacros in Emacs state:\n======================\n") |
(princ "\n\nMacros in Emacs state:\n======================\n") |
657 |
(mapcar 'viper-describe-one-macro viper-emacs-kbd-macro-alist) |
(mapcar 'viper-describe-one-macro viper-emacs-kbd-macro-alist) |
658 |
)) |
)) |
659 |
|
|
660 |
(defun viper-describe-one-macro (macro) |
(defun viper-describe-one-macro (macro) |
661 |
(princ (format "\n *** Mappings for %S:\n ------------\n" |
(princ (format "\n *** Mappings for %S:\n ------------\n" |
662 |
(viper-display-macro (car macro)))) |
(viper-display-macro (car macro)))) |
673 |
(princ (format "\n %S" (cdr (viper-kbd-global-pair macro)))) |
(princ (format "\n %S" (cdr (viper-kbd-global-pair macro)))) |
674 |
(princ " none")) |
(princ " none")) |
675 |
(princ "\n")) |
(princ "\n")) |
676 |
|
|
677 |
(defun viper-describe-one-macro-elt (elt) |
(defun viper-describe-one-macro-elt (elt) |
678 |
(let ((name (car elt)) |
(let ((name (car elt)) |
679 |
(defn (cdr elt))) |
(defn (cdr elt))) |
680 |
(princ (format "\n * %S:\n %S\n" name defn)))) |
(princ (format "\n * %S:\n %S\n" name defn)))) |
681 |
|
|
682 |
|
|
683 |
|
|
684 |
;; check if SEQ is a prefix of some car of an element in ALIST |
;; check if SEQ is a prefix of some car of an element in ALIST |
685 |
(defun viper-keyseq-is-a-possible-macro (seq alist) |
(defun viper-keyseq-is-a-possible-macro (seq alist) |
686 |
(let ((converted-seq (viper-events-to-macro seq))) |
(let ((converted-seq (viper-events-to-macro seq))) |
687 |
(eval (cons 'or |
(eval (cons 'or |
688 |
(mapcar |
(mapcar |
689 |
(lambda (elt) (viper-prefix-subseq-p converted-seq elt)) |
(lambda (elt) (viper-prefix-subseq-p converted-seq elt)) |
690 |
(viper-this-buffer-macros alist)))))) |
(viper-this-buffer-macros alist)))))) |
691 |
|
|
692 |
;; whether SEQ1 is a prefix of SEQ2 |
;; whether SEQ1 is a prefix of SEQ2 |
693 |
(defun viper-prefix-subseq-p (seq1 seq2) |
(defun viper-prefix-subseq-p (seq1 seq2) |
694 |
(let ((len1 (length seq1)) |
(let ((len1 (length seq1)) |
695 |
(len2 (length seq2))) |
(len2 (length seq2))) |
696 |
(if (<= len1 len2) |
(if (<= len1 len2) |
697 |
(equal seq1 (subseq seq2 0 len1))))) |
(equal seq1 (subseq seq2 0 len1))))) |
698 |
|
|
699 |
;; find the longest common prefix |
;; find the longest common prefix |
700 |
(defun viper-common-seq-prefix (&rest seqs) |
(defun viper-common-seq-prefix (&rest seqs) |
701 |
(let* ((first (car seqs)) |
(let* ((first (car seqs)) |
707 |
(setq len 0) |
(setq len 0) |
708 |
(setq len (apply 'min (mapcar 'length seqs)))) |
(setq len (apply 'min (mapcar 'length seqs)))) |
709 |
(while (< idx len) |
(while (< idx len) |
710 |
(if (eval (cons 'and |
(if (eval (cons 'and |
711 |
(mapcar (lambda (s) (equal (elt first idx) (elt s idx))) |
(mapcar (lambda (s) (equal (elt first idx) (elt s idx))) |
712 |
rest))) |
rest))) |
713 |
(setq pref (vconcat pref (vector (elt first idx))))) |
(setq pref (vconcat pref (vector (elt first idx))))) |
714 |
(setq idx (1+ idx))) |
(setq idx (1+ idx))) |
715 |
pref)) |
pref)) |
716 |
|
|
717 |
;; get all sequences that match PREFIX from a given A-LIST |
;; get all sequences that match PREFIX from a given A-LIST |
718 |
(defun viper-extract-matching-alist-members (pref alist) |
(defun viper-extract-matching-alist-members (pref alist) |
719 |
(delq nil (mapcar (lambda (elt) (if (viper-prefix-subseq-p pref elt) elt)) |
(delq nil (mapcar (lambda (elt) (if (viper-prefix-subseq-p pref elt) elt)) |
720 |
(viper-this-buffer-macros alist)))) |
(viper-this-buffer-macros alist)))) |
721 |
|
|
722 |
(defun viper-do-sequence-completion (seq alist compl-message) |
(defun viper-do-sequence-completion (seq alist compl-message) |
723 |
(let* ((matches (viper-extract-matching-alist-members seq alist)) |
(let* ((matches (viper-extract-matching-alist-members seq alist)) |
724 |
(new-seq (apply 'viper-common-seq-prefix matches)) |
(new-seq (apply 'viper-common-seq-prefix matches)) |
726 |
(cond ((and (equal seq new-seq) (= (length matches) 1)) |
(cond ((and (equal seq new-seq) (= (length matches) 1)) |
727 |
(message "%s (Sole completion)" compl-message) |
(message "%s (Sole completion)" compl-message) |
728 |
(sit-for 2)) |
(sit-for 2)) |
729 |
((null matches) |
((null matches) |
730 |
(message "%s (No match)" compl-message) |
(message "%s (No match)" compl-message) |
731 |
(sit-for 2) |
(sit-for 2) |
732 |
(setq new-seq seq)) |
(setq new-seq seq)) |
733 |
((member seq matches) |
((member seq matches) |
734 |
(message "%s (Complete, but not unique)" compl-message) |
(message "%s (Complete, but not unique)" compl-message) |
735 |
(sit-for 2) |
(sit-for 2) |
736 |
(viper-display-vector-completions matches)) |
(viper-display-vector-completions matches)) |
737 |
((equal seq new-seq) |
((equal seq new-seq) |
738 |
(viper-display-vector-completions matches))) |
(viper-display-vector-completions matches))) |
739 |
new-seq)) |
new-seq)) |
740 |
|
|
741 |
|
|
742 |
(defun viper-display-vector-completions (list) |
(defun viper-display-vector-completions (list) |
743 |
(with-output-to-temp-buffer "*Completions*" |
(with-output-to-temp-buffer "*Completions*" |
744 |
(display-completion-list |
(display-completion-list |
745 |
(mapcar 'prin1-to-string |
(mapcar 'prin1-to-string |
746 |
(mapcar 'viper-display-macro list))))) |
(mapcar 'viper-display-macro list))))) |
747 |
|
|
748 |
|
|
749 |
|
|
750 |
;; alist is the alist of macros |
;; alist is the alist of macros |
751 |
;; str is the fast key sequence entered |
;; str is the fast key sequence entered |
752 |
;; returns: (matching-macro-def . unmatched-suffix-start-index) |
;; returns: (matching-macro-def . unmatched-suffix-start-index) |
766 |
(setq found t)) |
(setq found t)) |
767 |
) |
) |
768 |
(setq lis (cdr lis))) |
(setq lis (cdr lis))) |
769 |
|
|
770 |
(if found |
(if found |
771 |
(setq match macro-def |
(setq match macro-def |
772 |
unmatched-start-idx def-len) |
unmatched-start-idx def-len) |
773 |
(setq match nil |
(setq match nil |
774 |
unmatched-start-idx 0)) |
unmatched-start-idx 0)) |
775 |
|
|
776 |
(cons match unmatched-start-idx))) |
(cons match unmatched-start-idx))) |
777 |
|
|
778 |
|
|
779 |
|
|
780 |
;; returns a list of names of macros defined for the current buffer |
;; returns a list of names of macros defined for the current buffer |
781 |
(defun viper-this-buffer-macros (macro-alist) |
(defun viper-this-buffer-macros (macro-alist) |
782 |
(let (candidates) |
(let (candidates) |
788 |
(car elt))) |
(car elt))) |
789 |
macro-alist)) |
macro-alist)) |
790 |
(setq candidates (delq nil candidates)))) |
(setq candidates (delq nil candidates)))) |
791 |
|
|
792 |
|
|
793 |
;; if seq of Viper key symbols (representing a macro) can be converted to a |
;; if seq of Viper key symbols (representing a macro) can be converted to a |
794 |
;; string--do so. Otherwise, do nothing. |
;; string--do so. Otherwise, do nothing. |
795 |
(defun viper-display-macro (macro-name-or-body) |
(defun viper-display-macro (macro-name-or-body) |
798 |
((viper-char-array-p macro-name-or-body) |
((viper-char-array-p macro-name-or-body) |
799 |
(mapconcat 'char-to-string macro-name-or-body "")) |
(mapconcat 'char-to-string macro-name-or-body "")) |
800 |
(t macro-name-or-body))) |
(t macro-name-or-body))) |
801 |
|
|
802 |
;; convert sequence of events (that came presumably from emacs kbd macro) into |
;; convert sequence of events (that came presumably from emacs kbd macro) into |
803 |
;; Viper's macro, which is a vector of the form |
;; Viper's macro, which is a vector of the form |
804 |
;; [ desc desc ... ] |
;; [ desc desc ... ] |
813 |
nil |
nil |
814 |
(viper-event-key elt))) |
(viper-event-key elt))) |
815 |
event-seq)))) |
event-seq)))) |
816 |
|
|
817 |
;; convert strings or arrays of characters to Viper macro form |
;; convert strings or arrays of characters to Viper macro form |
818 |
(defun viper-char-array-to-macro (array) |
(defun viper-char-array-to-macro (array) |
819 |
(let ((vec (vconcat array)) |
(let ((vec (vconcat array)) |
822 |
(setq macro (mapcar 'character-to-event vec)) |
(setq macro (mapcar 'character-to-event vec)) |
823 |
(setq macro vec)) |
(setq macro vec)) |
824 |
(vconcat (mapcar 'viper-event-key macro)))) |
(vconcat (mapcar 'viper-event-key macro)))) |
825 |
|
|
826 |
;; For macros bodies and names, goes over MACRO and checks if all members are |
;; For macros bodies and names, goes over MACRO and checks if all members are |
827 |
;; names of keys (actually, it only checks if they are symbols or lists |
;; names of keys (actually, it only checks if they are symbols or lists |
828 |
;; if a digit is found, it is converted into a symbol (e.g., 0 -> \0, etc). |
;; if a digit is found, it is converted into a symbol (e.g., 0 -> \0, etc). |
850 |
((symbolp elt) nil) |
((symbolp elt) nil) |
851 |
(t (setq break t))) |
(t (setq break t))) |
852 |
(setq idx (1+ idx)))) |
(setq idx (1+ idx)))) |
853 |
|
|
854 |
(if break |
(if break |
855 |
(error "Wrong type macro component, symbol-or-listp, %S" elt) |
(error "Wrong type macro component, symbol-or-listp, %S" elt) |
856 |
macro))) |
macro))) |
857 |
|
|
858 |
(defun viper-macro-to-events (macro-body) |
(defun viper-macro-to-events (macro-body) |
859 |
(vconcat (mapcar 'viper-key-to-emacs-key macro-body))) |
(vconcat (mapcar 'viper-key-to-emacs-key macro-body))) |
860 |
|
|
861 |
|
|
862 |
|
|
863 |
;;; Reading fast key sequences |
;;; Reading fast key sequences |
864 |
|
|
865 |
;; Assuming that CHAR was the first character in a fast succession of key |
;; Assuming that CHAR was the first character in a fast succession of key |
866 |
;; strokes, read the rest. Return the vector of keys that was entered in |
;; strokes, read the rest. Return the vector of keys that was entered in |
867 |
;; this fast succession of key strokes. |
;; this fast succession of key strokes. |
902 |
(viper-set-register-macro reg)) |
(viper-set-register-macro reg)) |
903 |
(execute-kbd-macro (get-register reg) count))) |
(execute-kbd-macro (get-register reg) count))) |
904 |
((or (= ?@ reg) (= ?\^j reg) (= ?\^m reg)) |
((or (= ?@ reg) (= ?\^j reg) (= ?\^m reg)) |
905 |
(if viper-last-macro-reg |
(if viper-last-macro-reg |
906 |
nil |
nil |
907 |
(error "No previous kbd macro")) |
(error "No previous kbd macro")) |
908 |
(execute-kbd-macro (get-register viper-last-macro-reg) count)) |
(execute-kbd-macro (get-register viper-last-macro-reg) count)) |
916 |
(viper-set-register-macro reg)))) |
(viper-set-register-macro reg)))) |
917 |
(t |
(t |
918 |
(error "`%c': Unknown register" reg))))) |
(error "`%c': Unknown register" reg))))) |
919 |
|
|
920 |
|
|
921 |
(defun viper-global-execute () |
(defun viper-global-execute () |
922 |
"Call last keyboad macro for each line in the region." |
"Call last keyboad macro for each line in the region." |