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