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