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