lisp/emulation/viper-macs.el

   1 ;;; viper-macs.el --- functions implementing keyboard macros for Viper
   2
   3 ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Kifer <kifer@cs.sunysb.edu>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2, or (at your option)
  12 ;; any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 ;; Boston, MA 02111-1307, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; Code:
  27
  28 (provide 'viper-macs)
  29
  30 ;; compiler pacifier
  31 (defvar viper-ex-work-buf)
  32 (defvar viper-custom-file-name)
  33 (defvar viper-current-state)
  34 (defvar viper-fast-keyseq-timeout)
  35
  36 ;; loading happens only in non-interactive compilation
  37 ;; in order to spare non-viperized emacs from being viperized
  38 (if noninteractive
  39     (eval-when-compile
  40       (let ((load-path (cons (expand-file-name ".") load-path)))
  41         (or (featurep 'viper-util)
  42             (load "viper-util.el" nil nil 'nosuffix))
  43         (or (featurep 'viper-keym)
  44             (load "viper-keym.el" nil nil 'nosuffix))
  45         (or (featurep 'viper-mous)
  46             (load "viper-mous.el" nil nil 'nosuffix))
  47         (or (featurep 'viper-cmd)
  48             (load "viper-cmd.el" nil nil 'nosuffix))
  49         )))
  50 ;; end pacifier
  51
  52 (require 'viper-util)
  53 (require 'viper-keym)
  54
  55
  56 ;;; Variables
  57
  58 ;; Register holding last macro.
  59 (defvar viper-last-macro-reg nil)
  60
  61 ;; format of the elements of kbd alists:
  62 ;; (name ((buf . macr)...(buf . macr)) ((maj-mode . macr)...) (t . macr))
  63 ;; kbd macro alist for Vi state
  64 (defvar viper-vi-kbd-macro-alist nil)
  65 ;; same for insert/replace state
  66 (defvar viper-insert-kbd-macro-alist nil)
  67 ;; same for emacs state
  68 (defvar viper-emacs-kbd-macro-alist nil)
  69
  70 ;; Internal var that passes info between start-kbd-macro and end-kbd-macro
  71 ;; in :map and :map!
  72 (defvar viper-kbd-macro-parameters nil)
  73
  74 (defvar viper-this-kbd-macro nil
  75   "Vector of keys representing the name of currently running Viper kbd macro.")
  76 (defvar viper-last-kbd-macro nil
  77   "Vector of keys representing the name of last Viper keyboard macro.")
  78
  79 (defcustom viper-repeat-from-history-key 'f12
  80   "Prefix key for accessing previously typed Vi commands.
  81
  82 The previous command is accessible, as usual, via `.'.  The command before this
  83 can be invoked as `<this key> 1', and the command before that, and the command
  84 before that one is accessible as `<this key> 2'.
  85 The notation for these keys is borrowed from XEmacs.  Basically,
  86 a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g.,
  87 `(meta control f1)'."
  88   :type 'sexp
  89   :group 'viper)
  90
  91
  92 \f
  93 ;;; Code
  94
  95 ;; Ex map command
  96 (defun ex-map ()
  97   (let ((mod-char "")
  98         macro-name macro-body map-args ins)
  99     (save-window-excursion
 100       (set-buffer viper-ex-work-buf)
 101       (if (looking-at "!")
 102           (progn
 103             (setq ins t
 104                   mod-char "!")
 105             (forward-char 1))))
 106     (setq map-args (ex-map-read-args mod-char)
 107           macro-name (car map-args)
 108           macro-body (cdr map-args))
 109     (setq viper-kbd-macro-parameters (list ins mod-char macro-name macro-body))
 110     (if macro-body
 111         (viper-end-mapping-kbd-macro 'ignore)
 112       (ex-fixup-history (format "map%s %S" mod-char
 113                                 (viper-display-macro macro-name)))
 114       ;; if defining macro for insert, switch there for authentic WYSIWYG
 115       (if ins (viper-change-state-to-insert))
 116       (start-kbd-macro nil)
 117       (define-key viper-vi-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro)
 118       (define-key viper-insert-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro)
 119       (define-key viper-emacs-intercept-map "\C-x)" 'viper-end-mapping-kbd-macro)
 120       (message "Mapping %S in %s state.  Hit `C-x )' to complete the mapping"
 121                (viper-display-macro macro-name)
 122                (if ins "Insert" "Vi")))
 123     ))
 124
 125
 126 ;; Ex unmap
 127 (defun ex-unmap ()
 128   (let ((mod-char "")
 129         temp macro-name ins)
 130     (save-window-excursion
 131       (set-buffer viper-ex-work-buf)
 132       (if (looking-at "!")
 133           (progn
 134             (setq ins t
 135                   mod-char "!")
 136             (forward-char 1))))
 137
 138     (setq macro-name (ex-unmap-read-args mod-char))
 139     (setq temp (viper-fixup-macro (vconcat macro-name))) ;; copy and fixup
 140     (ex-fixup-history (format "unmap%s %S" mod-char
 141                               (viper-display-macro temp)))
 142     (viper-unrecord-kbd-macro macro-name (if ins 'insert-state 'vi-state))
 143     ))
 144
 145
 146 ;; read arguments for ex-map
 147 (defun ex-map-read-args (variant)
 148   (let ((cursor-in-echo-area t)
 149         (key-seq [])
 150         temp key event message
 151         macro-name macro-body args)
 152
 153     (condition-case nil
 154         (setq args (concat (ex-get-inline-cmd-args ".*map[!]*[ \t]?" "\n\C-m")
 155                            " nil nil ")
 156               temp (read-from-string args)
 157               macro-name (car temp)
 158               macro-body (car (read-from-string args (cdr temp))))
 159       (error
 160        (signal
 161         'error
 162         '("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.
 165     ;; 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
 167     (if macro-name
 168         (cond ((vectorp macro-name) nil)
 169               ((stringp macro-name)
 170                (setq macro-name (vconcat macro-name)))
 171               (t (setq macro-name (vconcat (prin1-to-string macro-name)))))
 172       (message ":map%s <Name>" variant)(sit-for 2)
 173       (while
 174           (not (member key
 175                        '(?\C-m ?\n (control m) (control j) return linefeed)))
 176         (setq key-seq (vconcat key-seq (if key (vector key) [])))
 177         ;; the only keys available for editing are these-- no help while there
 178         (if (member
 179              key
 180              '(?\b ?\d '^? '^H (control h) (control \?) backspace delete))
 181             (setq key-seq (subseq key-seq 0 (- (length key-seq) 2))))
 182         (setq message
 183               (format
 184                ":map%s %s"
 185                variant (if (> (length key-seq) 0)
 186                            (prin1-to-string (viper-display-macro key-seq))
 187                          "")))
 188         (message message)
 189         (setq event (viper-read-key))
 190         ;;(setq event (viper-read-event))
 191         (setq key
 192               (if (viper-mouse-event-p event)
 193                   (progn
 194                     (message "%s (No mouse---only keyboard keys, please)"
 195                              message)
 196                     (sit-for 2)
 197                     nil)
 198                 (viper-event-key event)))
 199         )
 200       (setq macro-name key-seq))
 201
 202     (if (= (length macro-name) 0)
 203         (error "Can't map an empty macro name"))
 204     (setq macro-name (viper-fixup-macro macro-name))
 205     (if (viper-char-array-p macro-name)
 206         (setq macro-name (viper-char-array-to-macro macro-name)))
 207
 208     (if macro-body
 209         (cond ((viper-char-array-p macro-body)
 210                (setq macro-body (viper-char-array-to-macro macro-body)))
 211               ((vectorp macro-body) nil)
 212               (t (error "map: Invalid syntax in macro definition"))))
 213     (setq cursor-in-echo-area nil)(sit-for 0) ; this overcomes xemacs tty bug
 214     (cons macro-name macro-body)))
 215
 216
 217
 218 ;; read arguments for ex-unmap
 219 (defun ex-unmap-read-args (variant)
 220   (let ((cursor-in-echo-area t)
 221         (macro-alist (if (string= variant "!")
 222                          viper-insert-kbd-macro-alist
 223                        viper-vi-kbd-macro-alist))
 224         ;; these are disabled just in case, to avoid surprises when doing
 225         ;; completing-read
 226         viper-vi-kbd-minor-mode viper-insert-kbd-minor-mode
 227         viper-emacs-kbd-minor-mode
 228         viper-vi-intercept-minor-mode viper-insert-intercept-minor-mode
 229         viper-emacs-intercept-minor-mode
 230         event message
 231         key key-seq macro-name)
 232     (setq macro-name (ex-get-inline-cmd-args ".*unma?p?[!]*[ \t]*"))
 233
 234     (if (> (length macro-name) 0)
 235         ()
 236       (message ":unmap%s <Name>" variant) (sit-for 2)
 237       (while
 238           (not
 239            (member key '(?\C-m ?\n (control m) (control j) return linefeed)))
 240         (setq key-seq (vconcat key-seq (if key (vector key) [])))
 241         ;; the only keys available for editing are these-- no help while there
 242         (cond ((member
 243                 key
 244                 '(?\b ?\d '^? '^H (control h) (control \?) backspace delete))
 245                (setq key-seq (subseq key-seq 0 (- (length key-seq) 2))))
 246               ((member key '(tab (control i) ?\t))
 247                (setq key-seq (subseq key-seq 0 (1- (length key-seq))))
 248                (setq message
 249                      (format
 250                       ":unmap%s %s"
 251                       variant (if (> (length key-seq) 0)
 252                                   (prin1-to-string
 253                                    (viper-display-macro key-seq))
 254                                 "")))
 255                (setq key-seq
 256                      (viper-do-sequence-completion key-seq macro-alist message))
 257                ))
 258         (setq message
 259               (format
 260                ":unmap%s %s"
 261                variant (if (> (length key-seq) 0)
 262                            (prin1-to-string
 263                             (viper-display-macro key-seq))
 264                          "")))
 265         (message message)
 266         (setq event (viper-read-key))
 267         ;;(setq event (viper-read-event))
 268         (setq key
 269               (if (viper-mouse-event-p event)
 270                   (progn
 271                     (message "%s (No mouse---only keyboard keys, please)"
 272                              message)
 273                     (sit-for 2)
 274                     nil)
 275                 (viper-event-key event)))
 276         )
 277       (setq macro-name key-seq))
 278
 279     (if (= (length macro-name) 0)
 280         (error "Can't unmap an empty macro name"))
 281
 282     ;; convert macro names into vector, if starts with a `['
 283     (if (memq (elt macro-name 0) '(?\[ ?\"))
 284         (car (read-from-string macro-name))
 285       (vconcat macro-name))
 286     ))
 287
 288
 289 ;; Terminate a Vi kbd macro.
 290 ;; 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
 292 ;; terminate a kbd macro.
 293 (defun viper-end-mapping-kbd-macro (&optional ignore)
 294   (interactive)
 295   (define-key viper-vi-intercept-map "\C-x)" nil)
 296   (define-key viper-insert-intercept-map "\C-x)" nil)
 297   (define-key viper-emacs-intercept-map "\C-x)" nil)
 298   (if (and (not ignore)
 299            (or (not viper-kbd-macro-parameters)
 300                (not defining-kbd-macro)))
 301       (error "Not mapping a kbd-macro"))
 302   (let ((mod-char (nth 1 viper-kbd-macro-parameters))
 303         (ins (nth 0 viper-kbd-macro-parameters))
 304         (macro-name (nth 2 viper-kbd-macro-parameters))
 305         (macro-body (nth 3 viper-kbd-macro-parameters)))
 306     (setq viper-kbd-macro-parameters nil)
 307     (or ignore
 308         (progn
 309           (end-kbd-macro nil)
 310           (setq macro-body (viper-events-to-macro last-kbd-macro))
 311           ;; always go back to Vi, since this is where we started
 312           ;; defining macro
 313           (viper-change-state-to-vi)))
 314
 315     (viper-record-kbd-macro macro-name
 316                           (if ins 'insert-state 'vi-state)
 317                           (viper-display-macro macro-body))
 318
 319     (ex-fixup-history (format "map%s %S %S" mod-char
 320                               (viper-display-macro macro-name)
 321                               (viper-display-macro macro-body)))
 322     ))
 323
 324
 325
 326 \f
 327 ;;; Recording, unrecording, executing
 328
 329 ;; Accepts as macro names: strings and vectors.
 330 ;; strings must be strings of characters; vectors must be vectors of keys
 331 ;; in canonic form.  The canonic form is essentially the form used in XEmacs
 332 (defun viper-record-kbd-macro (macro-name state macro-body &optional scope)
 333   "Record a Vi macro.  Can be used in `.viper' file to define permanent macros.
 334 MACRO-NAME is a string of characters or a vector of keys.  STATE is
 335 either `vi-state' or `insert-state'.  It specifies the Viper state in which to
 336 define the macro.  MACRO-BODY is a string that represents the keyboard macro.
 337 Optional SCOPE says whether the macro should be global \(t\), mode-specific
 338 \(a major-mode symbol\), or buffer-specific \(buffer name, a string\).
 339 If SCOPE is nil, the user is asked to specify the scope."
 340   (let* (state-name keymap
 341          (macro-alist-var
 342           (cond ((eq state 'vi-state)
 343                  (setq state-name "Vi state"
 344                        keymap viper-vi-kbd-map)
 345                  'viper-vi-kbd-macro-alist)
 346                 ((memq state '(insert-state replace-state))
 347                  (setq state-name "Insert state"
 348                        keymap viper-insert-kbd-map)
 349                  'viper-insert-kbd-macro-alist)
 350                 (t
 351                  (setq state-name "Emacs state"
 352                        keymap viper-emacs-kbd-map)
 353                  'viper-emacs-kbd-macro-alist)
 354                  ))
 355          new-elt old-elt old-sub-elt msg
 356          temp lis lis2)
 357
 358     (if (= (length macro-name) 0)
 359         (error "Can't map an empty macro name"))
 360
 361     ;; Macro-name is usually a vector.  However, command history or macros
 362     ;; recorded in ~/.viper may be recorded as strings.  So, convert to
 363     ;; vectors.
 364     (setq macro-name (viper-fixup-macro macro-name))
 365     (if (viper-char-array-p macro-name)
 366         (setq macro-name (viper-char-array-to-macro macro-name)))
 367     (setq macro-body (viper-fixup-macro macro-body))
 368     (if (viper-char-array-p macro-body)
 369         (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
 372     (or (eq scope t)
 373         (stringp scope)
 374         (and scope (symbolp scope))
 375         (progn
 376           (setq scope
 377                 (cond
 378                  ((y-or-n-p
 379                    (format
 380                     "Map this macro for buffer `%s' only? "
 381                     (buffer-name)))
 382                   (setq msg
 383                         (format
 384                          "%S is mapped to %s for %s in `%s'"
 385                          (viper-display-macro macro-name)
 386                          (viper-abbreviate-string
 387                           (format
 388                            "%S"
 389                            (setq temp (viper-display-macro macro-body)))
 390                           14 "" ""
 391                           (if (stringp temp) "  ....\"" "  ....]"))
 392                          state-name (buffer-name)))
 393                   (buffer-name))
 394                  ((y-or-n-p
 395                    (format
 396                     "Map this macro for the major mode `%S' only? "
 397                     major-mode))
 398                   (setq msg
 399                         (format
 400                          "%S is mapped to %s for %s in `%S'"
 401                          (viper-display-macro macro-name)
 402                          (viper-abbreviate-string
 403                           (format
 404                            "%S"
 405                            (setq temp (viper-display-macro macro-body)))
 406                           14 "" ""
 407                           (if (stringp macro-body) "  ....\"" "  ....]"))
 408                          state-name major-mode))
 409                   major-mode)
 410                  (t
 411                   (setq msg
 412                         (format
 413                          "%S is globally mapped to %s in %s"
 414                          (viper-display-macro macro-name)
 415                          (viper-abbreviate-string
 416                           (format
 417                            "%S"
 418                            (setq temp (viper-display-macro macro-body)))
 419                           14 "" ""
 420                           (if (stringp macro-body) "  ....\"" "  ....]"))
 421                          state-name))
 422                   t)))
 423           (if (y-or-n-p
 424                (format "Save this macro in %s? "
 425                        (viper-abbreviate-file-name viper-custom-file-name)))
 426               (viper-save-string-in-file
 427                (format "\n(viper-record-kbd-macro %S '%S %s '%S)"
 428                        (viper-display-macro macro-name)
 429                        state
 430                        ;; if we don't let vector macro-body through %S,
 431                        ;; the symbols `\.' `\[' etc will be converted into
 432                        ;; characters, causing invalid read  error on recorded
 433                        ;; macros in .viper.
 434                        ;; I am not sure is macro-body can still be a string at
 435                        ;; this point, but I am preserving this option anyway.
 436                        (if (vectorp macro-body)
 437                            (format "%S" macro-body)
 438                          macro-body)
 439                        scope)
 440                viper-custom-file-name))
 441
 442           (message msg)
 443           ))
 444
 445     (setq new-elt
 446           (cons macro-name
 447                 (cond ((eq scope t) (list nil nil (cons t nil)))
 448                       ((symbolp scope)
 449                        (list nil (list (cons scope nil)) (cons t nil)))
 450                       ((stringp scope)
 451                        (list (list (cons scope nil)) nil (cons t nil))))))
 452     (setq old-elt (assoc macro-name (eval macro-alist-var)))
 453
 454       (if (null old-elt)
 455           (progn
 456             ;; insert new-elt in macro-alist-var and keep the list sorted
 457             (define-key
 458               keymap
 459               (vector (viper-key-to-emacs-key (aref macro-name 0)))
 460               'viper-exec-mapped-kbd-macro)
 461             (setq lis (eval macro-alist-var))
 462             (while (and lis (string< (viper-array-to-string (car (car lis)))
 463                                      (viper-array-to-string macro-name)))
 464               (setq lis2 (cons (car lis) lis2))
 465               (setq lis (cdr lis)))
 466
 467             (setq lis2 (reverse lis2))
 468             (set macro-alist-var (append lis2 (cons new-elt lis)))
 469             (setq old-elt new-elt)))
 470     (setq old-sub-elt
 471           (cond ((eq scope t) (viper-kbd-global-pair old-elt))
 472                 ((symbolp scope) (assoc scope (viper-kbd-mode-alist old-elt)))
 473                 ((stringp scope) (assoc scope (viper-kbd-buf-alist old-elt)))))
 474     (if old-sub-elt
 475         (setcdr old-sub-elt macro-body)
 476       (cond ((symbolp scope) (setcar (cdr (cdr old-elt))
 477                                      (cons (cons scope macro-body)
 478                                            (viper-kbd-mode-alist old-elt))))
 479             ((stringp scope) (setcar (cdr old-elt)
 480                                      (cons (cons scope macro-body)
 481                                            (viper-kbd-buf-alist old-elt))))))
 482     ))
 483
 484
 485
 486 ;; macro name must be a vector of viper-style keys
 487 (defun viper-unrecord-kbd-macro (macro-name state)
 488   "Delete macro MACRO-NAME from Viper STATE.
 489 MACRO-NAME must be a vector of viper-style keys.  This command is used by Viper
 490 internally, but the user can also use it in ~/.viper to delete pre-defined
 491 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
 493 name from there."
 494   (let* (state-name keymap
 495          (macro-alist-var
 496           (cond ((eq state 'vi-state)
 497                  (setq state-name "Vi state"
 498                        keymap viper-vi-kbd-map)
 499                  'viper-vi-kbd-macro-alist)
 500                 ((memq state '(insert-state replace-state))
 501                  (setq state-name "Insert state"
 502                        keymap viper-insert-kbd-map)
 503                  'viper-insert-kbd-macro-alist)
 504                 (t
 505                  (setq state-name "Emacs state"
 506                        keymap viper-emacs-kbd-map)
 507                  'viper-emacs-kbd-macro-alist)
 508                 ))
 509          buf-mapping mode-mapping global-mapping
 510          macro-pair macro-entry)
 511
 512     ;; Macro-name is usually a vector.  However, command history or macros
 513     ;; recorded in ~/.viper may appear as strings.  So, convert to vectors.
 514     (setq macro-name (viper-fixup-macro macro-name))
 515     (if (viper-char-array-p macro-name)
 516         (setq macro-name (viper-char-array-to-macro macro-name)))
 517
 518     (setq macro-entry (assoc macro-name (eval macro-alist-var)))
 519     (if (= (length macro-name) 0)
 520         (error "Can't unmap an empty macro name"))
 521     (if (null macro-entry)
 522         (error "%S is not mapped to a macro for %s in `%s'"
 523                (viper-display-macro macro-name)
 524                state-name (buffer-name)))
 525
 526     (setq buf-mapping (viper-kbd-buf-pair macro-entry)
 527           mode-mapping (viper-kbd-mode-pair macro-entry)
 528           global-mapping (viper-kbd-global-pair macro-entry))
 529
 530     (cond ((and (cdr buf-mapping)
 531                 (or (and (not (cdr mode-mapping)) (not (cdr global-mapping)))
 532                     (y-or-n-p
 533                      (format "Unmap %S for `%s' only? "
 534                              (viper-display-macro macro-name)
 535                              (buffer-name)))))
 536            (setq macro-pair buf-mapping)
 537            (message "%S is unmapped for %s in `%s'"
 538                     (viper-display-macro macro-name)
 539                     state-name (buffer-name)))
 540           ((and (cdr mode-mapping)
 541                 (or (not (cdr global-mapping))
 542                     (y-or-n-p
 543                      (format "Unmap %S for the major mode `%S' only? "
 544                              (viper-display-macro macro-name)
 545                              major-mode))))
 546            (setq macro-pair mode-mapping)
 547            (message "%S is unmapped for %s in %S"
 548                     (viper-display-macro macro-name) state-name major-mode))
 549           ((cdr (setq macro-pair (viper-kbd-global-pair macro-entry)))
 550            (message
 551             "Global mapping for %S in %s is removed"
 552             (viper-display-macro macro-name) state-name))
 553           (t (error "%S is not mapped to a macro for %s in `%s'"
 554                     (viper-display-macro macro-name)
 555                     state-name (buffer-name))))
 556     (setcdr macro-pair nil)
 557     (or (cdr buf-mapping)
 558         (cdr mode-mapping)
 559         (cdr global-mapping)
 560         (progn
 561           (set macro-alist-var (delq macro-entry (eval macro-alist-var)))
 562           (if (viper-can-release-key (aref macro-name 0)
 563                                    (eval macro-alist-var))
 564               (define-key
 565                 keymap
 566                 (vector (viper-key-to-emacs-key (aref macro-name 0)))
 567                 nil))
 568           ))
 569     ))
 570
 571 ;; 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
 573 ;; in viper-vi/insert-kbd-map can be released.
 574 (defun viper-can-release-key (char macro-alist)
 575   (let ((lis macro-alist)
 576         (can-release t)
 577         macro-name)
 578
 579     (while (and lis can-release)
 580       (setq macro-name (car (car lis)))
 581       (if (eq char (aref macro-name 0))
 582           (setq can-release nil))
 583       (setq lis (cdr lis)))
 584     can-release))
 585
 586
 587 (defun viper-exec-mapped-kbd-macro (count)
 588   "Dispatch kbd macro."
 589   (interactive "P")
 590   (let* ((macro-alist (cond ((eq viper-current-state 'vi-state)
 591                              viper-vi-kbd-macro-alist)
 592                             ((memq viper-current-state
 593                                    '(insert-state replace-state))
 594                              viper-insert-kbd-macro-alist)
 595                             (t
 596                              viper-emacs-kbd-macro-alist)))
 597         (unmatched-suffix "")
 598         ;; Macros and keys are executed with other macros turned off
 599         ;; For macros, this is done to avoid macro recursion
 600         viper-vi-kbd-minor-mode viper-insert-kbd-minor-mode
 601         viper-emacs-kbd-minor-mode
 602         next-best-match keyseq event-seq
 603         macro-first-char macro-alist-elt macro-body
 604         command)
 605
 606     (setq macro-first-char last-command-event
 607           event-seq (viper-read-fast-keysequence macro-first-char macro-alist)
 608           keyseq (viper-events-to-macro event-seq)
 609           macro-alist-elt (assoc keyseq macro-alist)
 610           next-best-match (viper-find-best-matching-macro macro-alist keyseq))
 611
 612     (if (null macro-alist-elt)
 613         (setq macro-alist-elt (car next-best-match)
 614               unmatched-suffix (subseq event-seq (cdr next-best-match))))
 615
 616     (cond ((null macro-alist-elt))
 617           ((setq macro-body (viper-kbd-buf-definition macro-alist-elt)))
 618           ((setq macro-body (viper-kbd-mode-definition macro-alist-elt)))
 619           ((setq macro-body (viper-kbd-global-definition macro-alist-elt))))
 620
 621     ;; when defining keyboard macro, don't use the macro mappings
 622     (if (and macro-body (not defining-kbd-macro))
 623         ;; block cmd executed as part of a macro from entering command history
 624         (let ((command-history command-history))
 625           (setq viper-this-kbd-macro (car macro-alist-elt))
 626           (execute-kbd-macro (viper-macro-to-events macro-body) count)
 627           (setq viper-this-kbd-macro nil
 628                 viper-last-kbd-macro (car macro-alist-elt))
 629           (viper-set-unread-command-events unmatched-suffix))
 630       ;; If not a macro, or the macro is suppressed while defining another
 631       ;; macro, put keyseq back on the event queue
 632       (viper-set-unread-command-events event-seq)
 633       ;; if the user typed arg, then use it if prefix arg is not set by
 634       ;; 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
 636       ;; this routine
 637       (or prefix-arg (setq  prefix-arg count))
 638       (setq command (key-binding (read-key-sequence nil)))
 639       (if (commandp command)
 640           (command-execute command)
 641         (beep 1)))
 642     ))
 643
 644
 645 \f
 646 ;;; Displaying and completing macros
 647
 648 (defun viper-describe-kbd-macros ()
 649   "Show currently defined keyboard macros."
 650   (interactive)
 651   (with-output-to-temp-buffer " *viper-info*"
 652     (princ "Macros in Vi state:\n===================\n")
 653     (mapcar 'viper-describe-one-macro viper-vi-kbd-macro-alist)
 654     (princ "\n\nMacros in Insert and Replace states:\n====================================\n")
 655     (mapcar 'viper-describe-one-macro viper-insert-kbd-macro-alist)
 656     (princ "\n\nMacros in Emacs state:\n======================\n")
 657     (mapcar 'viper-describe-one-macro viper-emacs-kbd-macro-alist)
 658     ))
 659
 660 (defun viper-describe-one-macro (macro)
 661   (princ (format "\n  *** Mappings for %S:\n      ------------\n"
 662                  (viper-display-macro (car macro))))
 663   (princ "   ** Buffer-specific:")
 664   (if (viper-kbd-buf-alist macro)
 665       (mapcar 'viper-describe-one-macro-elt (viper-kbd-buf-alist macro))
 666     (princ "  none\n"))
 667   (princ "\n   ** Mode-specific:")
 668   (if (viper-kbd-mode-alist macro)
 669       (mapcar 'viper-describe-one-macro-elt (viper-kbd-mode-alist macro))
 670     (princ "  none\n"))
 671   (princ "\n   ** Global:")
 672   (if (viper-kbd-global-definition macro)
 673       (princ (format "\n           %S" (cdr (viper-kbd-global-pair macro))))
 674     (princ "  none"))
 675   (princ "\n"))
 676
 677 (defun viper-describe-one-macro-elt (elt)
 678   (let ((name (car elt))
 679         (defn (cdr elt)))
 680     (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
 685 (defun viper-keyseq-is-a-possible-macro (seq alist)
 686   (let ((converted-seq (viper-events-to-macro seq)))
 687     (eval (cons 'or
 688                 (mapcar
 689                  (lambda (elt) (viper-prefix-subseq-p converted-seq elt))
 690                  (viper-this-buffer-macros alist))))))
 691
 692 ;; whether SEQ1 is a prefix of SEQ2
 693 (defun viper-prefix-subseq-p (seq1 seq2)
 694   (let ((len1 (length seq1))
 695         (len2 (length seq2)))
 696     (if (<= len1 len2)
 697         (equal seq1 (subseq seq2 0 len1)))))
 698
 699 ;; find the longest common prefix
 700 (defun viper-common-seq-prefix (&rest seqs)
 701   (let* ((first (car seqs))
 702          (rest (cdr seqs))
 703          (pref [])
 704          (idx 0)
 705          len)
 706     (if (= (length seqs) 0)
 707         (setq len 0)
 708       (setq len (apply 'min (mapcar 'length seqs))))
 709     (while (< idx len)
 710       (if (eval (cons 'and
 711                       (mapcar (lambda (s) (equal (elt first idx) (elt s idx)))
 712                               rest)))
 713           (setq pref (vconcat pref (vector (elt first idx)))))
 714       (setq idx (1+ idx)))
 715     pref))
 716
 717 ;; get all sequences that match PREFIX from a given A-LIST
 718 (defun viper-extract-matching-alist-members (pref alist)
 719   (delq nil (mapcar (lambda (elt) (if (viper-prefix-subseq-p pref elt) elt))
 720                     (viper-this-buffer-macros alist))))
 721
 722 (defun viper-do-sequence-completion (seq alist compl-message)
 723   (let* ((matches (viper-extract-matching-alist-members seq alist))
 724          (new-seq (apply 'viper-common-seq-prefix matches))
 725          )
 726     (cond ((and (equal seq new-seq) (= (length matches) 1))
 727            (message "%s (Sole completion)" compl-message)
 728            (sit-for 2))
 729           ((null matches)
 730            (message "%s (No match)" compl-message)
 731            (sit-for 2)
 732            (setq new-seq seq))
 733           ((member seq matches)
 734            (message "%s (Complete, but not unique)" compl-message)
 735            (sit-for 2)
 736            (viper-display-vector-completions matches))
 737           ((equal seq new-seq)
 738            (viper-display-vector-completions matches)))
 739     new-seq))
 740
 741
 742 (defun viper-display-vector-completions (list)
 743   (with-output-to-temp-buffer "*Completions*"
 744     (display-completion-list
 745      (mapcar 'prin1-to-string
 746              (mapcar 'viper-display-macro list)))))
 747
 748
 749
 750 ;; alist is the alist of macros
 751 ;; str is the fast key sequence entered
 752 ;; returns: (matching-macro-def . unmatched-suffix-start-index)
 753 (defun viper-find-best-matching-macro (alist str)
 754   (let ((lis alist)
 755         (def-len 0)
 756         (str-len (length str))
 757         match unmatched-start-idx found macro-def)
 758     (while (and (not found) lis)
 759       (setq macro-def (car lis)
 760             def-len (length (car macro-def)))
 761       (if (and (>= str-len def-len)
 762                (equal (car macro-def) (subseq str 0 def-len)))
 763           (if (or (viper-kbd-buf-definition macro-def)
 764                   (viper-kbd-mode-definition macro-def)
 765                   (viper-kbd-global-definition macro-def))
 766               (setq found t))
 767         )
 768       (setq lis (cdr lis)))
 769
 770     (if found
 771         (setq match macro-def
 772               unmatched-start-idx def-len)
 773       (setq match nil
 774             unmatched-start-idx 0))
 775
 776     (cons match unmatched-start-idx)))
 777
 778
 779
 780 ;; returns a list of names of macros defined for the current buffer
 781 (defun viper-this-buffer-macros (macro-alist)
 782   (let (candidates)
 783     (setq candidates
 784           (mapcar (lambda (elt)
 785                     (if (or (viper-kbd-buf-definition elt)
 786                             (viper-kbd-mode-definition elt)
 787                             (viper-kbd-global-definition elt))
 788                         (car elt)))
 789                   macro-alist))
 790     (setq candidates (delq nil candidates))))
 791
 792
 793 ;; if seq of Viper key symbols (representing a macro) can be converted to a
 794 ;; string--do so.  Otherwise, do nothing.
 795 (defun viper-display-macro (macro-name-or-body)
 796   (cond ((viper-char-symbol-sequence-p macro-name-or-body)
 797          (mapconcat 'symbol-name macro-name-or-body ""))
 798         ((viper-char-array-p macro-name-or-body)
 799          (mapconcat 'char-to-string macro-name-or-body ""))
 800         (t macro-name-or-body)))
 801
 802 ;; convert sequence of events (that came presumably from emacs kbd macro) into
 803 ;; Viper's macro, which is a vector of the form
 804 ;; [ desc desc ... ]
 805 ;; Each desc is either a symbol of (meta symb), (shift symb), etc.
 806 ;; Here we purge events that happen to be lists.  In most cases, these events
 807 ;; got into a macro definition unintentionally; say, when the user moves mouse
 808 ;; during a macro definition, then something like (switch-frame ...) might get
 809 ;; in.  Another reason for purging lists-events is that we can't store them in
 810 ;; textual form (say, in .emacs) and then read them back.
 811 (defun viper-events-to-macro (event-seq)
 812   (vconcat (delq nil (mapcar (lambda (elt) (if (consp elt)
 813                                                nil
 814                                              (viper-event-key elt)))
 815                              event-seq))))
 816
 817 ;; convert strings or arrays of characters to Viper macro form
 818 (defun viper-char-array-to-macro (array)
 819   (let ((vec (vconcat array))
 820         macro)
 821     (if viper-xemacs-p
 822         (setq macro (mapcar 'character-to-event vec))
 823       (setq macro vec))
 824     (vconcat (mapcar 'viper-event-key macro))))
 825
 826 ;; 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
 828 ;; if a digit is found, it is converted into a symbol (e.g., 0 -> \0, etc).
 829 ;; If MACRO is not a list or vector -- doesn't change MACRO.
 830 (defun viper-fixup-macro (macro)
 831   (let ((len (length macro))
 832         (idx 0)
 833         elt break)
 834     (if (or (vectorp macro) (listp macro))
 835         (while (and (< idx len) (not break))
 836           (setq elt (elt macro idx))
 837           (cond ((numberp elt)
 838                  ;; fix number
 839                  (if (and (<= 0 elt) (<= elt 9))
 840                      (cond ((arrayp macro)
 841                             (aset macro
 842                                   idx
 843                                   (intern (char-to-string (+ ?0 elt)))))
 844                            ((listp macro)
 845                             (setcar (nthcdr idx macro)
 846                                     (intern (char-to-string (+ ?0 elt)))))
 847                            )))
 848                 ((listp elt)
 849                  (viper-fixup-macro elt))
 850                 ((symbolp elt) nil)
 851                 (t (setq break t)))
 852           (setq idx (1+ idx))))
 853
 854       (if break
 855           (error "Wrong type macro component, symbol-or-listp, %S" elt)
 856         macro)))
 857
 858 (defun viper-char-array-p (array)
 859   (eval (cons 'and (mapcar 'viper-characterp array))))
 860
 861 (defun viper-macro-to-events (macro-body)
 862   (vconcat (mapcar 'viper-key-to-emacs-key macro-body)))
 863
 864
 865 ;; check if vec is a vector of character symbols
 866 (defun viper-char-symbol-sequence-p (vec)
 867   (and
 868    (sequencep vec)
 869    (eval
 870     (cons 'and
 871           (mapcar (lambda (elt)
 872                     (and (symbolp elt) (= (length (symbol-name elt)) 1)))
 873                   vec)))))
 874
 875
 876 ;; Check if vec is a vector of key-press events representing characters
 877 ;; XEmacs only
 878 (defun viper-event-vector-p (vec)
 879   (and (vectorp vec)
 880        (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec)))))
 881
 882 \f
 883 ;;; Reading fast key sequences
 884
 885 ;; Assuming that CHAR was the first character in a fast succession of key
 886 ;; strokes, read the rest.  Return the vector of keys that was entered in
 887 ;; this fast succession of key strokes.
 888 ;; A fast keysequence is one that is terminated by a pause longer than
 889 ;; viper-fast-keyseq-timeout.
 890 (defun viper-read-fast-keysequence (event macro-alist)
 891   (let ((lis (vector event))
 892         next-event)
 893     (while (and (viper-fast-keysequence-p)
 894                 (viper-keyseq-is-a-possible-macro lis macro-alist))
 895       (setq next-event (viper-read-key))
 896       ;;(setq next-event (viper-read-event))
 897       (or (viper-mouse-event-p next-event)
 898           (setq lis (vconcat lis (vector next-event)))))
 899     lis))
 900
 901 \f
 902 ;;; Keyboard macros in registers
 903
 904 ;; sets register to last-kbd-macro carefully.
 905 (defun viper-set-register-macro (reg)
 906   (if (get-register reg)
 907       (if (y-or-n-p "Register contains data.  Overwrite? ")
 908           ()
 909         (error
 910          "Macro not saved in register.  Can still be invoked via `C-x e'")))
 911   (set-register reg last-kbd-macro))
 912
 913 (defun viper-register-macro (count)
 914   "Keyboard macros in registers - a modified \@ command."
 915   (interactive "P")
 916   (let ((reg (downcase (read-char))))
 917     (cond ((or (and (<= ?a reg) (<= reg ?z)))
 918            (setq viper-last-macro-reg reg)
 919            (if defining-kbd-macro
 920                (progn
 921                  (end-kbd-macro)
 922                  (viper-set-register-macro reg))
 923              (execute-kbd-macro (get-register reg) count)))
 924           ((or (= ?@ reg) (= ?\^j reg) (= ?\^m reg))
 925            (if viper-last-macro-reg
 926                nil
 927                (error "No previous kbd macro"))
 928            (execute-kbd-macro (get-register viper-last-macro-reg) count))
 929           ((= ?\# reg)
 930            (start-kbd-macro count))
 931           ((= ?! reg)
 932            (setq reg (downcase (read-char)))
 933            (if (or (and (<= ?a reg) (<= reg ?z)))
 934                (progn
 935                (setq viper-last-macro-reg reg)
 936                (viper-set-register-macro reg))))
 937           (t
 938            (error "`%c': Unknown register" reg)))))
 939
 940
 941 (defun viper-global-execute ()
 942   "Call last keyboad macro for each line in the region."
 943   (if (> (point) (mark t)) (exchange-point-and-mark))
 944   (beginning-of-line)
 945   (call-last-kbd-macro)
 946   (while (< (point) (mark t))
 947     (forward-line 1)
 948     (beginning-of-line)
 949     (call-last-kbd-macro)))
 950
 951
 952 ;;; viper-macs.el ends here