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