1;;; vip.el --- a VI Package for GNU Emacs 2 3;; Author: Masahiko Sato <ms@sail.stanford.edu> 4;; Version: 3.5 5;; Keywords: emulations 6 7;;; Commentary: 8 9;; A full-featured vi(1) emulator. 10;; 11;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet 12;; 13;; Send suggestions and bug reports to one of the above addresses. 14;; When you report a bug, be sure to include the version number of VIP and 15;; Emacs you are using. 16 17;; Execute info command by typing "M-x info" to get information on VIP. 18 19;;; Code: 20 21;; external variables 22 23(defvar vip-emacs-local-map nil 24 "Local map used in emacs mode. \(buffer specific\)") 25 26(defvar vip-insert-local-map nil 27 "Local map used in insert command mode. \(buffer specific\)") 28 29(make-variable-buffer-local 'vip-emacs-local-map) 30(make-variable-buffer-local 'vip-insert-local-map) 31 32(defvar vip-insert-point nil 33 "Remember insert point as a marker. \(buffer specific\)") 34 35(set-default 'vip-insert-point (make-marker)) 36(make-variable-buffer-local 'vip-insert-point) 37 38(defvar vip-com-point nil 39 "Remember com point as a marker. \(buffer specific\)") 40 41(set-default 'vip-com-point (make-marker)) 42(make-variable-buffer-local 'vip-com-point) 43 44(defvar vip-current-mode nil 45 "Current mode. One of emacs-mode, vi-mode, insert-mode.") 46 47(make-variable-buffer-local 'vip-current-mode) 48(setq-default vip-current-mode 'emacs-mode) 49 50(defvar vip-emacs-mode-line-buffer-identification nil 51 "value of mode-line-buffer-identification in emacs-mode.") 52(make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification) 53(setq-default vip-emacs-mode-line-buffer-identification 54 '("Emacs: %17b")) 55 56(defvar vip-current-major-mode nil 57 "vip-current-major-mode is the major-mode vi considers it is now. 58\(buffer specific\)") 59 60(make-variable-buffer-local 'vip-current-major-mode) 61 62(defvar vip-last-shell-com nil 63 "last shell command executed by ! command") 64 65(defvar vip-use-register nil 66 "name of register to store deleted or yanked strings.") 67 68(defvar vip-d-com nil 69 "If non-nil, it's value is a list (M-COM VAL COM), and is used to 70re-execute last destructive command") 71 72(defconst vip-shift-width 8 73 "*The number of colums shifted by > and < command.") 74 75(defconst vip-re-replace nil 76 "*If t then do regexp replace, if nil then do string replace.") 77 78(defvar vip-d-char nil 79 "The character remembered by the vi \"r\" command") 80 81(defvar vip-f-char nil 82 "for use by \";\" command") 83 84(defvar vip-F-char nil 85 "for use by \".\" command") 86 87(defvar vip-f-forward nil 88 "for use by \";\" command") 89 90(defvar vip-f-offset nil 91 "for use by \";\" command") 92 93(defconst vip-search-wrap-around t 94 "*if t, search wraps around") 95 96(defconst vip-re-search nil 97 "*if t, search is reg-exp search, otherwise vanilla search.") 98 99(defvar vip-s-string nil 100 "last search string") 101 102(defvar vip-s-forward nil 103 "if t, search is forward.") 104 105(defconst vip-case-fold-search nil 106 "*if t, search ignores cases.") 107 108(defconst vip-re-query-replace nil 109 "*If t then do regexp replace, if nil then do string replace.") 110 111(defconst vip-open-with-indent nil 112 "*if t, indent when open a new line.") 113 114(defconst vip-help-in-insert-mode nil 115 "*if t then C-h is bound to help-command in insert mode, if nil then it is 116bound to delete-backward-char.") 117 118(defvar vip-quote-string "> " 119 "string inserted at the beginning of region") 120 121(defvar vip-tags-file-name "TAGS") 122 123(defvar vip-inhibit-startup-message nil) 124 125;; basic set up 126 127(global-set-key "\C-z" 'vip-change-mode-to-vi) 128 129(defmacro vip-loop (count body) 130 "(COUNT BODY) Execute BODY COUNT times." 131 (list 'let (list (list 'count count)) 132 (list 'while (list '> 'count 0) 133 body 134 (list 'setq 'count (list '1- 'count))))) 135 136(defun vip-push-mark-silent (&optional location) 137 "Set mark at LOCATION (point, by default) and push old mark on mark ring. 138No message." 139 (if (null (mark)) 140 nil 141 (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) 142 (if (> (length mark-ring) mark-ring-max) 143 (progn 144 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) 145 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))) 146 (set-mark (or location (point)))) 147 148(defun vip-goto-col (arg) 149 "Go to ARG's column." 150 (interactive "P") 151 (let ((val (vip-p-val arg)) 152 (com (vip-getcom arg))) 153 (save-excursion 154 (end-of-line) 155 (if (> val (1+ (current-column))) (error ""))) 156 (if com (move-marker vip-com-point (point))) 157 (beginning-of-line) 158 (forward-char (1- val)) 159 (if com (vip-execute-com 'vip-goto-col val com)))) 160 161(defun vip-refresh-mode-line () 162 "Redraw mode line." 163 (set-buffer-modified-p (buffer-modified-p))) 164 165(defun vip-copy-keymap (map) 166 (if (null map) (make-sparse-keymap) (copy-keymap map))) 167 168 169;; changing mode 170 171(defun vip-change-mode (new-mode) 172 "Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode." 173 (or (eq new-mode vip-current-mode) 174 (progn 175 (cond ((eq new-mode 'vi-mode) 176 (if (eq vip-current-mode 'insert-mode) 177 (progn 178 (vip-copy-region-as-kill (point) vip-insert-point) 179 (vip-repeat-insert-command)) 180 (setq vip-emacs-local-map (current-local-map) 181 vip-emacs-mode-line-buffer-identification 182 mode-line-buffer-identification 183 vip-insert-local-map (vip-copy-keymap 184 (current-local-map)))) 185 (vip-change-mode-line "Vi: ") 186 (use-local-map vip-mode-map)) 187 ((eq new-mode 'insert-mode) 188 (move-marker vip-insert-point (point)) 189 (if (eq vip-current-mode 'emacs-mode) 190 (setq vip-emacs-local-map (current-local-map) 191 vip-emacs-mode-line-buffer-identification 192 mode-line-buffer-identification 193 vip-insert-local-map (vip-copy-keymap 194 (current-local-map))) 195 (setq vip-insert-local-map (vip-copy-keymap 196 vip-emacs-local-map))) 197 (vip-change-mode-line "Insert") 198 (use-local-map vip-insert-local-map) 199 (define-key vip-insert-local-map "\e" 'vip-change-mode-to-vi) 200 (define-key vip-insert-local-map "\C-z" 'vip-ESC) 201 (define-key vip-insert-local-map "\C-h" 202 (if vip-help-in-insert-mode 'help-command 203 'delete-backward-char)) 204 (define-key vip-insert-local-map "\C-w" 205 'vip-delete-backward-word)) 206 ((eq new-mode 'emacs-mode) 207 (vip-change-mode-line "Emacs:") 208 (use-local-map vip-emacs-local-map))) 209 (setq vip-current-mode new-mode) 210 (vip-refresh-mode-line)))) 211 212(defun vip-copy-region-as-kill (beg end) 213 "If BEG and END do not belong to the same buffer, it copies empty region." 214 (condition-case nil 215 (copy-region-as-kill beg end) 216 (error (copy-region-as-kill beg beg)))) 217 218(defun vip-change-mode-line (string) 219 "Assuming that the mode line format contains the string \"Emacs:\", this 220function replaces the string by \"Vi: \" etc." 221 (setq mode-line-buffer-identification 222 (if (string= string "Emacs:") 223 vip-emacs-mode-line-buffer-identification 224 (list (concat string " %17b"))))) 225 226;;;###autoload 227(defun vip-mode () 228 "Turn on VIP emulation of VI." 229 (interactive) 230 (if (not vip-inhibit-startup-message) 231 (progn 232 (switch-to-buffer "VIP Startup Message") 233 (erase-buffer) 234 (insert 235 "VIP is a Vi emulation package for GNU Emacs. VIP provides most Vi commands 236including Ex commands. VIP is however different from Vi in several points. 237You can get more information on VIP by: 238 1. Typing `M-x info' and selecting menu item \"vip\". 239 2. Typing `C-h k' followed by a key whose description you want. 240 3. Printing VIP manual which can be found as GNU/man/vip.texinfo 241 4. Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex 242 243This startup message appears whenever you load VIP unless you type `y' now. 244Type `n' to quit this window for now.\n") 245 (goto-char (point-min)) 246 (if (y-or-n-p "Inhibit VIP startup message? ") 247 (progn 248 (save-excursion 249 (set-buffer 250 (find-file-noselect (substitute-in-file-name "~/.vip"))) 251 (goto-char (point-max)) 252 (insert "\n(setq vip-inhibit-startup-message t)\n") 253 (save-buffer) 254 (kill-buffer (current-buffer))) 255 (message "VIP startup message inhibited.") 256 (sit-for 2))) 257 (kill-buffer (current-buffer)) 258 (message "") 259 (setq vip-inhibit-startup-message t))) 260 (vip-change-mode-to-vi)) 261 262(defun vip-change-mode-to-vi () 263 "Change mode to vi mode." 264 (interactive) 265 (vip-change-mode 'vi-mode)) 266 267(defun vip-change-mode-to-insert () 268 "Change mode to insert mode." 269 (interactive) 270 (vip-change-mode 'insert-mode)) 271 272(defun vip-change-mode-to-emacs () 273 "Change mode to emacs mode." 274 (interactive) 275 (vip-change-mode 'emacs-mode)) 276 277 278;; escape to emacs mode temporarily 279 280(defun vip-escape-to-emacs (arg &optional events) 281 "Escape to Emacs mode for one Emacs command. 282ARG is used as the prefix value for the executed command. If 283EVENTS is a list of events, which become the beginning of the command." 284 (interactive "P") 285 (let (com key (old-map (current-local-map))) 286 (if events (setq unread-command-events events)) 287 (setq prefix-arg arg) 288 (use-local-map vip-emacs-local-map) 289 (unwind-protect 290 (setq com (key-binding (setq key (read-key-sequence nil)))) 291 (use-local-map old-map)) 292 (command-execute com prefix-arg) 293 (setq prefix-arg nil) ;; reset prefix arg 294 )) 295 296(defun vip-message-conditions (conditions) 297 "Print CONDITIONS as a message." 298 (let ((case (car conditions)) (msg (cdr conditions))) 299 (if (null msg) 300 (message "%s" case) 301 (message "%s %s" case (prin1-to-string msg))) 302 (ding))) 303 304(defun vip-ESC (arg) 305 "Emulate ESC key in Emacs mode." 306 (interactive "P") 307 (vip-escape-to-emacs arg '(?\e))) 308 309(defun vip-ctl-c (arg) 310 "Emulate C-c key in Emacs mode." 311 (interactive "P") 312 (vip-escape-to-emacs arg '(?\C-c))) 313 314(defun vip-ctl-x (arg) 315 "Emulate C-x key in Emacs mode." 316 (interactive "P") 317 (vip-escape-to-emacs arg '(?\C-x))) 318 319(defun vip-ctl-h (arg) 320 "Emulate C-h key in Emacs mode." 321 (interactive "P") 322 (vip-escape-to-emacs arg '(?\C-h))) 323 324 325;; prefix argument for vi mode 326 327;; In vi mode, prefix argument is a dotted pair (NUM . COM) where NUM 328;; represents the numeric value of the prefix argument and COM represents 329;; command prefix such as "c", "d", "m" and "y". 330 331(defun vip-prefix-arg-value (char value com) 332 "Compute numeric prefix arg value. Invoked by CHAR. VALUE is the value 333obtained so far, and COM is the command part obtained so far." 334 (while (and (>= char ?0) (<= char ?9)) 335 (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0))) 336 (setq char (read-char))) 337 (setq prefix-arg value) 338 (if com (setq prefix-arg (cons prefix-arg com))) 339 (while (= char ?U) 340 (vip-describe-arg prefix-arg) 341 (setq char (read-char))) 342 (setq unread-command-events (list char))) 343 344(defun vip-prefix-arg-com (char value com) 345 "Vi operator as prefix argument." 346 (let ((cont t)) 347 (while (and cont 348 (or (= char ?c) (= char ?d) (= char ?y) 349 (= char ?!) (= char ?<) (= char ?>) (= char ?=) 350 (= char ?#) (= char ?r) (= char ?R) (= char ?\"))) 351 (if com 352 ;; this means that we already have a command character, so we 353 ;; construct a com list and exit while. however, if char is " 354 ;; it is an error. 355 (progn 356 ;; new com is (CHAR . OLDCOM) 357 (if (or (= char ?#) (= char ?\")) (error "")) 358 (setq com (cons char com)) 359 (setq cont nil)) 360 ;; if com is nil we set com as char, and read more. again, if char 361 ;; is ", we read the name of register and store it in vip-use-register. 362 ;; if char is !, =, or #, a complete com is formed so we exit while. 363 (cond ((or (= char ?!) (= char ?=)) 364 (setq com char) 365 (setq char (read-char)) 366 (setq cont nil)) 367 ((= char ?#) 368 ;; read a char and encode it as com 369 (setq com (+ 128 (read-char))) 370 (setq char (read-char)) 371 (setq cont nil)) 372 ((or (= char ?<) (= char ?>)) 373 (setq com char) 374 (setq char (read-char)) 375 (if (= com char) (setq com (cons char com))) 376 (setq cont nil)) 377 ((= char ?\") 378 (let ((reg (read-char))) 379 (if (or (and (<= ?A reg) (<= reg ?z)) 380 (and (<= ?1 reg) (<= reg ?9))) 381 (setq vip-use-register reg) 382 (error "")) 383 (setq char (read-char)))) 384 (t 385 (setq com char) 386 (setq char (read-char))))))) 387 (if (atom com) 388 ;; com is a single char, so we construct prefix-arg 389 ;; and if char is ?, describe prefix arg, otherwise exit by 390 ;; pushing the char back 391 (progn 392 (setq prefix-arg (cons value com)) 393 (while (= char ?U) 394 (vip-describe-arg prefix-arg) 395 (setq char (read-char))) 396 (setq unread-command-events (list char))) 397 ;; as com is non-nil, this means that we have a command to execute 398 (if (or (= (car com) ?r) (= (car com) ?R)) 399 ;; execute apropriate region command. 400 (let ((char (car com)) (com (cdr com))) 401 (setq prefix-arg (cons value com)) 402 (if (= char ?r) (vip-region prefix-arg) 403 (vip-Region prefix-arg)) 404 ;; reset prefix-arg 405 (setq prefix-arg nil)) 406 ;; otherwise, reset prefix arg and call appropriate command 407 (setq value (if (null value) 1 value)) 408 (setq prefix-arg nil) 409 (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C))) 410 ((equal com '(?d . ?d)) (vip-line (cons value ?D))) 411 ((equal com '(?d . ?y)) (vip-yank-defun)) 412 ((equal com '(?y . ?y)) (vip-line (cons value ?Y))) 413 ((equal com '(?< . ?<)) (vip-line (cons value ?<))) 414 ((equal com '(?> . ?>)) (vip-line (cons value ?>))) 415 ((equal com '(?! . ?!)) (vip-line (cons value ?!))) 416 ((equal com '(?= . ?=)) (vip-line (cons value ?=))) 417 (t (error "")))))) 418 419(defun vip-describe-arg (arg) 420 (let (val com) 421 (setq val (vip-P-val arg) 422 com (vip-getcom arg)) 423 (if (null val) 424 (if (null com) 425 (message "Value is nil, and command is nil.") 426 (message "Value is nil, and command is %c." com)) 427 (if (null com) 428 (message "Value is %d, and command is nil." val) 429 (message "Value is %d, and command is %c." val com))))) 430 431(defun vip-digit-argument (arg) 432 "Begin numeric argument for the next command." 433 (interactive "P") 434 (vip-prefix-arg-value last-command-char nil 435 (if (consp arg) (cdr arg) nil))) 436 437(defun vip-command-argument (arg) 438 "Accept a motion command as an argument." 439 (interactive "P") 440 (condition-case conditions 441 (vip-prefix-arg-com 442 last-command-char 443 (cond ((null arg) nil) 444 ((consp arg) (car arg)) 445 ((numberp arg) arg) 446 (t (error "strange arg"))) 447 (cond ((null arg) nil) 448 ((consp arg) (cdr arg)) 449 ((numberp arg) nil) 450 (t (error "strange arg")))) 451 (quit 452 (setq vip-use-register nil) 453 (signal 'quit nil)))) 454 455(defun vip-p-val (arg) 456 "Get value part of prefix-argument ARG." 457 (cond ((null arg) 1) 458 ((consp arg) (if (null (car arg)) 1 (car arg))) 459 (t arg))) 460 461(defun vip-P-val (arg) 462 "Get value part of prefix-argument ARG." 463 (cond ((consp arg) (car arg)) 464 (t arg))) 465 466(defun vip-getcom (arg) 467 "Get com part of prefix-argument ARG." 468 (cond ((null arg) nil) 469 ((consp arg) (cdr arg)) 470 (t nil))) 471 472(defun vip-getCom (arg) 473 "Get com part of prefix-argument ARG and modify it." 474 (let ((com (vip-getcom arg))) 475 (cond ((equal com ?c) ?C) 476 ((equal com ?d) ?D) 477 ((equal com ?y) ?Y) 478 (t com)))) 479 480 481;; repeat last destructive command 482 483(defun vip-append-to-register (reg start end) 484 "Append region to text in register REG. 485START and END are buffer positions indicating what to append." 486 (set-register reg (concat (or (get-register reg) "") 487 (buffer-substring start end)))) 488 489(defun vip-execute-com (m-com val com) 490 "(M-COM VAL COM) Execute command COM. The list (M-COM VAL COM) is set 491to vip-d-com for later use by vip-repeat" 492 (let ((reg vip-use-register)) 493 (if com 494 (cond ((= com ?c) (vip-change vip-com-point (point))) 495 ((= com (- ?c)) (vip-change-subr vip-com-point (point))) 496 ((or (= com ?C) (= com (- ?C))) 497 (save-excursion 498 (set-mark vip-com-point) 499 (vip-enlarge-region (mark) (point)) 500 (if vip-use-register 501 (progn 502 (cond ((and (<= ?a vip-use-register) 503 (<= vip-use-register ?z)) 504 (copy-to-register 505 vip-use-register (mark) (point) nil)) 506 ((and (<= ?A vip-use-register) 507 (<= vip-use-register ?Z)) 508 (vip-append-to-register 509 (+ vip-use-register 32) (mark) (point))) 510 (t (setq vip-use-register nil) 511 (error ""))) 512 (setq vip-use-register nil))) 513 (delete-region (mark) (point))) 514 (open-line 1) 515 (if (= com ?C) (vip-change-mode-to-insert) (yank))) 516 ((= com ?d) 517 (if vip-use-register 518 (progn 519 (cond ((and (<= ?a vip-use-register) 520 (<= vip-use-register ?z)) 521 (copy-to-register 522 vip-use-register vip-com-point (point) nil)) 523 ((and (<= ?A vip-use-register) 524 (<= vip-use-register ?Z)) 525 (vip-append-to-register 526 (+ vip-use-register 32) vip-com-point (point))) 527 (t (setq vip-use-register nil) 528 (error ""))) 529 (setq vip-use-register nil))) 530 (setq last-command 531 (if (eq last-command 'd-command) 'kill-region nil)) 532 (kill-region vip-com-point (point)) 533 (setq this-command 'd-command)) 534 ((= com ?D) 535 (save-excursion 536 (set-mark vip-com-point) 537 (vip-enlarge-region (mark) (point)) 538 (if vip-use-register 539 (progn 540 (cond ((and (<= ?a vip-use-register) 541 (<= vip-use-register ?z)) 542 (copy-to-register 543 vip-use-register (mark) (point) nil)) 544 ((and (<= ?A vip-use-register) 545 (<= vip-use-register ?Z)) 546 (vip-append-to-register 547 (+ vip-use-register 32) (mark) (point))) 548 (t (setq vip-use-register nil) 549 (error ""))) 550 (setq vip-use-register nil))) 551 (setq last-command 552 (if (eq last-command 'D-command) 'kill-region nil)) 553 (kill-region (mark) (point)) 554 (if (eq m-com 'vip-line) (setq this-command 'D-command))) 555 (back-to-indentation)) 556 ((= com ?y) 557 (if vip-use-register 558 (progn 559 (cond ((and (<= ?a vip-use-register) 560 (<= vip-use-register ?z)) 561 (copy-to-register 562 vip-use-register vip-com-point (point) nil)) 563 ((and (<= ?A vip-use-register) 564 (<= vip-use-register ?Z)) 565 (vip-append-to-register 566 (+ vip-use-register 32) vip-com-point (point))) 567 (t (setq vip-use-register nil) 568 (error ""))) 569 (setq vip-use-register nil))) 570 (setq last-command nil) 571 (copy-region-as-kill vip-com-point (point)) 572 (goto-char vip-com-point)) 573 ((= com ?Y) 574 (save-excursion 575 (set-mark vip-com-point) 576 (vip-enlarge-region (mark) (point)) 577 (if vip-use-register 578 (progn 579 (cond ((and (<= ?a vip-use-register) 580 (<= vip-use-register ?z)) 581 (copy-to-register 582 vip-use-register (mark) (point) nil)) 583 ((and (<= ?A vip-use-register) 584 (<= vip-use-register ?Z)) 585 (vip-append-to-register 586 (+ vip-use-register 32) (mark) (point))) 587 (t (setq vip-use-register nil) 588 (error ""))) 589 (setq vip-use-register nil))) 590 (setq last-command nil) 591 (copy-region-as-kill (mark) (point))) 592 (goto-char vip-com-point)) 593 ((or (= com ?!) (= com (- ?!))) 594 (save-excursion 595 (set-mark vip-com-point) 596 (vip-enlarge-region (mark) (point)) 597 (shell-command-on-region 598 (mark) (point) 599 (if (= com ?!) 600 (setq vip-last-shell-com (vip-read-string "!")) 601 vip-last-shell-com) 602 t))) 603 ((= com ?=) 604 (save-excursion 605 (set-mark vip-com-point) 606 (vip-enlarge-region (mark) (point)) 607 (if (> (mark) (point)) (exchange-point-and-mark)) 608 (indent-region (mark) (point) nil))) 609 ((= com ?<) 610 (save-excursion 611 (set-mark vip-com-point) 612 (vip-enlarge-region (mark) (point)) 613 (indent-rigidly (mark) (point) (- vip-shift-width))) 614 (goto-char vip-com-point)) 615 ((= com ?>) 616 (save-excursion 617 (set-mark vip-com-point) 618 (vip-enlarge-region (mark) (point)) 619 (indent-rigidly (mark) (point) vip-shift-width)) 620 (goto-char vip-com-point)) 621 ((>= com 128) 622 ;; this is special command # 623 (vip-special-prefix-com (- com 128))))) 624 (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!)) 625 (- com) com) 626 reg)))) 627 628(defun vip-repeat (arg) 629 "(ARG) Re-execute last destructive command. vip-d-com has the form 630\(COM ARG CH REG), where COM is the command to be re-executed, ARG is the 631argument for COM, CH is a flag for repeat, and REG is optional and if exists 632is the name of the register for COM." 633 (interactive "P") 634 (if (eq last-command 'vip-undo) 635 ;; if the last command was vip-undo, then undo-more 636 (vip-undo-more) 637 ;; otherwise execute the command stored in vip-d-com. if arg is non-nil 638 ;; its prefix value is used as new prefix value for the command. 639 (let ((m-com (car vip-d-com)) 640 (val (vip-P-val arg)) 641 (com (car (cdr (cdr vip-d-com)))) 642 (reg (nth 3 vip-d-com))) 643 (if (null val) (setq val (car (cdr vip-d-com)))) 644 (if (null m-com) (error "No previous command to repeat.")) 645 (setq vip-use-register reg) 646 (funcall m-com (cons val com))))) 647 648(defun vip-special-prefix-com (char) 649 "This command is invoked interactively by the key sequence #<char>" 650 (cond ((= char ?c) 651 (downcase-region (min vip-com-point (point)) 652 (max vip-com-point (point)))) 653 ((= char ?C) 654 (upcase-region (min vip-com-point (point)) 655 (max vip-com-point (point)))) 656 ((= char ?g) 657 (set-mark vip-com-point) 658 (vip-global-execute)) 659 ((= char ?q) 660 (set-mark vip-com-point) 661 (vip-quote-region)) 662 ((= char ?s) (spell-region vip-com-point (point))))) 663 664 665;; undoing 666 667(defun vip-undo () 668 "Undo previous change." 669 (interactive) 670 (message "undo!") 671 (undo-start) 672 (undo-more 2) 673 (setq this-command 'vip-undo)) 674 675(defun vip-undo-more () 676 "Continue undoing previous changes." 677 (message "undo more!") 678 (undo-more 1) 679 (setq this-command 'vip-undo)) 680 681 682;; utilities 683 684(defun vip-string-tail (str) 685 (if (or (null str) (string= str "")) nil 686 (substring str 1))) 687 688(defun vip-yank-defun () 689 (mark-defun) 690 (copy-region-as-kill (point) (mark))) 691 692(defun vip-enlarge-region (beg end) 693 "Enlarge region between BEG and END." 694 (if (< beg end) 695 (progn (goto-char beg) (set-mark end)) 696 (goto-char end) 697 (set-mark beg)) 698 (beginning-of-line) 699 (exchange-point-and-mark) 700 (if (or (not (eobp)) (not (bolp))) (next-line 1)) 701 (beginning-of-line) 702 (if (> beg end) (exchange-point-and-mark))) 703 704(defun vip-global-execute () 705 "Call last keyboad macro for each line in the region." 706 (if (> (point) (mark)) (exchange-point-and-mark)) 707 (beginning-of-line) 708 (call-last-kbd-macro) 709 (while (< (point) (mark)) 710 (forward-line 1) 711 (beginning-of-line) 712 (call-last-kbd-macro))) 713 714(defun vip-quote-region () 715 "Quote region by inserting the user supplied string at the beginning of 716each line in the region." 717 (setq vip-quote-string 718 (let ((str 719 (vip-read-string (format "quote string \(default \"%s\"\): " 720 vip-quote-string)))) 721 (if (string= str "") vip-quote-string str))) 722 (vip-enlarge-region (point) (mark)) 723 (if (> (point) (mark)) (exchange-point-and-mark)) 724 (insert vip-quote-string) 725 (beginning-of-line) 726 (forward-line 1) 727 (while (and (< (point) (mark)) (bolp)) 728 (insert vip-quote-string) 729 (beginning-of-line) 730 (forward-line 1))) 731 732(defun vip-end-with-a-newline-p (string) 733 "Check if the string ends with a newline." 734 (or (string= text "") 735 (= (aref string (1- (length string))) ?\n))) 736 737(defun vip-read-string (prompt &optional init) 738 (setq save-minibuffer-local-map (copy-keymap minibuffer-local-map)) 739 (define-key minibuffer-local-map "\C-h" 'backward-char) 740 (define-key minibuffer-local-map "\C-w" 'backward-word) 741 (define-key minibuffer-local-map "\e" 'exit-minibuffer) 742 (let (str) 743 (condition-case conditions 744 (setq str (read-string prompt init)) 745 (quit 746 (setq minibuffer-local-map save-minibuffer-local-map) 747 (signal 'quit nil))) 748 (setq minibuffer-local-map save-minibuffer-local-map) 749 str)) 750 751 752;; insertion commands 753 754(defun vip-repeat-insert-command () 755 "This function is called when mode changes from insertion mode to 756vi command mode. It will repeat the insertion command if original insertion 757command was invoked with argument > 1." 758 (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com)))) 759 (if (and val (> val 1)) ;; first check that val is non-nil 760 (progn 761 (setq vip-d-com (list i-com (1- val) ?r)) 762 (vip-repeat nil) 763 (setq vip-d-com (list i-com val ?r)))))) 764 765(defun vip-insert (arg) "" 766 (interactive "P") 767 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 768 (setq vip-d-com (list 'vip-insert val ?r)) 769 (if com (vip-loop val (yank)) 770 (vip-change-mode-to-insert)))) 771 772(defun vip-append (arg) 773 "Append after point." 774 (interactive "P") 775 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 776 (setq vip-d-com (list 'vip-append val ?r)) 777 (if (not (eolp)) (forward-char)) 778 (if (equal com ?r) 779 (vip-loop val (yank)) 780 (vip-change-mode-to-insert)))) 781 782(defun vip-Append (arg) 783 "Append at end of line." 784 (interactive "P") 785 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 786 (setq vip-d-com (list 'vip-Append val ?r)) 787 (end-of-line) 788 (if (equal com ?r) 789 (vip-loop val (yank)) 790 (vip-change-mode-to-insert)))) 791 792(defun vip-Insert (arg) 793 "Insert before first non-white." 794 (interactive "P") 795 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 796 (setq vip-d-com (list 'vip-Insert val ?r)) 797 (back-to-indentation) 798 (if (equal com ?r) 799 (vip-loop val (yank)) 800 (vip-change-mode-to-insert)))) 801 802(defun vip-open-line (arg) 803 "Open line below." 804 (interactive "P") 805 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 806 (setq vip-d-com (list 'vip-open-line val ?r)) 807 (let ((col (current-indentation))) 808 (if (equal com ?r) 809 (vip-loop val 810 (progn 811 (end-of-line) 812 (newline 1) 813 (if vip-open-with-indent (indent-to col)) 814 (yank))) 815 (end-of-line) 816 (newline 1) 817 (if vip-open-with-indent (indent-to col)) 818 (vip-change-mode-to-insert))))) 819 820(defun vip-Open-line (arg) 821 "Open line above." 822 (interactive "P") 823 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 824 (setq vip-d-com (list 'vip-Open-line val ?r)) 825 (let ((col (current-indentation))) 826 (if (equal com ?r) 827 (vip-loop val 828 (progn 829 (beginning-of-line) 830 (open-line 1) 831 (if vip-open-with-indent (indent-to col)) 832 (yank))) 833 (beginning-of-line) 834 (open-line 1) 835 (if vip-open-with-indent (indent-to col)) 836 (vip-change-mode-to-insert))))) 837 838(defun vip-open-line-at-point (arg) 839 "Open line at point." 840 (interactive "P") 841 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 842 (setq vip-d-com (list 'vip-open-line-at-point val ?r)) 843 (if (equal com ?r) 844 (vip-loop val 845 (progn 846 (open-line 1) 847 (yank))) 848 (open-line 1) 849 (vip-change-mode-to-insert)))) 850 851(defun vip-substitute (arg) 852 "Substitute characters." 853 (interactive "P") 854 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 855 (save-excursion 856 (set-mark (point)) 857 (forward-char val) 858 (if (equal com ?r) 859 (vip-change-subr (mark) (point)) 860 (vip-change (mark) (point)))) 861 (setq vip-d-com (list 'vip-substitute val ?r)))) 862 863(defun vip-substitute-line (arg) 864 "Substitute lines." 865 (interactive "p") 866 (vip-line (cons arg ?C))) 867 868 869;; line command 870 871(defun vip-line (arg) 872 (let ((val (car arg)) (com (cdr arg))) 873 (move-marker vip-com-point (point)) 874 (next-line (1- val)) 875 (vip-execute-com 'vip-line val com))) 876 877(defun vip-yank-line (arg) 878 "Yank ARG lines (in vi's sense)" 879 (interactive "P") 880 (let ((val (vip-p-val arg))) 881 (vip-line (cons val ?Y)))) 882 883 884;; region command 885 886(defun vip-region (arg) 887 (interactive "P") 888 (let ((val (vip-P-val arg)) 889 (com (vip-getcom arg))) 890 (move-marker vip-com-point (point)) 891 (exchange-point-and-mark) 892 (vip-execute-com 'vip-region val com))) 893 894(defun vip-Region (arg) 895 (interactive "P") 896 (let ((val (vip-P-val arg)) 897 (com (vip-getCom arg))) 898 (move-marker vip-com-point (point)) 899 (exchange-point-and-mark) 900 (vip-execute-com 'vip-Region val com))) 901 902(defun vip-replace-char (arg) 903 "Replace the following ARG chars by the character read." 904 (interactive "P") 905 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 906 (setq vip-d-com (list 'vip-replace-char val ?r)) 907 (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val))) 908 909(defun vip-replace-char-subr (char arg) 910 (delete-char arg t) 911 (setq vip-d-char char) 912 (vip-loop (if (> arg 0) arg (- arg)) (insert char)) 913 (backward-char arg)) 914 915(defun vip-replace-string () 916 "Replace string. If you supply null string as the string to be replaced, 917the query replace mode will toggle between string replace and regexp replace." 918 (interactive) 919 (let (str) 920 (setq str (vip-read-string 921 (if vip-re-replace "Replace regexp: " "Replace string: "))) 922 (if (string= str "") 923 (progn 924 (setq vip-re-replace (not vip-re-replace)) 925 (message (format "Replace mode changed to %s." 926 (if vip-re-replace "regexp replace" 927 "string replace")))) 928 (if vip-re-replace 929 ;; (replace-regexp 930 ;; str 931 ;; (vip-read-string (format "Replace regexp \"%s\" with: " str))) 932 (while (re-search-forward str nil t) 933 (replace-match (vip-read-string 934 (format "Replace regexp \"%s\" with: " str)) 935 nil nil)) 936 (replace-string 937 str 938 (vip-read-string (format "Replace \"%s\" with: " str))))))) 939 940 941;; basic cursor movement. j, k, l, m commands. 942 943(defun vip-forward-char (arg) 944 "Move point right ARG characters (left if ARG negative).On reaching end 945of buffer, stop and signal error." 946 (interactive "P") 947 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 948 (if com (move-marker vip-com-point (point))) 949 (forward-char val) 950 (if com (vip-execute-com 'vip-forward-char val com)))) 951 952(defun vip-backward-char (arg) 953 "Move point left ARG characters (right if ARG negative). On reaching 954beginning of buffer, stop and signal error." 955 (interactive "P") 956 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 957 (if com (move-marker vip-com-point (point))) 958 (backward-char val) 959 (if com (vip-execute-com 'vip-backward-char val com)))) 960 961 962;; word command 963 964(defun vip-forward-word (arg) 965 "Forward word." 966 (interactive "P") 967 (let ((val (vip-p-val arg)) 968 (com (vip-getcom arg))) 969 (if com (move-marker vip-com-point (point))) 970 (forward-word val) 971 (skip-chars-forward " \t\n") 972 (if com 973 (progn 974 (if (or (= com ?c) (= com (- ?c))) 975 (progn (backward-word 1) (forward-word 1))) 976 (if (or (= com ?d) (= com ?y)) 977 (progn 978 (backward-word 1) 979 (forward-word 1) 980 (skip-chars-forward " \t"))) 981 (vip-execute-com 'vip-forward-word val com))))) 982 983(defun vip-end-of-word (arg) 984 "Move point to end of current word." 985 (interactive "P") 986 (let ((val (vip-p-val arg)) 987 (com (vip-getcom arg))) 988 (if com (move-marker vip-com-point (point))) 989 (forward-char) 990 (forward-word val) 991 (backward-char) 992 (if com 993 (progn 994 (forward-char) 995 (vip-execute-com 'vip-end-of-word val com))))) 996 997(defun vip-backward-word (arg) 998 "Backward word." 999 (interactive "P") 1000 (let ((val (vip-p-val arg)) 1001 (com (vip-getcom arg))) 1002 (if com (move-marker vip-com-point (point))) 1003 (backward-word val) 1004 (if com (vip-execute-com 'vip-backward-word val com)))) 1005 1006(defun vip-forward-Word (arg) 1007 "Forward word delimited by white character." 1008 (interactive "P") 1009 (let ((val (vip-p-val arg)) 1010 (com (vip-getcom arg))) 1011 (if com (move-marker vip-com-point (point))) 1012 (re-search-forward "[^ \t\n]*[ \t\n]+" nil t val) 1013 (if com 1014 (progn 1015 (if (or (= com ?c) (= com (- ?c))) 1016 (progn (backward-word 1) (forward-word 1))) 1017 (if (or (= com ?d) (= com ?y)) 1018 (progn 1019 (backward-word 1) 1020 (forward-word 1) 1021 (skip-chars-forward " \t"))) 1022 (vip-execute-com 'vip-forward-Word val com))))) 1023 1024(defun vip-end-of-Word (arg) 1025 "Move forward to end of word delimited by white character." 1026 (interactive "P") 1027 (let ((val (vip-p-val arg)) 1028 (com (vip-getcom arg))) 1029 (if com (move-marker vip-com-point (point))) 1030 (forward-char) 1031 (if (re-search-forward "[^ \t\n]+" nil t val) (backward-char)) 1032 (if com 1033 (progn 1034 (forward-char) 1035 (vip-execute-com 'vip-end-of-Word val com))))) 1036 1037(defun vip-backward-Word (arg) 1038 "Backward word delimited by white character." 1039 (interactive "P") 1040 (let ((val (vip-p-val arg)) 1041 (com (vip-getcom arg))) 1042 (if com (move-marker vip-com-point (point))) 1043 (if (re-search-backward "[ \t\n]+[^ \t\n]+" nil t val) 1044 (forward-char) 1045 (goto-char (point-min))) 1046 (if com (vip-execute-com 'vip-backward-Word val com)))) 1047 1048(defun vip-beginning-of-line (arg) 1049 "Go to beginning of line." 1050 (interactive "P") 1051 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1052 (if com (move-marker vip-com-point (point))) 1053 (beginning-of-line val) 1054 (if com (vip-execute-com 'vip-beginning-of-line val com)))) 1055 1056(defun vip-bol-and-skip-white (arg) 1057 "Beginning of line at first non-white character." 1058 (interactive "P") 1059 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1060 (if com (move-marker vip-com-point (point))) 1061 (back-to-indentation) 1062 (if com (vip-execute-com 'vip-bol-and-skip-white val com)))) 1063 1064(defun vip-goto-eol (arg) 1065 "Go to end of line." 1066 (interactive "P") 1067 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1068 (if com (move-marker vip-com-point (point))) 1069 (end-of-line val) 1070 (if com (vip-execute-com 'vip-goto-eol val com)))) 1071 1072(defun vip-next-line (arg) 1073 "Go to next line." 1074 (interactive "P") 1075 (let ((val (vip-p-val arg)) (com (vip-getCom arg))) 1076 (if com (move-marker vip-com-point (point))) 1077 (line-move val) 1078 (setq this-command 'next-line) 1079 (if com (vip-execute-com 'vip-next-line val com)))) 1080 1081(defun vip-next-line-at-bol (arg) 1082 "Next line at beginning of line." 1083 (interactive "P") 1084 (let ((val (vip-p-val arg)) (com (vip-getCom arg))) 1085 (if com (move-marker vip-com-point (point))) 1086 (next-line val) 1087 (back-to-indentation) 1088 (if com (vip-execute-com 'vip-next-line-at-bol val com)))) 1089 1090(defun vip-previous-line (arg) 1091 "Go to previous line." 1092 (interactive "P") 1093 (let ((val (vip-p-val arg)) (com (vip-getCom arg))) 1094 (if com (move-marker vip-com-point (point))) 1095 (next-line (- val)) 1096 (setq this-command 'previous-line) 1097 (if com (vip-execute-com 'vip-previous-line val com)))) 1098 1099(defun vip-previous-line-at-bol (arg) 1100 "Previous line at beginning of line." 1101 (interactive "P") 1102 (let ((val (vip-p-val arg)) (com (vip-getCom arg))) 1103 (if com (move-marker vip-com-point (point))) 1104 (next-line (- val)) 1105 (back-to-indentation) 1106 (if com (vip-execute-com 'vip-previous-line val com)))) 1107 1108(defun vip-change-to-eol (arg) 1109 "Change to end of line." 1110 (interactive "P") 1111 (vip-goto-eol (cons arg ?c))) 1112 1113(defun vip-kill-line (arg) 1114 "Delete line." 1115 (interactive "P") 1116 (vip-goto-eol (cons arg ?d))) 1117 1118 1119;; moving around 1120 1121(defun vip-goto-line (arg) 1122 "Go to ARG's line. Without ARG go to end of buffer." 1123 (interactive "P") 1124 (let ((val (vip-P-val arg)) (com (vip-getCom arg))) 1125 (move-marker vip-com-point (point)) 1126 (set-mark (point)) 1127 (if (null val) 1128 (goto-char (point-max)) 1129 (goto-char (point-min)) 1130 (forward-line (1- val))) 1131 (back-to-indentation) 1132 (if com (vip-execute-com 'vip-goto-line val com)))) 1133 1134(defun vip-find-char (arg char forward offset) 1135 "Find ARG's occurrence of CHAR on the current line. If FORWARD then 1136search is forward, otherwise backward. OFFSET is used to adjust point 1137after search." 1138 (let ((arg (if forward arg (- arg))) point) 1139 (save-excursion 1140 (save-restriction 1141 (if (> arg 0) 1142 (narrow-to-region 1143 ;; forward search begins here 1144 (if (eolp) (error "") (point)) 1145 ;; forward search ends here 1146 (progn (next-line 1) (beginning-of-line) (point))) 1147 (narrow-to-region 1148 ;; backward search begins from here 1149 (if (bolp) (error "") (point)) 1150 ;; backward search ends here 1151 (progn (beginning-of-line) (point)))) 1152 ;; if arg > 0, point is forwarded before search. 1153 (if (> arg 0) (goto-char (1+ (point-min))) 1154 (goto-char (point-max))) 1155 (let ((case-fold-search nil)) 1156 (search-forward (char-to-string char) nil 0 arg)) 1157 (setq point (point)) 1158 (if (or (and (> arg 0) (= point (point-max))) 1159 (and (< arg 0) (= point (point-min)))) 1160 (error "")))) 1161 (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0)))))) 1162 1163(defun vip-find-char-forward (arg) 1164 "Find char on the line. If called interactively read the char to find 1165from the terminal, and if called from vip-repeat, the char last used is 1166used. This behaviour is controlled by the sign of prefix numeric value." 1167 (interactive "P") 1168 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1169 (if (> val 0) 1170 ;; this means that the function was called interactively 1171 (setq vip-f-char (read-char) 1172 vip-f-forward t 1173 vip-f-offset nil) 1174 (setq val (- val))) 1175 (if com (move-marker vip-com-point (point))) 1176 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil) 1177 (setq val (- val)) 1178 (if com 1179 (progn 1180 (setq vip-F-char vip-f-char);; set new vip-F-char 1181 (forward-char) 1182 (vip-execute-com 'vip-find-char-forward val com))))) 1183 1184(defun vip-goto-char-forward (arg) 1185 "Go up to char ARG forward on line." 1186 (interactive "P") 1187 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1188 (if (> val 0) 1189 ;; this means that the function was called interactively 1190 (setq vip-f-char (read-char) 1191 vip-f-forward t 1192 vip-f-offset t) 1193 (setq val (- val))) 1194 (if com (move-marker vip-com-point (point))) 1195 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t) 1196 (setq val (- val)) 1197 (if com 1198 (progn 1199 (setq vip-F-char vip-f-char);; set new vip-F-char 1200 (forward-char) 1201 (vip-execute-com 'vip-goto-char-forward val com))))) 1202 1203(defun vip-find-char-backward (arg) 1204 "Find char ARG on line backward." 1205 (interactive "P") 1206 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1207 (if (> val 0) 1208 ;; this means that the function was called interactively 1209 (setq vip-f-char (read-char) 1210 vip-f-forward nil 1211 vip-f-offset nil) 1212 (setq val (- val))) 1213 (if com (move-marker vip-com-point (point))) 1214 (vip-find-char 1215 val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil) 1216 (setq val (- val)) 1217 (if com 1218 (progn 1219 (setq vip-F-char vip-f-char);; set new vip-F-char 1220 (vip-execute-com 'vip-find-char-backward val com))))) 1221 1222(defun vip-goto-char-backward (arg) 1223 "Go up to char ARG backward on line." 1224 (interactive "P") 1225 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1226 (if (> val 0) 1227 ;; this means that the function was called interactively 1228 (setq vip-f-char (read-char) 1229 vip-f-forward nil 1230 vip-f-offset t) 1231 (setq val (- val))) 1232 (if com (move-marker vip-com-point (point))) 1233 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t) 1234 (setq val (- val)) 1235 (if com 1236 (progn 1237 (setq vip-F-char vip-f-char);; set new vip-F-char 1238 (vip-execute-com 'vip-goto-char-backward val com))))) 1239 1240(defun vip-repeat-find (arg) 1241 "Repeat previous find command." 1242 (interactive "P") 1243 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1244 (if com (move-marker vip-com-point (point))) 1245 (vip-find-char val vip-f-char vip-f-forward vip-f-offset) 1246 (if com 1247 (progn 1248 (if vip-f-forward (forward-char)) 1249 (vip-execute-com 'vip-repeat-find val com))))) 1250 1251(defun vip-repeat-find-opposite (arg) 1252 "Repeat previous find command in the opposite direction." 1253 (interactive "P") 1254 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1255 (if com (move-marker vip-com-point (point))) 1256 (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset) 1257 (if com 1258 (progn 1259 (if vip-f-forward (forward-char)) 1260 (vip-execute-com 'vip-repeat-find-opposite val com))))) 1261 1262 1263;; window scrolling etc. 1264 1265(defun vip-other-window (arg) 1266 "Switch to other window." 1267 (interactive "p") 1268 (other-window arg) 1269 (or (not (eq vip-current-mode 'emacs-mode)) 1270 (string= (buffer-name (current-buffer)) " *Minibuf-1*") 1271 (vip-change-mode-to-vi))) 1272 1273(defun vip-window-top (arg) 1274 "Go to home window line." 1275 (interactive "P") 1276 (let ((val (vip-p-val arg)) 1277 (com (vip-getCom arg))) 1278 (if com (move-marker vip-com-point (point))) 1279 (move-to-window-line (1- val)) 1280 (if com (vip-execute-com 'vip-window-top val com)))) 1281 1282(defun vip-window-middle (arg) 1283 "Go to middle window line." 1284 (interactive "P") 1285 (let ((val (vip-p-val arg)) 1286 (com (vip-getCom arg))) 1287 (if com (move-marker vip-com-point (point))) 1288 (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val))) 1289 (if com (vip-execute-com 'vip-window-middle val com)))) 1290 1291(defun vip-window-bottom (arg) 1292 "Go to last window line." 1293 (interactive "P") 1294 (let ((val (vip-p-val arg)) 1295 (com (vip-getCom arg))) 1296 (if com (move-marker vip-com-point (point))) 1297 (move-to-window-line (- val)) 1298 (if com (vip-execute-com 'vip-window-bottom val com)))) 1299 1300(defun vip-line-to-top (arg) 1301 "Put current line on the home line." 1302 (interactive "p") 1303 (recenter (1- arg))) 1304 1305(defun vip-line-to-middle (arg) 1306 "Put current line on the middle line." 1307 (interactive "p") 1308 (recenter (+ (1- arg) (/ (1- (window-height)) 2)))) 1309 1310(defun vip-line-to-bottom (arg) 1311 "Put current line on the last line." 1312 (interactive "p") 1313 (recenter (- (window-height) (1+ arg)))) 1314 1315 1316;; paren match 1317 1318(defun vip-paren-match (arg) 1319 "Go to the matching parenthesis." 1320 (interactive "P") 1321 (let ((com (vip-getcom arg))) 1322 (if (numberp arg) 1323 (if (or (> arg 99) (< arg 1)) 1324 (error "Prefix must be between 1 and 99.") 1325 (goto-char 1326 (if (> (point-max) 80000) 1327 (* (/ (point-max) 100) arg) 1328 (/ (* (point-max) arg) 100))) 1329 (back-to-indentation)) 1330 (cond ((looking-at "[\(\[{]") 1331 (if com (move-marker vip-com-point (point))) 1332 (forward-sexp 1) 1333 (if com 1334 (vip-execute-com 'vip-paren-match nil com) 1335 (backward-char))) 1336 ((looking-at "[])}]") 1337 (forward-char) 1338 (if com (move-marker vip-com-point (point))) 1339 (backward-sexp 1) 1340 (if com (vip-execute-com 'vip-paren-match nil com))) 1341 (t (error "")))))) 1342 1343 1344;; sentence and paragraph 1345 1346(defun vip-forward-sentence (arg) 1347 "Forward sentence." 1348 (interactive "P") 1349 (let ((val (vip-p-val arg)) 1350 (com (vip-getcom arg))) 1351 (if com (move-marker vip-com-point (point))) 1352 (forward-sentence val) 1353 (if com (vip-execute-com 'vip-forward-sentence nil com)))) 1354 1355(defun vip-backward-sentence (arg) 1356 "Backward sentence." 1357 (interactive "P") 1358 (let ((val (vip-p-val arg)) 1359 (com (vip-getcom arg))) 1360 (if com (move-marker vip-com-point (point))) 1361 (backward-sentence val) 1362 (if com (vip-execute-com 'vip-backward-sentence nil com)))) 1363 1364(defun vip-forward-paragraph (arg) 1365 "Forward paragraph." 1366 (interactive "P") 1367 (let ((val (vip-p-val arg)) 1368 (com (vip-getCom arg))) 1369 (if com (move-marker vip-com-point (point))) 1370 (forward-paragraph val) 1371 (if com (vip-execute-com 'vip-forward-paragraph nil com)))) 1372 1373(defun vip-backward-paragraph (arg) 1374 "Backward paragraph." 1375 (interactive "P") 1376 (let ((val (vip-p-val arg)) 1377 (com (vip-getCom arg))) 1378 (if com (move-marker vip-com-point (point))) 1379 (backward-paragraph val) 1380 (if com (vip-execute-com 'vip-backward-paragraph nil com)))) 1381 1382 1383;; scrolling 1384 1385(defun vip-scroll (arg) 1386 "Scroll to next screen." 1387 (interactive "p") 1388 (if (> arg 0) 1389 (while (> arg 0) 1390 (scroll-up) 1391 (setq arg (1- arg))) 1392 (while (> 0 arg) 1393 (scroll-down) 1394 (setq arg (1+ arg))))) 1395 1396(defun vip-scroll-back (arg) 1397 "Scroll to previous screen." 1398 (interactive "p") 1399 (vip-scroll (- arg))) 1400 1401(defun vip-scroll-down (arg) 1402 "Scroll up half screen." 1403 (interactive "P") 1404 (if (null arg) (scroll-down (/ (window-height) 2)) 1405 (scroll-down arg))) 1406 1407(defun vip-scroll-down-one (arg) 1408 "Scroll up one line." 1409 (interactive "p") 1410 (scroll-down arg)) 1411 1412(defun vip-scroll-up (arg) 1413 "Scroll down half screen." 1414 (interactive "P") 1415 (if (null arg) (scroll-up (/ (window-height) 2)) 1416 (scroll-up arg))) 1417 1418(defun vip-scroll-up-one (arg) 1419 "Scroll down one line." 1420 (interactive "p") 1421 (scroll-up arg)) 1422 1423 1424;; splitting window 1425 1426(defun vip-buffer-in-two-windows () 1427 "Show current buffer in two windows." 1428 (interactive) 1429 (delete-other-windows) 1430 (split-window-vertically nil)) 1431 1432 1433;; searching 1434 1435(defun vip-search-forward (arg) 1436 "Search a string forward. ARG is used to find the ARG's occurrence 1437of the string. Default is vanilla search. Search mode can be toggled by 1438giving null search string." 1439 (interactive "P") 1440 (let ((val (vip-P-val arg)) (com (vip-getcom arg))) 1441 (setq vip-s-forward t 1442 vip-s-string (vip-read-string (if vip-re-search "RE-/" "/"))) 1443 (if (string= vip-s-string "") 1444 (progn 1445 (setq vip-re-search (not vip-re-search)) 1446 (message (format "Search mode changed to %s search." 1447 (if vip-re-search "regular expression" 1448 "vanilla")))) 1449 (vip-search vip-s-string t val) 1450 (if com 1451 (progn 1452 (move-marker vip-com-point (mark)) 1453 (vip-execute-com 'vip-search-next val com)))))) 1454 1455(defun vip-search-backward (arg) 1456 "Search a string backward. ARG is used to find the ARG's occurrence 1457of the string. Default is vanilla search. Search mode can be toggled by 1458giving null search string." 1459 (interactive "P") 1460 (let ((val (vip-P-val arg)) (com (vip-getcom arg))) 1461 (setq vip-s-forward nil 1462 vip-s-string (vip-read-string (if vip-re-search "RE-?" "?"))) 1463 (if (string= vip-s-string "") 1464 (progn 1465 (setq vip-re-search (not vip-re-search)) 1466 (message (format "Search mode changed to %s search." 1467 (if vip-re-search "regular expression" 1468 "vanilla")))) 1469 (vip-search vip-s-string nil val) 1470 (if com 1471 (progn 1472 (move-marker vip-com-point (mark)) 1473 (vip-execute-com 'vip-search-next val com)))))) 1474 1475(defun vip-search (string forward arg &optional no-offset init-point) 1476 "(STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of 1477STRING. Search will be forward if FORWARD, otherwise backward." 1478 (let ((val (vip-p-val arg)) (com (vip-getcom arg)) 1479 (null-arg (null (vip-P-val arg))) (offset (not no-offset)) 1480 (case-fold-search vip-case-fold-search) 1481 (start-point (or init-point (point)))) 1482 (if forward 1483 (condition-case conditions 1484 (progn 1485 (if (and offset (not (eobp))) (forward-char)) 1486 (if vip-re-search 1487 (progn 1488 (re-search-forward string nil nil val) 1489 (re-search-backward string)) 1490 (search-forward string nil nil val) 1491 (search-backward string)) 1492 (push-mark start-point)) 1493 (search-failed 1494 (if (and null-arg vip-search-wrap-around) 1495 (progn 1496 (goto-char (point-min)) 1497 (vip-search string forward (cons 1 com) t start-point)) 1498 (goto-char start-point) 1499 (signal 'search-failed (cdr conditions))))) 1500 (condition-case conditions 1501 (progn 1502 (if vip-re-search 1503 (re-search-backward string nil nil val) 1504 (search-backward string nil nil val)) 1505 (push-mark start-point)) 1506 (search-failed 1507 (if (and null-arg vip-search-wrap-around) 1508 (progn 1509 (goto-char (point-max)) 1510 (vip-search string forward (cons 1 com) t start-point)) 1511 (goto-char start-point) 1512 (signal 'search-failed (cdr conditions)))))))) 1513 1514(defun vip-search-next (arg) 1515 "Repeat previous search." 1516 (interactive "P") 1517 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1518 (if (null vip-s-string) (error "No previous search string.")) 1519 (vip-search vip-s-string vip-s-forward arg) 1520 (if com (vip-execute-com 'vip-search-next val com)))) 1521 1522(defun vip-search-Next (arg) 1523 "Repeat previous search in the reverse direction." 1524 (interactive "P") 1525 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1526 (if (null vip-s-string) (error "No previous search string.")) 1527 (vip-search vip-s-string (not vip-s-forward) arg) 1528 (if com (vip-execute-com 'vip-search-Next val com)))) 1529 1530 1531;; visiting and killing files, buffers 1532 1533(defun vip-switch-to-buffer () 1534 "Switch to buffer in the current window." 1535 (interactive) 1536 (let (buffer) 1537 (setq buffer 1538 (read-buffer 1539 (format "switch to buffer \(%s\): " 1540 (buffer-name (other-buffer (current-buffer)))))) 1541 (switch-to-buffer buffer) 1542 (vip-change-mode-to-vi))) 1543 1544(defun vip-switch-to-buffer-other-window () 1545 "Switch to buffer in another window." 1546 (interactive) 1547 (let (buffer) 1548 (setq buffer 1549 (read-buffer 1550 (format "Switch to buffer \(%s\): " 1551 (buffer-name (other-buffer (current-buffer)))))) 1552 (switch-to-buffer-other-window buffer) 1553 (vip-change-mode-to-vi))) 1554 1555(defun vip-kill-buffer () 1556 "Kill a buffer." 1557 (interactive) 1558 (let (buffer buffer-name) 1559 (setq buffer-name 1560 (read-buffer 1561 (format "Kill buffer \(%s\): " 1562 (buffer-name (current-buffer))))) 1563 (setq buffer 1564 (if (null buffer-name) 1565 (current-buffer) 1566 (get-buffer buffer-name))) 1567 (if (null buffer) (error "Buffer %s nonexistent." buffer-name)) 1568 (if (or (not (buffer-modified-p buffer)) 1569 (y-or-n-p "Buffer is modified, are you sure? ")) 1570 (kill-buffer buffer) 1571 (error "Buffer not killed.")))) 1572 1573(defun vip-find-file () 1574 "Visit file in the current window." 1575 (interactive) 1576 (let (file) 1577 (setq file (read-file-name "visit file: ")) 1578 (switch-to-buffer (find-file-noselect file)) 1579 (vip-change-mode-to-vi))) 1580 1581(defun vip-find-file-other-window () 1582 "Visit file in another window." 1583 (interactive) 1584 (let (file) 1585 (setq file (read-file-name "Visit file: ")) 1586 (switch-to-buffer-other-window (find-file-noselect file)) 1587 (vip-change-mode-to-vi))) 1588 1589(defun vip-info-on-file () 1590 "Give information of the file associated to the current buffer." 1591 (interactive) 1592 (message "\"%s\" line %d of %d" 1593 (if (buffer-file-name) (buffer-file-name) "") 1594 (1+ (count-lines (point-min) (point))) 1595 (1+ (count-lines (point-min) (point-max))))) 1596 1597 1598;; yank and pop 1599 1600(defun vip-yank (text) 1601 "yank TEXT silently." 1602 (save-excursion 1603 (vip-push-mark-silent (point)) 1604 (insert text) 1605 (exchange-point-and-mark)) 1606 (skip-chars-forward " \t")) 1607 1608(defun vip-put-back (arg) 1609 "Put back after point/below line." 1610 (interactive "P") 1611 (let ((val (vip-p-val arg)) 1612 (text (if vip-use-register 1613 (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) 1614 (current-kill (- vip-use-register ?1) 'do-not-rotate) 1615 (get-register vip-use-register)) 1616 (current-kill 0)))) 1617 (if (null text) 1618 (if vip-use-register 1619 (let ((reg vip-use-register)) 1620 (setq vip-use-register nil) 1621 (error "Nothing in register %c" reg)) 1622 (error ""))) 1623 (setq vip-use-register nil) 1624 (if (vip-end-with-a-newline-p text) 1625 (progn 1626 (next-line 1) 1627 (beginning-of-line)) 1628 (if (and (not (eolp)) (not (eobp))) (forward-char))) 1629 (setq vip-d-com (list 'vip-put-back val nil vip-use-register)) 1630 (vip-loop val (vip-yank text)))) 1631 1632(defun vip-Put-back (arg) 1633 "Put back at point/above line." 1634 (interactive "P") 1635 (let ((val (vip-p-val arg)) 1636 (text (if vip-use-register 1637 (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) 1638 (current-kill (- vip-use-register ?1) 'do-not-rotate) 1639 (get-register vip-use-register)) 1640 (current-kill 0)))) 1641 (if (null text) 1642 (if vip-use-register 1643 (let ((reg vip-use-register)) 1644 (setq vip-use-register nil) 1645 (error "Nothing in register %c" reg)) 1646 (error ""))) 1647 (setq vip-use-register nil) 1648 (if (vip-end-with-a-newline-p text) (beginning-of-line)) 1649 (setq vip-d-com (list 'vip-Put-back val nil vip-use-register)) 1650 (vip-loop val (vip-yank text)))) 1651 1652(defun vip-delete-char (arg) 1653 "Delete character." 1654 (interactive "P") 1655 (let ((val (vip-p-val arg))) 1656 (setq vip-d-com (list 'vip-delete-char val nil)) 1657 (if vip-use-register 1658 (progn 1659 (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) 1660 (vip-append-to-register 1661 (+ vip-use-register 32) (point) (- (point) val)) 1662 (copy-to-register vip-use-register (point) (- (point) val) nil)) 1663 (setq vip-use-register nil))) 1664 (delete-char val t))) 1665 1666(defun vip-delete-backward-char (arg) 1667 "Delete previous character." 1668 (interactive "P") 1669 (let ((val (vip-p-val arg))) 1670 (setq vip-d-com (list 'vip-delete-backward-char val nil)) 1671 (if vip-use-register 1672 (progn 1673 (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) 1674 (vip-append-to-register 1675 (+ vip-use-register 32) (point) (+ (point) val)) 1676 (copy-to-register vip-use-register (point) (+ (point) val) nil)) 1677 (setq vip-use-register nil))) 1678 (delete-backward-char val t))) 1679 1680 1681;; join lines. 1682 1683(defun vip-join-lines (arg) 1684 "Join this line to next, if ARG is nil. Otherwise, join ARG lines" 1685 (interactive "*P") 1686 (let ((val (vip-P-val arg))) 1687 (setq vip-d-com (list 'vip-join-lines val nil)) 1688 (vip-loop (if (null val) 1 (1- val)) 1689 (progn 1690 (end-of-line) 1691 (if (not (eobp)) 1692 (progn 1693 (forward-line 1) 1694 (delete-region (point) (1- (point))) 1695 (fixup-whitespace))))))) 1696 1697 1698;; making small changes 1699 1700(defun vip-change (beg end) 1701 (setq c-string 1702 (vip-read-string (format "%s => " (buffer-substring beg end)))) 1703 (vip-change-subr beg end)) 1704 1705(defun vip-change-subr (beg end) 1706 (if vip-use-register 1707 (progn 1708 (copy-to-register vip-use-register beg end nil) 1709 (setq vip-use-register nil))) 1710 (kill-region beg end) 1711 (setq this-command 'vip-change) 1712 (insert c-string)) 1713 1714 1715;; query replace 1716 1717(defun vip-query-replace () 1718 "Query replace. If you supply null string as the string to be replaced, 1719the query replace mode will toggle between string replace and regexp replace." 1720 (interactive) 1721 (let (str) 1722 (setq str (vip-read-string 1723 (if vip-re-query-replace "Query replace regexp: " 1724 "Query replace: "))) 1725 (if (string= str "") 1726 (progn 1727 (setq vip-re-query-replace (not vip-re-query-replace)) 1728 (message "Query replace mode changed to %s." 1729 (if vip-re-query-replace "regexp replace" 1730 "string replace"))) 1731 (if vip-re-query-replace 1732 (query-replace-regexp 1733 str 1734 (vip-read-string (format "Query replace regexp \"%s\" with: " str))) 1735 (query-replace 1736 str 1737 (vip-read-string (format "Query replace \"%s\" with: " str))))))) 1738 1739 1740;; marking 1741 1742(defun vip-mark-beginning-of-buffer () 1743 (interactive) 1744 (set-mark (point)) 1745 (goto-char (point-min)) 1746 (exchange-point-and-mark) 1747 (message "mark set at the beginning of buffer")) 1748 1749(defun vip-mark-end-of-buffer () 1750 (interactive) 1751 (set-mark (point)) 1752 (goto-char (point-max)) 1753 (exchange-point-and-mark) 1754 (message "mark set at the end of buffer")) 1755 1756(defun vip-mark-point (char) 1757 (interactive "c") 1758 (cond ((and (<= ?a char) (<= char ?z)) 1759 (point-to-register (- char (- ?a ?\C-a)) nil)) 1760 ((= char ?<) (vip-mark-beginning-of-buffer)) 1761 ((= char ?>) (vip-mark-end-of-buffer)) 1762 ((= char ?.) (push-mark)) 1763 ((= char ?,) (set-mark-command 1)) 1764 ((= char ?D) (mark-defun)) 1765 (t (error "")))) 1766 1767(defun vip-goto-mark (arg) 1768 "Go to mark." 1769 (interactive "P") 1770 (let ((char (read-char)) (com (vip-getcom arg))) 1771 (vip-goto-mark-subr char com nil))) 1772 1773(defun vip-goto-mark-and-skip-white (arg) 1774 "Go to mark and skip to first non-white on line." 1775 (interactive "P") 1776 (let ((char (read-char)) (com (vip-getCom arg))) 1777 (vip-goto-mark-subr char com t))) 1778 1779(defun vip-goto-mark-subr (char com skip-white) 1780 (cond ((and (<= ?a char) (<= char ?z)) 1781 (let ((buff (current-buffer))) 1782 (if com (move-marker vip-com-point (point))) 1783 (goto-char (register-to-point (- char (- ?a ?\C-a)))) 1784 (if skip-white (back-to-indentation)) 1785 (vip-change-mode-to-vi) 1786 (if com 1787 (if (equal buff (current-buffer)) 1788 (vip-execute-com (if skip-white 1789 'vip-goto-mark-and-skip-white 1790 'vip-goto-mark) 1791 nil com) 1792 (switch-to-buffer buff) 1793 (goto-char vip-com-point) 1794 (vip-change-mode-to-vi) 1795 (error ""))))) 1796 ((and (not skip-white) (= char ?`)) 1797 (if com (move-marker vip-com-point (point))) 1798 (exchange-point-and-mark) 1799 (if com (vip-execute-com 'vip-goto-mark nil com))) 1800 ((and skip-white (= char ?')) 1801 (if com (move-marker vip-com-point (point))) 1802 (exchange-point-and-mark) 1803 (back-to-indentation) 1804 (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com))) 1805 (t (error "")))) 1806 1807(defun vip-exchange-point-and-mark () 1808 (interactive) 1809 (exchange-point-and-mark) 1810 (back-to-indentation)) 1811 1812(defun vip-keyboard-quit () 1813 "Abort partially formed or running command." 1814 (interactive) 1815 (setq vip-use-register nil) 1816 (keyboard-quit)) 1817 1818(defun vip-ctl-c-equivalent (arg) 1819 "Emulate C-c in Emacs mode." 1820 (interactive "P") 1821 (vip-ctl-key-equivalent "\C-c" arg)) 1822 1823(defun vip-ctl-x-equivalent (arg) 1824 "Emulate C-x in Emacs mode." 1825 (interactive "P") 1826 (vip-ctl-key-equivalent "\C-x" arg)) 1827 1828(defun vip-ctl-key-equivalent (key arg) 1829 (let ((char (read-char))) 1830 (if (and (<= ?A char) (<= char ?Z)) 1831 (setq char (- char (- ?A ?\C-a)))) 1832 (vip-escape-to-emacs arg (list (aref key 0) char)))) 1833 1834;; commands in insertion mode 1835 1836(defun vip-delete-backward-word (arg) 1837 "Delete previous word." 1838 (interactive "p") 1839 (save-excursion 1840 (set-mark (point)) 1841 (backward-word arg) 1842 (delete-region (point) (mark)))) 1843 1844 1845;; key bindings 1846 1847(set 'vip-mode-map (make-keymap)) 1848 1849(define-key vip-mode-map "\C-a" 'beginning-of-line) 1850(define-key vip-mode-map "\C-b" 'vip-scroll-back) 1851(define-key vip-mode-map "\C-c" 'vip-ctl-c) 1852(define-key vip-mode-map "\C-d" 'vip-scroll-up) 1853(define-key vip-mode-map "\C-e" 'vip-scroll-up-one) 1854(define-key vip-mode-map "\C-f" 'vip-scroll) 1855(define-key vip-mode-map "\C-g" 'vip-keyboard-quit) 1856(define-key vip-mode-map "\C-h" 'help-command) 1857(define-key vip-mode-map "\C-m" 'vip-scroll-back) 1858(define-key vip-mode-map "\C-n" 'vip-other-window) 1859(define-key vip-mode-map "\C-o" 'vip-open-line-at-point) 1860(define-key vip-mode-map "\C-u" 'vip-scroll-down) 1861(define-key vip-mode-map "\C-x" 'vip-ctl-x) 1862(define-key vip-mode-map "\C-y" 'vip-scroll-down-one) 1863(define-key vip-mode-map "\C-z" 'vip-change-mode-to-emacs) 1864(define-key vip-mode-map "\e" 'vip-ESC) 1865 1866(define-key vip-mode-map " " 'vip-scroll) 1867(define-key vip-mode-map "!" 'vip-command-argument) 1868(define-key vip-mode-map "\"" 'vip-command-argument) 1869(define-key vip-mode-map "#" 'vip-command-argument) 1870(define-key vip-mode-map "$" 'vip-goto-eol) 1871(define-key vip-mode-map "%" 'vip-paren-match) 1872(define-key vip-mode-map "&" 'vip-nil) 1873(define-key vip-mode-map "'" 'vip-goto-mark-and-skip-white) 1874(define-key vip-mode-map "(" 'vip-backward-sentence) 1875(define-key vip-mode-map ")" 'vip-forward-sentence) 1876(define-key vip-mode-map "*" 'call-last-kbd-macro) 1877(define-key vip-mode-map "+" 'vip-next-line-at-bol) 1878(define-key vip-mode-map "," 'vip-repeat-find-opposite) 1879(define-key vip-mode-map "-" 'vip-previous-line-at-bol) 1880(define-key vip-mode-map "." 'vip-repeat) 1881(define-key vip-mode-map "/" 'vip-search-forward) 1882 1883(define-key vip-mode-map "0" 'vip-beginning-of-line) 1884(define-key vip-mode-map "1" 'vip-digit-argument) 1885(define-key vip-mode-map "2" 'vip-digit-argument) 1886(define-key vip-mode-map "3" 'vip-digit-argument) 1887(define-key vip-mode-map "4" 'vip-digit-argument) 1888(define-key vip-mode-map "5" 'vip-digit-argument) 1889(define-key vip-mode-map "6" 'vip-digit-argument) 1890(define-key vip-mode-map "7" 'vip-digit-argument) 1891(define-key vip-mode-map "8" 'vip-digit-argument) 1892(define-key vip-mode-map "9" 'vip-digit-argument) 1893 1894(define-key vip-mode-map ":" 'vip-ex) 1895(define-key vip-mode-map ";" 'vip-repeat-find) 1896(define-key vip-mode-map "<" 'vip-command-argument) 1897(define-key vip-mode-map "=" 'vip-command-argument) 1898(define-key vip-mode-map ">" 'vip-command-argument) 1899(define-key vip-mode-map "?" 'vip-search-backward) 1900(define-key vip-mode-map "@" 'vip-nil) 1901 1902(define-key vip-mode-map "A" 'vip-Append) 1903(define-key vip-mode-map "B" 'vip-backward-Word) 1904(define-key vip-mode-map "C" 'vip-ctl-c-equivalent) 1905(define-key vip-mode-map "D" 'vip-kill-line) 1906(define-key vip-mode-map "E" 'vip-end-of-Word) 1907(define-key vip-mode-map "F" 'vip-find-char-backward) 1908(define-key vip-mode-map "G" 'vip-goto-line) 1909(define-key vip-mode-map "H" 'vip-window-top) 1910(define-key vip-mode-map "I" 'vip-Insert) 1911(define-key vip-mode-map "J" 'vip-join-lines) 1912(define-key vip-mode-map "K" 'vip-kill-buffer) 1913(define-key vip-mode-map "L" 'vip-window-bottom) 1914(define-key vip-mode-map "M" 'vip-window-middle) 1915(define-key vip-mode-map "N" 'vip-search-Next) 1916(define-key vip-mode-map "O" 'vip-Open-line) 1917(define-key vip-mode-map "P" 'vip-Put-back) 1918(define-key vip-mode-map "Q" 'vip-query-replace) 1919(define-key vip-mode-map "R" 'vip-replace-string) 1920(define-key vip-mode-map "S" 'vip-switch-to-buffer-other-window) 1921(define-key vip-mode-map "T" 'vip-goto-char-backward) 1922(define-key vip-mode-map "U" 'vip-nil) 1923(define-key vip-mode-map "V" 'vip-find-file-other-window) 1924(define-key vip-mode-map "W" 'vip-forward-Word) 1925(define-key vip-mode-map "X" 'vip-ctl-x-equivalent) 1926(define-key vip-mode-map "Y" 'vip-yank-line) 1927(define-key vip-mode-map "ZZ" 'save-buffers-kill-emacs) 1928 1929(define-key vip-mode-map "[" 'vip-nil) 1930(define-key vip-mode-map "\\" 'vip-escape-to-emacs) 1931(define-key vip-mode-map "]" 'vip-nil) 1932(define-key vip-mode-map "^" 'vip-bol-and-skip-white) 1933(define-key vip-mode-map "_" 'vip-nil) 1934(define-key vip-mode-map "`" 'vip-goto-mark) 1935 1936(define-key vip-mode-map "a" 'vip-append) 1937(define-key vip-mode-map "b" 'vip-backward-word) 1938(define-key vip-mode-map "c" 'vip-command-argument) 1939(define-key vip-mode-map "d" 'vip-command-argument) 1940(define-key vip-mode-map "e" 'vip-end-of-word) 1941(define-key vip-mode-map "f" 'vip-find-char-forward) 1942(define-key vip-mode-map "g" 'vip-info-on-file) 1943(define-key vip-mode-map "h" 'vip-backward-char) 1944(define-key vip-mode-map "i" 'vip-insert) 1945(define-key vip-mode-map "j" 'vip-next-line) 1946(define-key vip-mode-map "k" 'vip-previous-line) 1947(define-key vip-mode-map "l" 'vip-forward-char) 1948(define-key vip-mode-map "m" 'vip-mark-point) 1949(define-key vip-mode-map "n" 'vip-search-next) 1950(define-key vip-mode-map "o" 'vip-open-line) 1951(define-key vip-mode-map "p" 'vip-put-back) 1952(define-key vip-mode-map "q" 'vip-nil) 1953(define-key vip-mode-map "r" 'vip-replace-char) 1954(define-key vip-mode-map "s" 'vip-switch-to-buffer) 1955(define-key vip-mode-map "t" 'vip-goto-char-forward) 1956(define-key vip-mode-map "u" 'vip-undo) 1957(define-key vip-mode-map "v" 'vip-find-file) 1958(define-key vip-mode-map "w" 'vip-forward-word) 1959(define-key vip-mode-map "x" 'vip-delete-char) 1960(define-key vip-mode-map "y" 'vip-command-argument) 1961(define-key vip-mode-map "zH" 'vip-line-to-top) 1962(define-key vip-mode-map "zM" 'vip-line-to-middle) 1963(define-key vip-mode-map "zL" 'vip-line-to-bottom) 1964(define-key vip-mode-map "z\C-m" 'vip-line-to-top) 1965(define-key vip-mode-map "z." 'vip-line-to-middle) 1966(define-key vip-mode-map "z-" 'vip-line-to-bottom) 1967 1968(define-key vip-mode-map "{" 'vip-backward-paragraph) 1969(define-key vip-mode-map "|" 'vip-goto-col) 1970(define-key vip-mode-map "}" 'vip-forward-paragraph) 1971(define-key vip-mode-map "~" 'vip-nil) 1972(define-key vip-mode-map "\177" 'vip-delete-backward-char) 1973 1974(define-key ctl-x-map "3" 'vip-buffer-in-two-windows) 1975(define-key ctl-x-map "\C-i" 'insert-file) 1976 1977(defun vip-version () 1978 (interactive) 1979 (message "VIP version 3.5 of September 15, 1987")) 1980 1981 1982;; implement ex commands 1983 1984(defvar ex-token-type nil 1985 "type of token. if non-nil, gives type of address. if nil, it 1986is a command.") 1987 1988(defvar ex-token nil 1989 "value of token.") 1990 1991(defvar ex-addresses nil 1992 "list of ex addresses") 1993 1994(defvar ex-flag nil 1995 "flag for ex flag") 1996 1997(defvar ex-buffer nil 1998 "name of ex buffer") 1999 2000(defvar ex-count nil 2001 "value of ex count") 2002 2003(defvar ex-g-flag nil 2004 "flag for global command") 2005 2006(defvar ex-g-variant nil 2007 "if t global command is executed on lines not matching ex-g-pat") 2008 2009(defvar ex-reg-exp nil 2010 "save reg-exp used in substitute") 2011 2012(defvar ex-repl nil 2013 "replace pattern for substitute") 2014 2015(defvar ex-g-pat nil 2016 "pattern for global command") 2017 2018(defvar ex-map (make-sparse-keymap) 2019 "save commands for mapped keys") 2020 2021(defvar ex-tag nil 2022 "save ex tag") 2023 2024(defvar ex-file nil) 2025 2026(defvar ex-variant nil) 2027 2028(defvar ex-offset nil) 2029 2030(defvar ex-append nil) 2031 2032(defun vip-nil () 2033 (interactive) 2034 (error "")) 2035 2036(defun vip-looking-back (str) 2037 "returns t if looking back reg-exp STR before point." 2038 (and (save-excursion (re-search-backward str nil t)) 2039 (= (point) (match-end 0)))) 2040 2041(defun vip-check-sub (str) 2042 "check if ex-token is an initial segment of STR" 2043 (let ((length (length ex-token))) 2044 (if (and (<= length (length str)) 2045 (string= ex-token (substring str 0 length))) 2046 (setq ex-token str) 2047 (setq ex-token-type "non-command")))) 2048 2049(defun vip-get-ex-com-subr () 2050 "get a complete ex command" 2051 (set-mark (point)) 2052 (re-search-forward "[a-z][a-z]*") 2053 (setq ex-token-type "command") 2054 (setq ex-token (buffer-substring (point) (mark))) 2055 (exchange-point-and-mark) 2056 (cond ((looking-at "a") 2057 (cond ((looking-at "ab") (vip-check-sub "abbreviate")) 2058 ((looking-at "ar") (vip-check-sub "args")) 2059 (t (vip-check-sub "append")))) 2060 ((looking-at "[bh]") (setq ex-token-type "non-command")) 2061 ((looking-at "c") 2062 (if (looking-at "co") (vip-check-sub "copy") 2063 (vip-check-sub "change"))) 2064 ((looking-at "d") (vip-check-sub "delete")) 2065 ((looking-at "e") 2066 (if (looking-at "ex") (vip-check-sub "ex") 2067 (vip-check-sub "edit"))) 2068 ((looking-at "f") (vip-check-sub "file")) 2069 ((looking-at "g") (vip-check-sub "global")) 2070 ((looking-at "i") (vip-check-sub "insert")) 2071 ((looking-at "j") (vip-check-sub "join")) 2072 ((looking-at "l") (vip-check-sub "list")) 2073 ((looking-at "m") 2074 (cond ((looking-at "map") (vip-check-sub "map")) 2075 ((looking-at "mar") (vip-check-sub "mark")) 2076 (t (vip-check-sub "move")))) 2077 ((looking-at "n") 2078 (if (looking-at "nu") (vip-check-sub "number") 2079 (vip-check-sub "next"))) 2080 ((looking-at "o") (vip-check-sub "open")) 2081 ((looking-at "p") 2082 (cond ((looking-at "pre") (vip-check-sub "preserve")) 2083 ((looking-at "pu") (vip-check-sub "put")) 2084 (t (vip-check-sub "print")))) 2085 ((looking-at "q") (vip-check-sub "quit")) 2086 ((looking-at "r") 2087 (cond ((looking-at "rec") (vip-check-sub "recover")) 2088 ((looking-at "rew") (vip-check-sub "rewind")) 2089 (t (vip-check-sub "read")))) 2090 ((looking-at "s") 2091 (cond ((looking-at "se") (vip-check-sub "set")) 2092 ((looking-at "sh") (vip-check-sub "shell")) 2093 ((looking-at "so") (vip-check-sub "source")) 2094 ((looking-at "st") (vip-check-sub "stop")) 2095 (t (vip-check-sub "substitute")))) 2096 ((looking-at "t") 2097 (if (looking-at "ta") (vip-check-sub "tag") 2098 (vip-check-sub "t"))) 2099 ((looking-at "u") 2100 (cond ((looking-at "una") (vip-check-sub "unabbreviate")) 2101 ((looking-at "unm") (vip-check-sub "unmap")) 2102 (t (vip-check-sub "undo")))) 2103 ((looking-at "v") 2104 (cond ((looking-at "ve") (vip-check-sub "version")) 2105 ((looking-at "vi") (vip-check-sub "visual")) 2106 (t (vip-check-sub "v")))) 2107 ((looking-at "w") 2108 (if (looking-at "wq") (vip-check-sub "wq") 2109 (vip-check-sub "write"))) 2110 ((looking-at "x") (vip-check-sub "xit")) 2111 ((looking-at "y") (vip-check-sub "yank")) 2112 ((looking-at "z") (vip-check-sub "z"))) 2113 (exchange-point-and-mark)) 2114 2115(defun vip-get-ex-token () 2116 "get an ex-token which is either an address or a command. 2117a token has type \(command, address, end-mark\) and value." 2118 (save-window-excursion 2119 (set-buffer " *ex-working-space*") 2120 (skip-chars-forward " \t") 2121 (cond ((looking-at "[k#]") 2122 (setq ex-token-type "command") 2123 (setq ex-token (char-to-string (following-char))) 2124 (forward-char 1)) 2125 ((looking-at "[a-z]") (vip-get-ex-com-subr)) 2126 ((looking-at "\\.") 2127 (forward-char 1) 2128 (setq ex-token-type "dot")) 2129 ((looking-at "[0-9]") 2130 (set-mark (point)) 2131 (re-search-forward "[0-9]*") 2132 (setq ex-token-type 2133 (cond ((string= ex-token-type "plus") "add-number") 2134 ((string= ex-token-type "minus") "sub-number") 2135 (t "abs-number"))) 2136 (setq ex-token (string-to-int (buffer-substring (point) (mark))))) 2137 ((looking-at "\\$") 2138 (forward-char 1) 2139 (setq ex-token-type "end")) 2140 ((looking-at "%") 2141 (forward-char 1) 2142 (setq ex-token-type "whole")) 2143 ((looking-at "+") 2144 (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]")) 2145 (forward-char 1) 2146 (insert "1") 2147 (backward-char 1) 2148 (setq ex-token-type "plus")) 2149 ((looking-at "+[0-9]") 2150 (forward-char 1) 2151 (setq ex-token-type "plus")) 2152 (t 2153 (error "Badly formed address")))) 2154 ((looking-at "-") 2155 (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]")) 2156 (forward-char 1) 2157 (insert "1") 2158 (backward-char 1) 2159 (setq ex-token-type "minus")) 2160 ((looking-at "-[0-9]") 2161 (forward-char 1) 2162 (setq ex-token-type "minus")) 2163 (t 2164 (error "Badly formed address")))) 2165 ((looking-at "/") 2166 (forward-char 1) 2167 (set-mark (point)) 2168 (let ((cont t)) 2169 (while (and (not (eolp)) cont) 2170 ;;(re-search-forward "[^/]*/") 2171 (re-search-forward "[^/]*\\(/\\|\n\\)") 2172 (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) 2173 (setq cont nil)))) 2174 (backward-char 1) 2175 (setq ex-token (buffer-substring (point) (mark))) 2176 (if (looking-at "/") (forward-char 1)) 2177 (setq ex-token-type "search-forward")) 2178 ((looking-at "\\?") 2179 (forward-char 1) 2180 (set-mark (point)) 2181 (let ((cont t)) 2182 (while (and (not (eolp)) cont) 2183 ;;(re-search-forward "[^\\?]*\\?") 2184 (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") 2185 (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) 2186 (setq cont nil)) 2187 (backward-char 1) 2188 (if (not (looking-at "\n")) (forward-char 1)))) 2189 (setq ex-token-type "search-backward") 2190 (setq ex-token (buffer-substring (1- (point)) (mark)))) 2191 ((looking-at ",") 2192 (forward-char 1) 2193 (setq ex-token-type "comma")) 2194 ((looking-at ";") 2195 (forward-char 1) 2196 (setq ex-token-type "semi-colon")) 2197 ((looking-at "[!=><&~]") 2198 (setq ex-token-type "command") 2199 (setq ex-token (char-to-string (following-char))) 2200 (forward-char 1)) 2201 ((looking-at "'") 2202 (setq ex-token-type "goto-mark") 2203 (forward-char 1) 2204 (cond ((looking-at "'") (setq ex-token nil)) 2205 ((looking-at "[a-z]") (setq ex-token (following-char))) 2206 (t (error "Marks are ' and a-z"))) 2207 (forward-char 1)) 2208 ((looking-at "\n") 2209 (setq ex-token-type "end-mark") 2210 (setq ex-token "goto")) 2211 (t 2212 (error "illegal token"))))) 2213 2214(defun vip-ex (&optional string) 2215 "ex commands within VIP." 2216 (interactive) 2217 (or string 2218 (setq ex-g-flag nil 2219 ex-g-variant nil)) 2220 (let ((com-str (or string (vip-read-string ":"))) 2221 (address nil) (cont t) (dot (point))) 2222 (save-window-excursion 2223 (set-buffer (get-buffer-create " *ex-working-space*")) 2224 (delete-region (point-min) (point-max)) 2225 (insert com-str "\n") 2226 (goto-char (point-min))) 2227 (setq ex-token-type "") 2228 (setq ex-addresses nil) 2229 (while cont 2230 (vip-get-ex-token) 2231 (cond ((or (string= ex-token-type "command") 2232 (string= ex-token-type "end-mark")) 2233 (if address (setq ex-addresses (cons address ex-addresses))) 2234 (cond ((string= ex-token "global") 2235 (ex-global nil) 2236 (setq cont nil)) 2237 ((string= ex-token "v") 2238 (ex-global t) 2239 (setq cont nil)) 2240 (t 2241 (vip-execute-ex-command) 2242 (save-window-excursion 2243 (set-buffer " *ex-working-space*") 2244 (skip-chars-forward " \t") 2245 (cond ((looking-at "|") 2246 (forward-char 1)) 2247 ((looking-at "\n") 2248 (setq cont nil)) 2249 (t (error "Extra character at end of a command"))))))) 2250 ((string= ex-token-type "non-command") 2251 (error (format "%s: Not an editor command" ex-token))) 2252 ((string= ex-token-type "whole") 2253 (setq ex-addresses 2254 (cons (point-max) (cons (point-min) ex-addresses)))) 2255 ((string= ex-token-type "comma") 2256 (setq ex-addresses 2257 (cons (if (null address) (point) address) ex-addresses))) 2258 ((string= ex-token-type "semi-colon") 2259 (if address (setq dot address)) 2260 (setq ex-addresses 2261 (cons (if (null address) (point) address) ex-addresses))) 2262 (t (let ((ans (vip-get-ex-address-subr address dot))) 2263 (if ans (setq address ans)))))))) 2264 2265(defun vip-get-ex-pat () 2266 "get a regular expression and set ex-variant if found" 2267 (save-window-excursion 2268 (set-buffer " *ex-working-space*") 2269 (skip-chars-forward " \t") 2270 (if (looking-at "!") 2271 (progn 2272 (setq ex-g-variant (not ex-g-variant) 2273 ex-g-flag (not ex-g-flag)) 2274 (forward-char 1) 2275 (skip-chars-forward " \t"))) 2276 (if (looking-at "/") 2277 (progn 2278 (forward-char 1) 2279 (set-mark (point)) 2280 (let ((cont t)) 2281 (while (and (not (eolp)) cont) 2282 (re-search-forward "[^/]*\\(/\\|\n\\)") 2283 ;;(re-search-forward "[^/]*/") 2284 (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) 2285 (setq cont nil)))) 2286 (setq ex-token 2287 (if (= (mark) (point)) "" 2288 (buffer-substring (1- (point)) (mark)))) 2289 (backward-char 1)) 2290 (setq ex-token nil)))) 2291 2292(defun vip-get-ex-command () 2293 "get an ex command" 2294 (save-window-excursion 2295 (set-buffer " *ex-working-space*") 2296 (if (looking-at "/") (forward-char 1)) 2297 (skip-chars-forward " \t") 2298 (cond ((looking-at "[a-z]") 2299 (vip-get-ex-com-subr) 2300 (if (string= ex-token-type "non-command") 2301 (error "%s: not an editor command" ex-token))) 2302 ((looking-at "[!=><&~]") 2303 (setq ex-token (char-to-string (following-char))) 2304 (forward-char 1)) 2305 (t (error "Could not find an ex command"))))) 2306 2307(defun vip-get-ex-opt-gc () 2308 "get an ex option g or c" 2309 (save-window-excursion 2310 (set-buffer " *ex-working-space*") 2311 (if (looking-at "/") (forward-char 1)) 2312 (skip-chars-forward " \t") 2313 (cond ((looking-at "g") 2314 (setq ex-token "g") 2315 (forward-char 1) 2316 t) 2317 ((looking-at "c") 2318 (setq ex-token "c") 2319 (forward-char 1) 2320 t) 2321 (t nil)))) 2322 2323(defun vip-default-ex-addresses (&optional whole-flag) 2324 "compute default addresses. whole-flag means whole buffer." 2325 (cond ((null ex-addresses) 2326 (setq ex-addresses 2327 (if whole-flag 2328 (cons (point-max) (cons (point-min) nil)) 2329 (cons (point) (cons (point) nil))))) 2330 ((null (cdr ex-addresses)) 2331 (setq ex-addresses 2332 (cons (car ex-addresses) ex-addresses))))) 2333 2334(defun vip-get-ex-address () 2335 "get an ex-address as a marker and set ex-flag if a flag is found" 2336 (let ((address (point-marker)) (cont t)) 2337 (setq ex-token "") 2338 (setq ex-flag nil) 2339 (while cont 2340 (vip-get-ex-token) 2341 (cond ((string= ex-token-type "command") 2342 (if (or (string= ex-token "print") (string= ex-token "list") 2343 (string= ex-token "#")) 2344 (progn 2345 (setq ex-flag t) 2346 (setq cont nil)) 2347 (error "address expected"))) 2348 ((string= ex-token-type "end-mark") 2349 (setq cont nil)) 2350 ((string= ex-token-type "whole") 2351 (error "a trailing address is expected")) 2352 ((string= ex-token-type "comma") 2353 (error "Extra characters after an address")) 2354 (t (let ((ans (vip-get-ex-address-subr address (point-marker)))) 2355 (if ans (setq address ans)))))) 2356 address)) 2357 2358(defun vip-get-ex-address-subr (old-address dot) 2359 "returns an address as a point" 2360 (let ((address nil)) 2361 (if (null old-address) (setq old-address dot)) 2362 (cond ((string= ex-token-type "dot") 2363 (setq address dot)) 2364 ((string= ex-token-type "add-number") 2365 (save-excursion 2366 (goto-char old-address) 2367 (forward-line (if (= old-address 0) (1- ex-token) ex-token)) 2368 (setq address (point-marker)))) 2369 ((string= ex-token-type "sub-number") 2370 (save-excursion 2371 (goto-char old-address) 2372 (forward-line (- ex-token)) 2373 (setq address (point-marker)))) 2374 ((string= ex-token-type "abs-number") 2375 (save-excursion 2376 (goto-char (point-min)) 2377 (if (= ex-token 0) (setq address 0) 2378 (forward-line (1- ex-token)) 2379 (setq address (point-marker))))) 2380 ((string= ex-token-type "end") 2381 (setq address (point-max-marker))) 2382 ((string= ex-token-type "plus") t);; do nothing 2383 ((string= ex-token-type "minus") t);; do nothing 2384 ((string= ex-token-type "search-forward") 2385 (save-excursion 2386 (ex-search-address t) 2387 (setq address (point-marker)))) 2388 ((string= ex-token-type "search-backward") 2389 (save-excursion 2390 (ex-search-address nil) 2391 (setq address (point-marker)))) 2392 ((string= ex-token-type "goto-mark") 2393 (save-excursion 2394 (if (null ex-token) 2395 (exchange-point-and-mark) 2396 (goto-char (register-to-point (- ex-token (- ?a ?\C-a))))) 2397 (setq address (point-marker))))) 2398 address)) 2399 2400(defun ex-search-address (forward) 2401 "search pattern and set address" 2402 (if (string= ex-token "") 2403 (if (null vip-s-string) (error "No previous search string") 2404 (setq ex-token vip-s-string)) 2405 (setq vip-s-string ex-token)) 2406 (if forward 2407 (progn 2408 (forward-line 1) 2409 (re-search-forward ex-token)) 2410 (forward-line -1) 2411 (re-search-backward ex-token))) 2412 2413(defun vip-get-ex-buffer () 2414 "get a buffer name and set ex-count and ex-flag if found" 2415 (setq ex-buffer nil) 2416 (setq ex-count nil) 2417 (setq ex-flag nil) 2418 (save-window-excursion 2419 (set-buffer " *ex-working-space*") 2420 (skip-chars-forward " \t") 2421 (if (looking-at "[a-zA-Z]") 2422 (progn 2423 (setq ex-buffer (following-char)) 2424 (forward-char 1) 2425 (skip-chars-forward " \t"))) 2426 (if (looking-at "[0-9]") 2427 (progn 2428 (set-mark (point)) 2429 (re-search-forward "[0-9][0-9]*") 2430 (setq ex-count (string-to-int (buffer-substring (point) (mark)))) 2431 (skip-chars-forward " \t"))) 2432 (if (looking-at "[pl#]") 2433 (progn 2434 (setq ex-flag t) 2435 (forward-char 1))) 2436 (if (not (looking-at "[\n|]")) 2437 (error "Illegal extra characters")))) 2438 2439(defun vip-get-ex-count () 2440 (setq ex-variant nil 2441 ex-count nil 2442 ex-flag nil) 2443 (save-window-excursion 2444 (set-buffer " *ex-working-space*") 2445 (skip-chars-forward " \t") 2446 (if (looking-at "!") 2447 (progn 2448 (setq ex-variant t) 2449 (forward-char 1))) 2450 (skip-chars-forward " \t") 2451 (if (looking-at "[0-9]") 2452 (progn 2453 (set-mark (point)) 2454 (re-search-forward "[0-9][0-9]*") 2455 (setq ex-count (string-to-int (buffer-substring (point) (mark)))) 2456 (skip-chars-forward " \t"))) 2457 (if (looking-at "[pl#]") 2458 (progn 2459 (setq ex-flag t) 2460 (forward-char 1))) 2461 (if (not (looking-at "[\n|]")) 2462 (error "Illegal extra characters")))) 2463 2464(defun vip-get-ex-file () 2465 "get a file name and set ex-variant, ex-append and ex-offset if found" 2466 (setq ex-file nil 2467 ex-variant nil 2468 ex-append nil 2469 ex-offset nil) 2470 (save-window-excursion 2471 (set-buffer " *ex-working-space*") 2472 (skip-chars-forward " \t") 2473 (if (looking-at "!") 2474 (progn 2475 (setq ex-variant t) 2476 (forward-char 1) 2477 (skip-chars-forward " \t"))) 2478 (if (looking-at ">>") 2479 (progn 2480 (setq ex-append t 2481 ex-variant t) 2482 (forward-char 2) 2483 (skip-chars-forward " \t"))) 2484 (if (looking-at "+") 2485 (progn 2486 (forward-char 1) 2487 (set-mark (point)) 2488 (re-search-forward "[ \t\n]") 2489 (backward-char 1) 2490 (setq ex-offset (buffer-substring (point) (mark))) 2491 (forward-char 1) 2492 (skip-chars-forward " \t"))) 2493 (set-mark (point)) 2494 (re-search-forward "[ \t\n]") 2495 (backward-char 1) 2496 (setq ex-file (buffer-substring (point) (mark))))) 2497 2498(defun vip-execute-ex-command () 2499 "execute ex command using the value of addresses." 2500 (cond ((string= ex-token "goto") (ex-goto)) 2501 ((string= ex-token "copy") (ex-copy nil)) 2502 ((string= ex-token "delete") (ex-delete)) 2503 ((string= ex-token "edit") (ex-edit)) 2504 ((string= ex-token "file") (vip-info-on-file)) 2505 ;((string= ex-token "global") (ex-global nil)) 2506 ((string= ex-token "join") (ex-line "join")) 2507 ((string= ex-token "k") (ex-mark)) 2508 ((string= ex-token "mark") (ex-mark)) 2509 ((string= ex-token "map") (ex-map)) 2510 ((string= ex-token "move") (ex-copy t)) 2511 ((string= ex-token "put") (ex-put)) 2512 ((string= ex-token "quit") (ex-quit)) 2513 ((string= ex-token "read") (ex-read)) 2514 ((string= ex-token "set") (ex-set)) 2515 ((string= ex-token "shell") (ex-shell)) 2516 ((string= ex-token "substitute") (ex-substitute)) 2517 ((string= ex-token "stop") (suspend-emacs)) 2518 ((string= ex-token "t") (ex-copy nil)) 2519 ((string= ex-token "tag") (ex-tag)) 2520 ((string= ex-token "undo") (vip-undo)) 2521 ((string= ex-token "unmap") (ex-unmap)) 2522 ;((string= ex-token "v") (ex-global t)) 2523 ((string= ex-token "version") (vip-version)) 2524 ((string= ex-token "visual") (ex-edit)) 2525 ((string= ex-token "write") (ex-write nil)) 2526 ((string= ex-token "wq") (ex-write t)) 2527 ((string= ex-token "yank") (ex-yank)) 2528 ((string= ex-token "!") (ex-command)) 2529 ((string= ex-token "=") (ex-line-no)) 2530 ((string= ex-token ">") (ex-line "right")) 2531 ((string= ex-token "<") (ex-line "left")) 2532 ((string= ex-token "&") (ex-substitute t)) 2533 ((string= ex-token "~") (ex-substitute t t)) 2534 ((or (string= ex-token "append") 2535 (string= ex-token "args") 2536 (string= ex-token "change") 2537 (string= ex-token "insert") 2538 (string= ex-token "open") 2539 ) 2540 (error (format "%s: no such command from VIP" ex-token))) 2541 ((or (string= ex-token "abbreviate") 2542 (string= ex-token "list") 2543 (string= ex-token "next") 2544 (string= ex-token "print") 2545 (string= ex-token "preserve") 2546 (string= ex-token "recover") 2547 (string= ex-token "rewind") 2548 (string= ex-token "source") 2549 (string= ex-token "unabbreviate") 2550 (string= ex-token "xit") 2551 (string= ex-token "z") 2552 ) 2553 (error (format "%s: not implemented in VIP" ex-token))) 2554 (t (error (format "%s: Not an editor command" ex-token))))) 2555 2556(defun ex-goto () 2557 "ex goto command" 2558 (if (null ex-addresses) 2559 (setq ex-addresses (cons (point) nil))) 2560 (push-mark (point)) 2561 (goto-char (car ex-addresses)) 2562 (beginning-of-line)) 2563 2564(defun ex-copy (del-flag) 2565 "ex copy and move command. DEL-FLAG means delete." 2566 (vip-default-ex-addresses) 2567 (let ((address (vip-get-ex-address)) 2568 (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) 2569 (goto-char end) 2570 (save-excursion 2571 (set-mark beg) 2572 (vip-enlarge-region (mark) (point)) 2573 (if del-flag (kill-region (point) (mark)) 2574 (copy-region-as-kill (point) (mark))) 2575 (if ex-flag 2576 (progn 2577 (with-output-to-temp-buffer "*copy text*" 2578 (princ 2579 (if (or del-flag ex-g-flag ex-g-variant) 2580 (current-kill 0) 2581 (buffer-substring (point) (mark))))) 2582 (condition-case nil 2583 (progn 2584 (vip-read-string "[Hit return to continue] ") 2585 (save-excursion (kill-buffer "*copy text*"))) 2586 (quit 2587 (save-excursion (kill-buffer "*copy text*")) 2588 (signal 'quit nil)))))) 2589 (if (= address 0) 2590 (goto-char (point-min)) 2591 (goto-char address) 2592 (forward-line 1)) 2593 (insert (current-kill 0)))) 2594 2595(defun ex-delete () 2596 "ex delete" 2597 (vip-default-ex-addresses) 2598 (vip-get-ex-buffer) 2599 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) 2600 (if (> beg end) (error "First address exceeds second")) 2601 (save-excursion 2602 (vip-enlarge-region beg end) 2603 (exchange-point-and-mark) 2604 (if ex-count 2605 (progn 2606 (set-mark (point)) 2607 (forward-line (1- ex-count))) 2608 (set-mark end)) 2609 (vip-enlarge-region (point) (mark)) 2610 (if ex-flag 2611 ;; show text to be deleted and ask for confirmation 2612 (progn 2613 (with-output-to-temp-buffer " *delete text*" 2614 (princ (buffer-substring (point) (mark)))) 2615 (condition-case conditions 2616 (vip-read-string "[Hit return to continue] ") 2617 (quit 2618 (save-excursion (kill-buffer " *delete text*")) 2619 (error ""))) 2620 (save-excursion (kill-buffer " *delete text*"))) 2621 (if ex-buffer 2622 (if (and (<= ?A ex-buffer) (<= ex-buffer ?Z)) 2623 (vip-append-to-register 2624 (+ ex-buffer 32) (point) (mark)) 2625 (copy-to-register ex-buffer (point) (mark) nil))) 2626 (delete-region (point) (mark)))))) 2627 2628(defun ex-edit () 2629 "ex-edit" 2630 (vip-get-ex-file) 2631 (if (and (not ex-variant) (buffer-modified-p) buffer-file-name) 2632 (error "No write since last change \(:e! overrides\)")) 2633 (vip-change-mode-to-emacs) 2634 (set-buffer 2635 (find-file-noselect (concat default-directory ex-file))) 2636 (vip-change-mode-to-vi) 2637 (goto-char (point-min)) 2638 (if ex-offset 2639 (progn 2640 (save-window-excursion 2641 (set-buffer " *ex-working-space*") 2642 (delete-region (point-min) (point-max)) 2643 (insert ex-offset "\n") 2644 (goto-char (point-min))) 2645 (goto-char (vip-get-ex-address)) 2646 (beginning-of-line)))) 2647 2648(defun ex-global (variant) 2649 "ex global command" 2650 (if (or ex-g-flag ex-g-variant) 2651 (error "Global within global not allowed") 2652 (if variant 2653 (setq ex-g-flag nil 2654 ex-g-variant t) 2655 (setq ex-g-flag t 2656 ex-g-variant nil))) 2657 (vip-get-ex-pat) 2658 (if (null ex-token) 2659 (error "Missing regular expression for global command")) 2660 (if (string= ex-token "") 2661 (if (null vip-s-string) (error "No previous search string") 2662 (setq ex-g-pat vip-s-string)) 2663 (setq ex-g-pat ex-token 2664 vip-s-string ex-token)) 2665 (if (null ex-addresses) 2666 (setq ex-addresses (list (point-max) (point-min)))) 2667 (let ((marks nil) (mark-count 0) 2668 com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) 2669 (if (> beg end) (error "First address exceeds second")) 2670 (save-excursion 2671 (vip-enlarge-region beg end) 2672 (exchange-point-and-mark) 2673 (let ((cont t) (limit (point-marker))) 2674 (exchange-point-and-mark) 2675 ;; skip the last line if empty 2676 (beginning-of-line) 2677 (if (and (eobp) (not (bobp))) (backward-char 1)) 2678 (while (and cont (not (bobp)) (>= (point) limit)) 2679 (beginning-of-line) 2680 (set-mark (point)) 2681 (end-of-line) 2682 (let ((found (re-search-backward ex-g-pat (mark) t))) 2683 (if (or (and ex-g-flag found) 2684 (and ex-g-variant (not found))) 2685 (progn 2686 (end-of-line) 2687 (setq mark-count (1+ mark-count)) 2688 (setq marks (cons (point-marker) marks))))) 2689 (beginning-of-line) 2690 (if (bobp) (setq cont nil) 2691 (forward-line -1) 2692 (end-of-line))))) 2693 (save-window-excursion 2694 (set-buffer " *ex-working-space*") 2695 (setq com-str (buffer-substring (1+ (point)) (1- (point-max))))) 2696 (while marks 2697 (goto-char (car marks)) 2698 ; report progress of execution on a slow machine. 2699 ;(message "Executing global command...") 2700 ;(if (zerop (% mark-count 10)) 2701 ;(message "Executing global command...%d" mark-count)) 2702 (vip-ex com-str) 2703 (setq mark-count (1- mark-count)) 2704 (setq marks (cdr marks))))) 2705 ;(message "Executing global command...done"))) 2706 2707(defun ex-line (com) 2708 "ex line commands. COM is join, shift-right or shift-left." 2709 (vip-default-ex-addresses) 2710 (vip-get-ex-count) 2711 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point) 2712 (if (> beg end) (error "First address exceeds second")) 2713 (save-excursion 2714 (vip-enlarge-region beg end) 2715 (exchange-point-and-mark) 2716 (if ex-count 2717 (progn 2718 (set-mark (point)) 2719 (forward-line ex-count))) 2720 (if ex-flag 2721 ;; show text to be joined and ask for confirmation 2722 (progn 2723 (with-output-to-temp-buffer " *text*" 2724 (princ (buffer-substring (point) (mark)))) 2725 (condition-case conditions 2726 (progn 2727 (vip-read-string "[Hit return to continue] ") 2728 (ex-line-subr com (point) (mark))) 2729 (quit 2730 (ding))) 2731 (save-excursion (kill-buffer " *text*"))) 2732 (ex-line-subr com (point) (mark))) 2733 (setq point (point))) 2734 (goto-char (1- point)) 2735 (beginning-of-line))) 2736 2737(defun ex-line-subr (com beg end) 2738 (cond ((string= com "join") 2739 (goto-char (min beg end)) 2740 (while (and (not (eobp)) (< (point) (max beg end))) 2741 (end-of-line) 2742 (if (and (<= (point) (max beg end)) (not (eobp))) 2743 (progn 2744 (forward-line 1) 2745 (delete-region (point) (1- (point))) 2746 (if (not ex-variant) (fixup-whitespace)))))) 2747 ((or (string= com "right") (string= com "left")) 2748 (indent-rigidly 2749 (min beg end) (max beg end) 2750 (if (string= com "right") vip-shift-width (- vip-shift-width))) 2751 (goto-char (max beg end)) 2752 (end-of-line) 2753 (forward-char 1)))) 2754 2755(defun ex-mark () 2756 "ex mark" 2757 (let (char) 2758 (if (null ex-addresses) 2759 (setq ex-addresses 2760 (cons (point) nil))) 2761 (save-window-excursion 2762 (set-buffer " *ex-working-space*") 2763 (skip-chars-forward " \t") 2764 (if (looking-at "[a-z]") 2765 (progn 2766 (setq char (following-char)) 2767 (forward-char 1) 2768 (skip-chars-forward " \t") 2769 (if (not (looking-at "[\n|]")) 2770 (error "Extra characters at end of \"k\" command"))) 2771 (if (looking-at "[\n|]") 2772 (error "\"k\" requires a following letter") 2773 (error "Mark must specify a letter")))) 2774 (save-excursion 2775 (goto-char (car ex-addresses)) 2776 (point-to-register (- char (- ?a ?\C-a)) nil)))) 2777 2778(defun ex-map () 2779 "ex map" 2780 (let (char string) 2781 (save-window-excursion 2782 (set-buffer " *ex-working-space*") 2783 (skip-chars-forward " \t") 2784 (setq char (char-to-string (following-char))) 2785 (forward-char 1) 2786 (skip-chars-forward " \t") 2787 (if (looking-at "[\n|]") (error "Missing rhs")) 2788 (set-mark (point)) 2789 (end-of-buffer) 2790 (backward-char 1) 2791 (setq string (buffer-substring (mark) (point)))) 2792 (if (not (lookup-key ex-map char)) 2793 (define-key ex-map char 2794 (or (lookup-key vip-mode-map char) 'vip-nil))) 2795 (define-key vip-mode-map char 2796 (eval 2797 (list 'quote 2798 (cons 'lambda 2799 (list '(count) 2800 '(interactive "p") 2801 (list 'execute-kbd-macro string 'count)))))))) 2802 2803(defun ex-unmap () 2804 "ex unmap" 2805 (let (char) 2806 (save-window-excursion 2807 (set-buffer " *ex-working-space*") 2808 (skip-chars-forward " \t") 2809 (setq char (char-to-string (following-char))) 2810 (forward-char 1) 2811 (skip-chars-forward " \t") 2812 (if (not (looking-at "[\n|]")) (error "Macro must be a character"))) 2813 (if (not (lookup-key ex-map char)) 2814 (error "That macro wasn't mapped")) 2815 (define-key vip-mode-map char (lookup-key ex-map char)) 2816 (define-key ex-map char nil))) 2817 2818(defun ex-put () 2819 "ex put" 2820 (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) 2821 (vip-get-ex-buffer) 2822 (setq vip-use-register ex-buffer) 2823 (goto-char point) 2824 (if (= point 0) (vip-Put-back 1) (vip-put-back 1)))) 2825 2826(defun ex-quit () 2827 "ex quit" 2828 (let (char) 2829 (save-window-excursion 2830 (set-buffer " *ex-working-space*") 2831 (skip-chars-forward " \t") 2832 (setq char (following-char))) 2833 (if (= char ?!) (kill-emacs t) (save-buffers-kill-emacs)))) 2834 2835(defun ex-read () 2836 "ex read" 2837 (let ((point (if (null ex-addresses) (point) (car ex-addresses))) 2838 (variant nil) command file) 2839 (goto-char point) 2840 (if (not (= point 0)) (next-line 1)) 2841 (beginning-of-line) 2842 (save-window-excursion 2843 (set-buffer " *ex-working-space*") 2844 (skip-chars-forward " \t") 2845 (if (looking-at "!") 2846 (progn 2847 (setq variant t) 2848 (forward-char 1) 2849 (skip-chars-forward " \t") 2850 (set-mark (point)) 2851 (end-of-line) 2852 (setq command (buffer-substring (mark) (point)))) 2853 (set-mark (point)) 2854 (re-search-forward "[ \t\n]") 2855 (backward-char 1) 2856 (setq file (buffer-substring (point) (mark))))) 2857 (if variant 2858 (shell-command command t) 2859 (insert-file file)))) 2860 2861(defun ex-set () 2862 (eval (list 'setq 2863 (read-variable "Variable: ") 2864 (eval (read-minibuffer "Value: "))))) 2865 2866(defun ex-shell () 2867 "ex shell" 2868 (vip-change-mode-to-emacs) 2869 (shell)) 2870 2871(defun ex-substitute (&optional repeat r-flag) 2872 "ex substitute. 2873If REPEAT use previous reg-exp which is ex-reg-exp or 2874vip-s-string" 2875 (let (pat repl (opt-g nil) (opt-c nil) (matched-pos nil)) 2876 (if repeat (setq ex-token nil) (vip-get-ex-pat)) 2877 (if (null ex-token) 2878 (setq pat (if r-flag vip-s-string ex-reg-exp) 2879 repl ex-repl) 2880 (setq pat (if (string= ex-token "") vip-s-string ex-token)) 2881 (setq vip-s-string pat 2882 ex-reg-exp pat) 2883 (vip-get-ex-pat) 2884 (if (null ex-token) 2885 (setq ex-token "" 2886 ex-repl "") 2887 (setq repl ex-token 2888 ex-repl ex-token))) 2889 (while (vip-get-ex-opt-gc) 2890 (if (string= ex-token "g") (setq opt-g t) (setq opt-c t))) 2891 (vip-get-ex-count) 2892 (if ex-count 2893 (save-excursion 2894 (if ex-addresses (goto-char (car ex-addresses))) 2895 (set-mark (point)) 2896 (forward-line (1- ex-count)) 2897 (setq ex-addresses (cons (point) (cons (mark) nil)))) 2898 (if (null ex-addresses) 2899 (setq ex-addresses (cons (point) (cons (point) nil))) 2900 (if (null (cdr ex-addresses)) 2901 (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) 2902 ;(setq G opt-g) 2903 (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses))) 2904 (cont t) eol-mark) 2905 (save-excursion 2906 (vip-enlarge-region beg end) 2907 (let ((limit (save-excursion 2908 (goto-char (max (point) (mark))) 2909 (point-marker)))) 2910 (goto-char (min (point) (mark))) 2911 (while (< (point) limit) 2912 (end-of-line) 2913 (setq eol-mark (point-marker)) 2914 (beginning-of-line) 2915 (if opt-g 2916 (progn 2917 (while (and (not (eolp)) 2918 (re-search-forward pat eol-mark t)) 2919 (if (or (not opt-c) (y-or-n-p "Replace? ")) 2920 (progn 2921 (setq matched-pos (point)) 2922 (replace-match repl)))) 2923 (end-of-line) 2924 (forward-char)) 2925 (if (and (re-search-forward pat eol-mark t) 2926 (or (not opt-c) (y-or-n-p "Replace? "))) 2927 (progn 2928 (setq matched-pos (point)) 2929 (replace-match repl))) 2930 (end-of-line) 2931 (forward-char)))))) 2932 (if matched-pos (goto-char matched-pos)) 2933 (beginning-of-line) 2934 (if opt-c (message "done")))) 2935 2936(defun ex-tag () 2937 "ex tag" 2938 (let (tag) 2939 (save-window-excursion 2940 (set-buffer " *ex-working-space*") 2941 (skip-chars-forward " \t") 2942 (set-mark (point)) 2943 (skip-chars-forward "^ |\t\n") 2944 (setq tag (buffer-substring (mark) (point)))) 2945 (if (not (string= tag "")) (setq ex-tag tag)) 2946 (vip-change-mode-to-emacs) 2947 (condition-case conditions 2948 (progn 2949 (if (string= tag "") 2950 (find-tag ex-tag t) 2951 (find-tag-other-window ex-tag)) 2952 (vip-change-mode-to-vi)) 2953 (error 2954 (vip-change-mode-to-vi) 2955 (vip-message-conditions conditions))))) 2956 2957(defun ex-write (q-flag) 2958 "ex write" 2959 (vip-default-ex-addresses t) 2960 (vip-get-ex-file) 2961 (if (string= ex-file "") 2962 (progn 2963 (if (null buffer-file-name) 2964 (error "No file associated with this buffer")) 2965 (setq ex-file buffer-file-name)) 2966 (setq ex-file (expand-file-name ex-file))) 2967 (if (and (not (string= ex-file (buffer-file-name))) 2968 (file-exists-p ex-file) 2969 (not ex-variant)) 2970 (error (format "\"%s\" File exists - use w! to override" ex-file))) 2971 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) 2972 (if (> beg end) (error "First address exceeds second")) 2973 (save-excursion 2974 (vip-enlarge-region beg end) 2975 (write-region (point) (mark) ex-file ex-append t))) 2976 (if (null buffer-file-name) (setq buffer-file-name ex-file)) 2977 (if q-flag (save-buffers-kill-emacs))) 2978 2979(defun ex-yank () 2980 "ex yank" 2981 (vip-default-ex-addresses) 2982 (vip-get-ex-buffer) 2983 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) 2984 (if (> beg end) (error "First address exceeds second")) 2985 (save-excursion 2986 (vip-enlarge-region beg end) 2987 (exchange-point-and-mark) 2988 (if (or ex-g-flag ex-g-variant) (error "Can't yank within global")) 2989 (if ex-count 2990 (progn 2991 (set-mark (point)) 2992 (forward-line (1- ex-count))) 2993 (set-mark end)) 2994 (vip-enlarge-region (point) (mark)) 2995 (if ex-flag (error "Extra characters at end of command")) 2996 (if ex-buffer 2997 (copy-to-register ex-buffer (point) (mark) nil)) 2998 (copy-region-as-kill (point) (mark))))) 2999 3000(defun ex-command () 3001 "execute shell command" 3002 (let (command) 3003 (save-window-excursion 3004 (set-buffer " *ex-working-space*") 3005 (skip-chars-forward " \t") 3006 (set-mark (point)) 3007 (end-of-line) 3008 (setq command (buffer-substring (mark) (point)))) 3009 (if (null ex-addresses) 3010 (shell-command command) 3011 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) 3012 (if (null beg) (setq beg end)) 3013 (save-excursion 3014 (goto-char beg) 3015 (set-mark end) 3016 (vip-enlarge-region (point) (mark)) 3017 (shell-command-on-region (point) (mark) command t)) 3018 (goto-char beg))))) 3019 3020(defun ex-line-no () 3021 "print line number" 3022 (message "%d" 3023 (1+ (count-lines 3024 (point-min) 3025 (if (null ex-addresses) (point-max) (car ex-addresses)))))) 3026 3027(if (file-exists-p "~/.vip") (load "~/.vip")) 3028 3029;;; vip.el ends here 3030