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