/[emacs]/emacs/lisp/emulation/viper-macs.el
ViewVC logotype

Diff of /emacs/lisp/emulation/viper-macs.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.26 by kifer, Tue Jan 8 04:36:00 2002 UTC revision 1.26.4.1 by miles, Fri Apr 4 06:20:19 2003 UTC
# Line 58  Line 58 
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)
# Line 121  a key is a symbol, e.g., `a', `\\1', `f2 Line 121  a key is a symbol, e.g., `a', `\\1', `f2
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 ()
# Line 141  a key is a symbol, e.g., `a', `\\1', `f2 Line 141  a key is a symbol, e.g., `a', `\\1', `f2
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)
# Line 149  a key is a symbol, e.g., `a', `\\1', `f2 Line 149  a key is a symbol, e.g., `a', `\\1', `f2
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 ")
# Line 158  a key is a symbol, e.g., `a', `\\1', `f2 Line 158  a key is a symbol, e.g., `a', `\\1', `f2
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)
# Line 198  a key is a symbol, e.g., `a', `\\1', `f2 Line 198  a key is a symbol, e.g., `a', `\\1', `f2
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)))
# Line 212  a key is a symbol, e.g., `a', `\\1', `f2 Line 212  a key is a symbol, e.g., `a', `\\1', `f2
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
# Line 230  a key is a symbol, e.g., `a', `\\1', `f2 Line 230  a key is a symbol, e.g., `a', `\\1', `f2
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)
# Line 245  a key is a symbol, e.g., `a', `\\1', `f2 Line 245  a key is a symbol, e.g., `a', `\\1', `f2
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)
# Line 255  a key is a symbol, e.g., `a', `\\1', `f2 Line 255  a key is a symbol, e.g., `a', `\\1', `f2
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)
# Line 278  a key is a symbol, e.g., `a', `\\1', `f2 Line 278  a key is a symbol, e.g., `a', `\\1', `f2
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
# Line 311  a key is a symbol, e.g., `a', `\\1', `f2 Line 311  a key is a symbol, e.g., `a', `\\1', `f2
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)))
# Line 337  define the macro.  MACRO-BODY is a strin Line 337  define the macro.  MACRO-BODY is a strin
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"
# Line 354  If SCOPE is nil, the user is asked to sp Line 354  If SCOPE is nil, the user is asked to sp
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)
# Line 423  If SCOPE is nil, the user is asked to sp Line 423  If SCOPE is nil, the user is asked to sp
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
# Line 436  If SCOPE is nil, the user is asked to sp Line 436  If SCOPE is nil, the user is asked to sp
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)))
# Line 463  If SCOPE is nil, the user is asked to sp Line 463  If SCOPE is nil, the user is asked to sp
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)))
# Line 471  If SCOPE is nil, the user is asked to sp Line 471  If SCOPE is nil, the user is asked to sp
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)
# Line 480  If SCOPE is nil, the user is asked to sp Line 480  If SCOPE is nil, the user is asked to sp
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.
# Line 491  internally, but the user can also use it Line 491  internally, but the user can also use it
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"
# Line 508  name from there." Line 508  name from there."
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))
# Line 522  name from there." Line 522  name from there."
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
# Line 534  name from there." Line 534  name from there."
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)
# Line 559  name from there." Line 559  name from there."
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
# Line 567  name from there." Line 567  name from there."
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.
# Line 575  name from there." Line 575  name from there."
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))
# Line 602  name from there." Line 602  name from there."
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))))
# Line 617  name from there." Line 617  name from there."
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
# Line 634  name from there." Line 634  name from there."
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)
# Line 644  name from there." Line 644  name from there."
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)
# Line 656  name from there." Line 656  name from there."
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))))
# Line 673  name from there." Line 673  name from there."
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))
# Line 707  name from there." Line 707  name from there."
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))
# Line 726  name from there." Line 726  name from there."
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)
# Line 766  name from there." Line 766  name from there."
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)
# Line 788  name from there." Line 788  name from there."
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)
# Line 798  name from there." Line 798  name from there."
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 ... ]
# Line 813  name from there." Line 813  name from there."
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))
# Line 822  name from there." Line 822  name from there."
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).
# Line 850  name from there." Line 850  name from there."
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.
# Line 902  name from there." Line 902  name from there."
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))
# Line 916  name from there." Line 916  name from there."
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."

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.26.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26