lisp/emulation/viper-macs.el

   1 ;;; viper-macs.el --- functions implementing keyboard macros for Viper
   2
   3 ;; Copyright (C) 1994, 95, 96, 97, 2000, 01, 02, 2005 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Kifer <kifer@cs.stonybrook.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., 51 Franklin Street, Fifth Floor,
  22 ;; Boston, MA 02110-1301, 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 (viper-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 (viper-subseq key-seq 0 (- (length key-seq) 2))))
 246               ((member key '(tab (control i) ?\t))
 247                (setq key-seq (viper-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 ;; More general definitions are inherited by more specific scopes:
 333 ;; global->major mode->buffer. More specific definitions override more general
 334 (defun viper-record-kbd-macro (macro-name state macro-body &optional scope)
 335   "Record a Vi macro.  Can be used in `.viper' file to define permanent macros.
 336 MACRO-NAME is a string of characters or a vector of keys.  STATE is
 337 either `vi-state' or `insert-state'.  It specifies the Viper state in which to
 338 define the macro.  MACRO-BODY is a string that represents the keyboard macro.
 339 Optional SCOPE says whether the macro should be global \(t\), mode-specific
 340 \(a major-mode symbol\), or buffer-specific \(buffer name, a string\).
 341 If SCOPE is nil, the user is asked to specify the scope."
 342   (let* (state-name keymap
 343          (macro-alist-var
 344           (cond ((eq state 'vi-state)
 345                  (setq state-name "Vi state"
 346                        keymap viper-vi-kbd-map)
 347                  'viper-vi-kbd-macro-alist)
 348                 ((memq state '(insert-state replace-state))
 349                  (setq state-name "Insert state"
 350                        keymap viper-insert-kbd-map)
 351                  'viper-insert-kbd-macro-alist)
 352                 (t
 353                  (setq state-name "Emacs state"
 354                        keymap viper-emacs-kbd-map)
 355                  'viper-emacs-kbd-macro-alist)
 356                  ))
 357          new-elt old-elt old-sub-elt msg
 358          temp lis lis2)
 359
 360     (if (= (length macro-name) 0)
 361         (error "Can't map an empty macro name"))
 362
 363     ;; Macro-name is usually a vector.  However, command history or macros
 364     ;; recorded in ~/.viper may be recorded as strings.  So, convert to
 365     ;; vectors.
 366     (setq macro-name (viper-fixup-macro macro-name))
 367     (if (viper-char-array-p macro-name)
 368         (setq macro-name (viper-char-array-to-macro macro-name)))
 369     (setq macro-body (viper-fixup-macro macro-body))
 370     (if (viper-char-array-p macro-body)
 371         (setq macro-body (viper-char-array-to-macro macro-body)))
 372
 373     ;; don't ask if scope is given and is of the right type
 374     (or (eq scope t)
 375         (stringp scope)
 376         (and scope (symbolp scope))
 377         (progn
 378           (setq scope
 379                 (cond
 380                  ((y-or-n-p
 381                    (format
 382                     "Map this macro for buffer `%s' only? "
 383                     (buffer-name)))
 384                   (setq msg
 385                         (format
 386                          "%S is mapped to %s for %s in `%s'"
 387                          (viper-display-macro macro-name)
 388                          (viper-abbreviate-string
 389                           (format
 390                            "%S"
 391                            (setq temp (viper-display-macro macro-body)))
 392                           14 "" ""
 393                           (if (stringp temp) "  ....\"" "  ....]"))
 394                          state-name (buffer-name)))
 395                   (buffer-name))
 396                  ((y-or-n-p
 397                    (format
 398                     "Map this macro for the major mode `%S' only? "
 399                     major-mode))
 400                   (setq msg
 401                         (format
 402                          "%S is mapped to %s for %s in `%S'"
 403                          (viper-display-macro macro-name)
 404                          (viper-abbreviate-string
 405                           (format
 406                            "%S"
 407                            (setq temp (viper-display-macro macro-body)))
 408                           14 "" ""
 409                           (if (stringp macro-body) "  ....\"" "  ....]"))
 410                          state-name major-mode))
 411                   major-mode)
 412                  (t
 413                   (setq msg
 414                         (format
 415                          "%S is globally mapped to %s in %s"
 416                          (viper-display-macro macro-name)
 417                          (viper-abbreviate-string
 418                           (format
 419                            "%S"
 420                            (setq temp (viper-display-macro macro-body)))
 421                           14 "" ""
 422                           (if (stringp macro-body) "  ....\"" "  ....]"))
 423                          state-name))
 424                   t)))
 425           (if (y-or-n-p
 426                (format "Save this macro in %s? "
 427                        (viper-abbreviate-file-name viper-custom-file-name)))
 428               (viper-save-string-in-file
 429                (format "\n(viper-record-kbd-macro %S '%S %s '%S)"
 430                        (viper-display-macro macro-name)
 431                        state
 432                        ;; if we don't let vector macro-body through %S,
 433                        ;; the symbols `\.' `\[' etc will be converted into
 434                        ;; characters, causing invalid read  error on recorded
 435                        ;; macros in .viper.
 436                        ;; I am not sure is macro-body can still be a string at
 437                        ;; this point, but I am preserving this option anyway.
 438                        (if (vectorp macro-body)
 439                            (format "%S" macro-body)
 440                          macro-body)
 441                        scope)
 442                viper-custom-file-name))
 443
 444           (message msg)
 445           ))
 446
 447     (setq new-elt
 448           (cons macro-name
 449                 (cond ((eq scope t) (list nil nil (cons t nil)))
 450                       ((symbolp scope)
 451                        (list nil (list (cons scope nil)) (cons t nil)))
 452                       ((stringp scope)
 453                        (list (list (cons scope nil)) nil (cons t nil))))))
 454     (setq old-elt (assoc macro-name (eval macro-alist-var)))
 455
 456     (if (null old-elt)
 457         (progn
 458           ;; insert new-elt in macro-alist-var and keep the list sorted
 459           (define-key
 460             keymap
 461             (vector (viper-key-to-emacs-key (aref macro-name 0)))
 462             'viper-exec-mapped-kbd-macro)
 463           (setq lis (eval macro-alist-var))
 464           (while (and lis (string< (viper-array-to-string (car (car lis)))
 465                                    (viper-array-to-string macro-name)))
 466             (setq lis2 (cons (car lis) lis2))
 467             (setq lis (cdr lis)))
 468
 469           (setq lis2 (reverse lis2))
 470           (set macro-alist-var (append lis2 (cons new-elt lis)))
 471           (setq old-elt new-elt)))
 472     (setq old-sub-elt
 473           (cond ((eq scope t) (viper-kbd-global-pair old-elt))
 474                 ((symbolp scope) (assoc scope (viper-kbd-mode-alist old-elt)))
 475                 ((stringp scope) (assoc scope (viper-kbd-buf-alist old-elt)))))
 476     (if old-sub-elt
 477         (setcdr old-sub-elt macro-body)
 478       (cond ((symbolp scope) (setcar (cdr (cdr old-elt))
 479                                      (cons (cons scope macro-body)
 480                                            (viper-kbd-mode-alist old-elt))))
 481             ((stringp scope) (setcar (cdr old-elt)
 482                                      (cons (cons scope macro-body)
 483                                            (viper-kbd-buf-alist old-elt))))))
 484     ))
 485
 486
 487
 488 ;; macro name must be a vector of viper-style keys
 489 ;; viper-unrecord-kbd-macro doesn't have scope. Macro definitions are inherited
 490 ;; from global -> major mode -> buffer
 491 ;; More specific definition overrides more general
 492 ;; Can't unrecord definition for more specific, if a more general definition is
 493 ;; in effect
 494 (defun viper-unrecord-kbd-macro (macro-name state)
 495   "Delete macro MACRO-NAME from Viper STATE.
 496 MACRO-NAME must be a vector of viper-style keys.  This command is used by Viper
 497 internally, but the user can also use it in ~/.viper to delete pre-defined
 498 macros supplied with Viper.  The best way to avoid mistakes in macro names to
 499 be passed to this function is to use viper-describe-kbd-macros and copy the
 500 name from there."
 501   (let* (state-name keymap
 502          (macro-alist-var
 503           (cond ((eq state 'vi-state)
 504                  (setq state-name "Vi state"
 505                        keymap viper-vi-kbd-map)
 506                  'viper-vi-kbd-macro-alist)
 507                 ((memq state '(insert-state replace-state))
 508                  (setq state-name "Insert state"
 509                        keymap viper-insert-kbd-map)
 510                  'viper-insert-kbd-macro-alist)
 511                 (t
 512                  (setq state-name "Emacs state"
 513                        keymap viper-emacs-kbd-map)
 514                  'viper-emacs-kbd-macro-alist)
 515                 ))
 516          buf-mapping mode-mapping global-mapping
 517          macro-pair macro-entry)
 518
 519     ;; Macro-name is usually a vector.  However, command history or macros
 520     ;; recorded in ~/.viper may appear as strings.  So, convert to vectors.
 521     (setq macro-name (viper-fixup-macro macro-name))
 522     (if (viper-char-array-p macro-name)
 523         (setq macro-name (viper-char-array-to-macro macro-name)))
 524
 525     (setq macro-entry (assoc macro-name (eval macro-alist-var)))
 526     (if (= (length macro-name) 0)
 527         (error "Can't unmap an empty macro name"))
 528     (if (null macro-entry)
 529         (error "%S is not mapped to a macro for %s in `%s'"
 530                (viper-display-macro macro-name)
 531                state-name (buffer-name)))
 532
 533     (setq buf-mapping (viper-kbd-buf-pair macro-entry)
 534           mode-mapping (viper-kbd-mode-pair macro-entry)
 535           global-mapping (viper-kbd-global-pair macro-entry))
 536
 537     (cond ((and (cdr buf-mapping)
 538                 (or (and (not (cdr mode-mapping)) (not (cdr global-mapping)))
 539                     (y-or-n-p
 540                      (format "Unmap %S for `%s' only? "
 541                              (viper-display-macro macro-name)
 542                              (buffer-name)))))
 543            (setq macro-pair buf-mapping)
 544            (message "%S is unmapped for %s in `%s'"
 545                     (viper-display-macro macro-name)
 546                     state-name (buffer-name)))
 547           ((and (cdr mode-mapping)
 548                 (or (not (cdr global-mapping))
 549                     (y-or-n-p
 550                      (format "Unmap %S for the major mode `%S' only? "
 551                              (viper-display-macro macro-name)
 552                              major-mode))))
 553            (setq macro-pair mode-mapping)
 554            (message "%S is unmapped for %s in %S"
 555                     (viper-display-macro macro-name) state-name major-mode))
 556           ((cdr (setq macro-pair global-mapping))
 557            (message
 558             "Global mapping for %S in %s is removed"
 559             (viper-display-macro macro-name) state-name))
 560           (t (error "%S is not mapped to a macro for %s in `%s'"
 561                     (viper-display-macro macro-name)
 562                     state-name (buffer-name))))
 563     (setcdr macro-pair nil)
 564     (or (cdr buf-mapping)
 565         (cdr mode-mapping)
 566         (cdr global-mapping)
 567         (progn
 568           (set macro-alist-var (delq macro-entry (eval macro-alist-var)))
 569           (if (viper-can-release-key (aref macro-name 0)
 570                                      (eval macro-alist-var))
 571               (define-key
 572                 keymap
 573                 (vector (viper-key-to-emacs-key (aref macro-name 0)))
 574                 nil))
 575           ))
 576     ))
 577
 578 ;; Check if MACRO-ALIST has an entry for a macro name starting with
 579 ;; CHAR.  If not, this indicates that the binding for this char
 580 ;; in viper-vi/insert-kbd-map can be released.
 581 (defun viper-can-release-key (char macro-alist)
 582   (let ((lis macro-alist)
 583         (can-release t)
 584         macro-name)
 585
 586     (while (and lis can-release)
 587       (setq macro-name (car (car lis)))
 588       (if (eq char (aref macro-name 0))
 589           (setq can-release nil))
 590       (setq lis (cdr lis)))
 591     can-release))
 592
 593
 594 (defun viper-exec-mapped-kbd-macro (count)
 595   "Dispatch kbd macro."
 596   (interactive "P")
 597   (let* ((macro-alist (cond ((eq viper-current-state 'vi-state)
 598                              viper-vi-kbd-macro-alist)
 599                             ((memq viper-current-state
 600                                    '(insert-state replace-state))
 601                              viper-insert-kbd-macro-alist)
 602                             (t
 603                              viper-emacs-kbd-macro-alist)))
 604         (unmatched-suffix "")
 605         ;; Macros and keys are executed with other macros turned off
 606         ;; For macros, this is done to avoid macro recursion
 607         viper-vi-kbd-minor-mode viper-insert-kbd-minor-mode
 608         viper-emacs-kbd-minor-mode
 609         next-best-match keyseq event-seq
 610         macro-first-char macro-alist-elt macro-body
 611         command)
 612
 613     (setq macro-first-char last-command-event
 614           event-seq (viper-read-fast-keysequence macro-first-char macro-alist)
 615           keyseq (viper-events-to-macro event-seq)
 616           macro-alist-elt (assoc keyseq macro-alist)
 617           next-best-match (viper-find-best-matching-macro macro-alist keyseq))
 618
 619     (if (null macro-alist-elt)
 620         (setq macro-alist-elt (car next-best-match)
 621               unmatched-suffix (viper-subseq event-seq (cdr next-best-match))))
 622
 623     (cond ((null macro-alist-elt))
 624           ((setq macro-body (viper-kbd-buf-definition macro-alist-elt)))
 625           ((setq macro-body (viper-kbd-mode-definition macro-alist-elt)))
 626           ((setq macro-body (viper-kbd-global-definition macro-alist-elt))))
 627
 628     ;; when defining keyboard macro, don't use the macro mappings
 629     (if (and macro-body (not defining-kbd-macro))
 630         ;; block cmd executed as part of a macro from entering command history
 631         (let ((command-history command-history))
 632           (setq viper-this-kbd-macro (car macro-alist-elt))
 633           (execute-kbd-macro (viper-macro-to-events macro-body) count)
 634           (setq viper-this-kbd-macro nil
 635                 viper-last-kbd-macro (car macro-alist-elt))
 636           (viper-set-unread-command-events unmatched-suffix))
 637       ;; If not a macro, or the macro is suppressed while defining another
 638       ;; macro, put keyseq back on the event queue
 639       (viper-set-unread-command-events event-seq)
 640       ;; if the user typed arg, then use it if prefix arg is not set by
 641       ;; some other command (setting prefix arg can happen if we do, say,
 642       ;; 2dw and there is a macro starting with 2.  Then control will go to
 643       ;; this routine
 644       (or prefix-arg (setq  prefix-arg count))
 645       (setq command (key-binding (read-key-sequence nil)))
 646       (if (commandp command)
 647           (command-execute command)
 648         (beep 1)))
 649     ))
 650
 651
 652 \f
 653 ;;; Displaying and completing macros
 654
 655 (defun viper-describe-kbd-macros ()
 656   "Show currently defined keyboard macros."
 657   (interactive)
 658   (with-output-to-temp-buffer " *viper-info*"
 659     (princ "Macros in Vi state:\n===================\n")
 660     (mapcar 'viper-describe-one-macro viper-vi-kbd-macro-alist)
 661     (princ "\n\nMacros in Insert and Replace states:\n====================================\n")
 662     (mapcar 'viper-describe-one-macro viper-insert-kbd-macro-alist)
 663     (princ "\n\nMacros in Emacs state:\n======================\n")
 664     (mapcar 'viper-describe-one-macro viper-emacs-kbd-macro-alist)
 665     ))
 666
 667 (defun viper-describe-one-macro (macro)
 668   (princ (format "\n  *** Mappings for %S:\n      ------------\n"
 669                  (viper-display-macro (car macro))))
 670   (princ "   ** Buffer-specific:")
 671   (if (viper-kbd-buf-alist macro)
 672       (mapcar 'viper-describe-one-macro-elt (viper-kbd-buf-alist macro))
 673     (princ "  none\n"))
 674   (princ "\n   ** Mode-specific:")
 675   (if (viper-kbd-mode-alist macro)
 676       (mapcar 'viper-describe-one-macro-elt (viper-kbd-mode-alist macro))
 677     (princ "  none\n"))
 678   (princ "\n   ** Global:")
 679   (if (viper-kbd-global-definition macro)
 680       (princ (format "\n           %S" (cdr (viper-kbd-global-pair macro))))
 681     (princ "  none"))
 682   (princ "\n"))
 683
 684 (defun viper-describe-one-macro-elt (elt)
 685   (let ((name (car elt))
 686         (defn (cdr elt)))
 687     (princ (format "\n       * %S:\n           %S\n" name defn))))
 688
 689
 690
 691 ;; check if SEQ is a prefix of some car of an element in ALIST
 692 (defun viper-keyseq-is-a-possible-macro (seq alist)
 693   (let ((converted-seq (viper-events-to-macro seq)))
 694     (eval (cons 'or
 695                 (mapcar
 696                  (lambda (elt) (viper-prefix-subseq-p converted-seq elt))
 697                  (viper-this-buffer-macros alist))))))
 698
 699 ;; whether SEQ1 is a prefix of SEQ2
 700 (defun viper-prefix-subseq-p (seq1 seq2)
 701   (let ((len1 (length seq1))
 702         (len2 (length seq2)))
 703     (if (<= len1 len2)
 704         (equal seq1 (viper-subseq seq2 0 len1)))))
 705
 706 ;; find the longest common prefix
 707 (defun viper-common-seq-prefix (&rest seqs)
 708   (let* ((first (car seqs))
 709          (rest (cdr seqs))
 710          (pref [])
 711          (idx 0)
 712          len)
 713     (if (= (length seqs) 0)
 714         (setq len 0)
 715       (setq len (apply 'min (mapcar 'length seqs))))
 716     (while (< idx len)
 717       (if (eval (cons 'and
 718                       (mapcar (lambda (s) (equal (elt first idx) (elt s idx)))
 719                               rest)))
 720           (setq pref (vconcat pref (vector (elt first idx)))))
 721       (setq idx (1+ idx)))
 722     pref))
 723
 724 ;; get all sequences that match PREFIX from a given A-LIST
 725 (defun viper-extract-matching-alist-members (pref alist)
 726   (delq nil (mapcar (lambda (elt) (if (viper-prefix-subseq-p pref elt) elt))
 727                     (viper-this-buffer-macros alist))))
 728
 729 (defun viper-do-sequence-completion (seq alist compl-message)
 730   (let* ((matches (viper-extract-matching-alist-members seq alist))
 731          (new-seq (apply 'viper-common-seq-prefix matches))
 732          )
 733     (cond ((and (equal seq new-seq) (= (length matches) 1))
 734            (message "%s (Sole completion)" compl-message)
 735            (sit-for 2))
 736           ((null matches)
 737            (message "%s (No match)" compl-message)
 738            (sit-for 2)
 739            (setq new-seq seq))
 740           ((member seq matches)
 741            (message "%s (Complete, but not unique)" compl-message)
 742            (sit-for 2)
 743            (viper-display-vector-completions matches))
 744           ((equal seq new-seq)
 745            (viper-display-vector-completions matches)))
 746     new-seq))
 747
 748
 749 (defun viper-display-vector-completions (list)
 750   (with-output-to-temp-buffer "*Completions*"
 751     (display-completion-list
 752      (mapcar 'prin1-to-string
 753              (mapcar 'viper-display-macro list)))))
 754
 755
 756
 757 ;; alist is the alist of macros
 758 ;; str is the fast key sequence entered
 759 ;; returns: (matching-macro-def . unmatched-suffix-start-index)
 760 (defun viper-find-best-matching-macro (alist str)
 761   (let ((lis alist)
 762         (def-len 0)
 763         (str-len (length str))
 764         match unmatched-start-idx found macro-def)
 765     (while (and (not found) lis)
 766       (setq macro-def (car lis)
 767             def-len (length (car macro-def)))
 768       (if (and (>= str-len def-len)
 769                (equal (car macro-def) (viper-subseq str 0 def-len)))
 770           (if (or (viper-kbd-buf-definition macro-def)
 771                   (viper-kbd-mode-definition macro-def)
 772                   (viper-kbd-global-definition macro-def))
 773               (setq found t))
 774         )
 775       (setq lis (cdr lis)))
 776
 777     (if found
 778         (setq match macro-def
 779               unmatched-start-idx def-len)
 780       (setq match nil
 781             unmatched-start-idx 0))
 782
 783     (cons match unmatched-start-idx)))
 784
 785
 786
 787 ;; returns a list of names of macros defined for the current buffer
 788 (defun viper-this-buffer-macros (macro-alist)
 789   (let (candidates)
 790     (setq candidates
 791           (mapcar (lambda (elt)
 792                     (if (or (viper-kbd-buf-definition elt)
 793                             (viper-kbd-mode-definition elt)
 794                             (viper-kbd-global-definition elt))
 795                         (car elt)))
 796                   macro-alist))
 797     (setq candidates (delq nil candidates))))
 798
 799
 800 ;; if seq of Viper key symbols (representing a macro) can be converted to a
 801 ;; string--do so.  Otherwise, do nothing.
 802 (defun viper-display-macro (macro-name-or-body)
 803   (cond ((viper-char-symbol-sequence-p macro-name-or-body)
 804          (mapconcat 'symbol-name macro-name-or-body ""))
 805         ((viper-char-array-p macro-name-or-body)
 806          (mapconcat 'char-to-string macro-name-or-body ""))
 807         (t macro-name-or-body)))
 808
 809 ;; convert sequence of events (that came presumably from emacs kbd macro) into
 810 ;; Viper's macro, which is a vector of the form
 811 ;; [ desc desc ... ]
 812 ;; Each desc is either a symbol of (meta symb), (shift symb), etc.
 813 ;; Here we purge events that happen to be lists.  In most cases, these events
 814 ;; got into a macro definition unintentionally; say, when the user moves mouse
 815 ;; during a macro definition, then something like (switch-frame ...) might get
 816 ;; in.  Another reason for purging lists-events is that we can't store them in
 817 ;; textual form (say, in .emacs) and then read them back.
 818 (defun viper-events-to-macro (event-seq)
 819   (vconcat (delq nil (mapcar (lambda (elt) (if (consp elt)
 820                                                nil
 821                                              (viper-event-key elt)))
 822                              event-seq))))
 823
 824 ;; convert strings or arrays of characters to Viper macro form
 825 (defun viper-char-array-to-macro (array)
 826   (let ((vec (vconcat array))
 827         macro)
 828     (if viper-xemacs-p
 829         (setq macro (mapcar 'character-to-event vec))
 830       (setq macro vec))
 831     (vconcat (mapcar 'viper-event-key macro))))
 832
 833 ;; For macros bodies and names, goes over MACRO and checks if all members are
 834 ;; names of keys (actually, it only checks if they are symbols or lists
 835 ;; if a digit is found, it is converted into a symbol (e.g., 0 -> \0, etc).
 836 ;; If MACRO is not a list or vector -- doesn't change MACRO.
 837 (defun viper-fixup-macro (macro)
 838   (let ((len (length macro))
 839         (idx 0)
 840         elt break)
 841     (if (or (vectorp macro) (listp macro))
 842         (while (and (< idx len) (not break))
 843           (setq elt (elt macro idx))
 844           (cond ((numberp elt)
 845                  ;; fix number
 846                  (if (and (<= 0 elt) (<= elt 9))
 847                      (cond ((arrayp macro)
 848                             (aset macro
 849                                   idx
 850                                   (intern (char-to-string (+ ?0 elt)))))
 851                            ((listp macro)
 852                             (setcar (nthcdr idx macro)
 853                                     (intern (char-to-string (+ ?0 elt)))))
 854                            )))
 855                 ((listp elt)
 856                  (viper-fixup-macro elt))
 857                 ((symbolp elt) nil)
 858                 (t (setq break t)))
 859           (setq idx (1+ idx))))
 860
 861       (if break
 862           (error "Wrong type macro component, symbol-or-listp, %S" elt)
 863         macro)))
 864
 865 (defun viper-macro-to-events (macro-body)
 866   (vconcat (mapcar 'viper-key-to-emacs-key macro-body)))
 867
 868
 869 \f
 870 ;;; Reading fast key sequences
 871
 872 ;; Assuming that CHAR was the first character in a fast succession of key
 873 ;; strokes, read the rest.  Return the vector of keys that was entered in
 874 ;; this fast succession of key strokes.
 875 ;; A fast keysequence is one that is terminated by a pause longer than
 876 ;; viper-fast-keyseq-timeout.
 877 (defun viper-read-fast-keysequence (event macro-alist)
 878   (let ((lis (vector event))
 879         next-event)
 880     (while (and (viper-fast-keysequence-p)
 881                 (viper-keyseq-is-a-possible-macro lis macro-alist))
 882       (setq next-event (viper-read-key))
 883       ;;(setq next-event (viper-read-event))
 884       (or (viper-mouse-event-p next-event)
 885           (setq lis (vconcat lis (vector next-event)))))
 886     lis))
 887
 888 \f
 889 ;;; Keyboard macros in registers
 890
 891 ;; sets register to last-kbd-macro carefully.
 892 (defun viper-set-register-macro (reg)
 893   (if (get-register reg)
 894       (if (y-or-n-p "Register contains data.  Overwrite? ")
 895           ()
 896         (error
 897          "Macro not saved in register.  Can still be invoked via `C-x e'")))
 898   (set-register reg last-kbd-macro))
 899
 900 (defun viper-register-macro (count)
 901   "Keyboard macros in registers - a modified \@ command."
 902   (interactive "P")
 903   (let ((reg (downcase (read-char))))
 904     (cond ((or (and (<= ?a reg) (<= reg ?z)))
 905            (setq viper-last-macro-reg reg)
 906            (if defining-kbd-macro
 907                (progn
 908                  (end-kbd-macro)
 909                  (viper-set-register-macro reg))
 910              (execute-kbd-macro (get-register reg) count)))
 911           ((or (= ?@ reg) (= ?\^j reg) (= ?\^m reg))
 912            (if viper-last-macro-reg
 913                nil
 914                (error "No previous kbd macro"))
 915            (execute-kbd-macro (get-register viper-last-macro-reg) count))
 916           ((= ?\# reg)
 917            (start-kbd-macro count))
 918           ((= ?! reg)
 919            (setq reg (downcase (read-char)))
 920            (if (or (and (<= ?a reg) (<= reg ?z)))
 921                (progn
 922                (setq viper-last-macro-reg reg)
 923                (viper-set-register-macro reg))))
 924           (t
 925            (error "`%c': Unknown register" reg)))))
 926
 927
 928 (defun viper-global-execute ()
 929   "Call last keyboad macro for each line in the region."
 930   (if (> (point) (mark t)) (exchange-point-and-mark))
 931   (beginning-of-line)
 932   (call-last-kbd-macro)
 933   (while (< (point) (mark t))
 934     (forward-line 1)
 935     (beginning-of-line)
 936     (call-last-kbd-macro)))
 937
 938
 939 ;;; arch-tag: ecd3cc5c-8cd0-4bbe-b2ec-7e75a4b7d0aa
 940 ;;; viper-macs.el ends here