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