home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / emulators / vip.el < prev    next >
Encoding:
Text File  |  1992-06-29  |  138.3 KB  |  4,385 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                            ;;
  3. ;;                        VIP                                 ;;
  4. ;;                                                            ;;
  5. ;;               VI Emulation for GNU Emacs                   ;;
  6. ;;                                                            ;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;
  9. ;;
  10. ;; LCD Archive Entry:
  11. ;;
  12. ;; vip-mode|Aamod Sane|sane@cs.uiuc.edu
  13. ;; |Much improved vip mode - minor mode vi emulation
  14. ;; |91-10-1|4.3|~/modes/vip-mode.shar.Z
  15. ;;
  16. ;;
  17. ;; Version 4.3: Aamod Sane (sane@cs.uiuc.edu)
  18. ;;        Jean Jacques Moreau (jjm@hplb.hpl.hp.com) 
  19. ;;        contributed code for Change and Overwrite.
  20. ;; Version 4.2: Aamod Sane (sane@cs.uiuc.edu)
  21. ;;        Jeff Lewis contributed changes marked jl (jlewis@cse.ogi.edu)
  22. ;; Version 4.1: Aamod Sane (sane@cs.uiuc.edu)
  23. ;; Version 3.5: Masahiko Sato (ms@sail.stanford.edu).
  24. ;;        In Japan masahiko@sato.riec.tohoku.junet
  25.  
  26. ;; Current bug reports 
  27. ;;             Aamod Sane (sane@cs.uiuc.edu)
  28.  
  29. ;; GNU Emacs is distributed in the hope that it will be useful,
  30. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  31. ;; accepts responsibility to anyone for the consequences of using it
  32. ;; or for whether it serves any particular purpose or works at all,
  33. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  34. ;; License for full details.
  35.  
  36. ;; Everyone is granted permission to copy, modify and redistribute
  37. ;; GNU Emacs, but only under the conditions described in the
  38. ;; GNU Emacs General Public License.   A copy of this license is
  39. ;; supposed to have been given to you along with GNU Emacs so you
  40. ;; can know your rights and responsibilities.  It should be in a
  41. ;; file named COPYING.  Among other things, the copyright notice
  42. ;; and this notice must be preserved on all copies.
  43.  
  44. ;; Acknowledgements: bug reports and helpful code from
  45. ;;    jjm@hplb.hpl.hp.com, jl@cse.ogi.edu
  46. ;;    rxga@ulysses.att.com,ascott@fws214.intel.com,lindstrom@stat.wisc.edu,
  47. ;;    toma@convex.convex.com,gvr@cs.brown.edu,dave@hellgate.utah.edu
  48. ;;    and others forgotten due to my limited mail archival abilities.
  49.  
  50.  
  51. ;; Variables
  52.  
  53. ;; Keymaps and related variables
  54.  
  55. (defvar vip-emacs-local-map nil
  56.   "Local map used in emacs mode. \(buffer specific\)")
  57.  
  58. (defvar vip-insert-local-map nil
  59.   "Local map used in insert command mode. \(buffer specific\)")
  60.  
  61. (make-variable-buffer-local 'vip-emacs-local-map)
  62. (make-variable-buffer-local 'vip-insert-local-map)
  63.  
  64. (defconst vip-insert-mode-vi-map t
  65.   "* Whether you want the vi map in insert mode or want to use emacs mode maps.
  66. Buffer specific so that that you can choose depending on the mode")
  67.  
  68. (make-variable-buffer-local 'vip-insert-mode-vi-map)
  69.  
  70. ;; vip-mode-map and vip-insert-mode-map are defined just before each
  71. ;; table definitions.
  72.  
  73. (defvar vip-mode-map)
  74. (defvar vip-insert-mode-map)
  75.  
  76. ;; Modes and related variables
  77.  
  78. (defvar vip-current-mode nil
  79.   "Current mode.  One of emacs-mode, vi-mode, insert-mode.")
  80.  
  81. (make-variable-buffer-local 'vip-current-mode)
  82. (setq-default vip-current-mode 'emacs-mode)
  83.  
  84. (defvar vip-emacs-mode-line-buffer-identification nil
  85.   "value of mode-line-buffer-identification in emacs-mode.")
  86. (make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification)
  87. (setq-default vip-emacs-mode-line-buffer-identification
  88.           '("Emacs: %17b"))
  89.  
  90. (defvar vip-current-major-mode nil
  91.   "vip-current-major-mode is the major-mode vi considers it is now.
  92. \(buffer specific\)")
  93.  
  94. (make-variable-buffer-local 'vip-current-major-mode)
  95.  
  96. (defconst vip-toggle-key "\C-z"
  97.   "*The key which will be used to change modes from emacs to vi and back.
  98. In insert mode, this will also function as Meta")
  99.  
  100. (defconst vip-ESC-key "\e" "key used to ESC")
  101.  
  102. (defconst vip-no-multiple-ESC t
  103.   "*If true, multiple ESC in vi mode will cause bell to ring.
  104. \_ is then mapped to Meta")
  105.  
  106. (defconst vip-help-in-insert-mode nil
  107.   "*if t then C-h is bound to help-command in insert mode, if nil then it is
  108. bound to delete-backward-char.")
  109.  
  110. ;; Replace mode and changing text
  111.  
  112. (defvar vip-need-to-finish-change nil
  113.   "Change command still need to be finished.
  114. \(buffer specific\)")
  115.  
  116. (make-variable-buffer-local 'vip-need-to-finish-change)
  117.  
  118. (defvar vip-need-to-exit-overwrite nil
  119.   "Overwrite mode needs to aborted.\(buffer specific\)")
  120.  
  121. (make-variable-buffer-local 'vip-need-to-exit-overwrite)
  122.  
  123. (defvar vip-change-beg-point nil
  124.   "Remember point where change is to start.\(buffer specific\)")
  125.  
  126. (set-default 'vip-change-beg-point (make-marker))
  127. (make-variable-buffer-local 'vip-change-beg-point)
  128.  
  129. (defvar vip-change-end-point nil
  130.   "Remember point where change is to end.\(buffer specific\)")
  131.  
  132. (set-default 'vip-change-end-point (make-marker))
  133. (make-variable-buffer-local 'vip-change-end-point)
  134.  
  135. ;; Autoindent in insert
  136.  
  137. (defvar vip-cted nil
  138.   "cted - Control T'ed - keep track of whether C-t has been pressed.
  139. \(buffer specific\)")
  140. (make-variable-buffer-local 'vip-cted)
  141.  
  142. (defvar vip-current-indent 0
  143.   "Preserve the indent value, used during ^^D.\(buffer specific\)")
  144. (make-variable-buffer-local 'vip-current-indent)
  145.  
  146. (defvar vip-preserve-indent nil
  147.   "Whether to preserve the indent, used by ^^D.\(buffer specific\)")
  148. (make-variable-buffer-local 'vip-preserve-indent)
  149.  
  150. (defconst vip-auto-indent nil
  151.   "* Autoindent if t.")
  152.  
  153. (defconst vip-shift-width 8
  154.   "* the shiftwidth variable")
  155.  
  156. ;; Variables for repeating destructive commands
  157.  
  158. (defvar vip-insert-point nil
  159.   "Remember insert point as a marker. \(buffer specific\)")
  160.  
  161. (set-default 'vip-insert-point (make-marker))
  162. (make-variable-buffer-local 'vip-insert-point)
  163.  
  164. (defvar vip-com-point nil
  165.   "Remember com point as a marker. \(buffer specific\)")
  166.  
  167. (set-default 'vip-com-point (make-marker))
  168. (make-variable-buffer-local 'vip-com-point)
  169.  
  170. (defvar vip-d-com nil
  171.   "If non-nil, it's value is a list (M-COM VAL COM), and is used to
  172. re-execute last destrcutive command")
  173.  
  174. (defvar vip-d-char nil
  175.   "The character remembered by the vi \"r\" command")
  176.  
  177. (defvar vip-use-register nil
  178.   "name of register to store deleted or yanked strings.")
  179.  
  180. ;; Variables for Moves and Searches
  181.  
  182. (defvar vip-f-char nil
  183.   "for use by \";\" command")
  184.  
  185. (defvar vip-F-char nil
  186.   "for use by \".\" command")
  187.  
  188. (defvar vip-f-forward nil
  189.   "for use by \";\" command")
  190.  
  191. (defvar vip-f-offset nil
  192.   "for use by \";\" command")
  193.  
  194. (defvar vip-s-string nil
  195.   "last search string")
  196.  
  197. (defvar vip-s-forward nil
  198.   "if t, search is forward.")
  199.  
  200. (defconst vip-case-fold-search nil
  201.   "*if t, search ignores cases.")
  202.  
  203. (defconst vip-re-search t
  204.   "*if t, search is reg-exp search, otherwise vanilla search.")
  205.  
  206. (defconst vip-re-query-replace t
  207.   "*If t then do regexp replace, if nil then do string replace.")
  208.  
  209. ;; vip replace string is no longer used
  210. (defconst vip-re-replace t
  211.   "*If t then do regexp replace, if nil then do string replace.")
  212.  
  213. (defconst vip-ex-style-motion t
  214.   "*l,h do not cross lines, ESC backs up etc.")
  215.  
  216. (defconst vip-buffer-search-char ?g
  217.   "* Key bound for buffer-searching")
  218.  
  219. (defconst vip-search-wrap-around-t t
  220.   "*if t, search wraps around")
  221.  
  222. (defconst vip-heading-start 
  223.       (concat "^\\s-*(\\s-*defun\\s-\\|"                ;; lisp
  224.           "^{\\s-*$\\|^[_a-zA-Z][^()]*[()].*{\\s-*$\\|"        ;; C/C++
  225.           "^\\s-*class.*{\\|^\\s-*struct.*{\\|^\\s-*enum.*{\\|"
  226.           "^\\\\[sb][a-z]*{.*}\\s-*$\\|"                    ;; latex
  227.           "^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if")        ;; texinfo
  228.       "* Regexps for Headings. Used by [[, ]].")
  229.  
  230. (defconst vip-heading-end "^}\\|^\\\\end{\\|^@end \\|)\n\n[ \t\n]*"
  231.       "* Regexps to end Headings/Sections")
  232.  
  233. ;; VIP word definitions
  234.  
  235. (defvar vip-word-chars-alpha "a-zA-Z0-9_")
  236. (defvar vip-word-chars-nonalpha "^a-zA-Z0-9_ \t\n")
  237. (defvar vip-word-chars-separator " \t\n")
  238.  
  239. ;; History variables
  240.  
  241. (defvar vip-history nil)
  242. (defvar vip-search-history nil)
  243. (defvar vip-ex-history nil)
  244.  
  245. (defconst vip-want-history nil
  246.   "* History for vi searches and ex commands")
  247.  
  248. ;; IO setup
  249.  
  250. (defconst vip-make-cc-quit nil
  251.   "* If set, will call set-input-mode to make ^C the quit character.
  252. However, there is no quit-char option for older emacsen. Moreover, the
  253. first two options may need to change from system to system")
  254.  
  255. ;; Keyboard macros
  256.  
  257. (defvar vip-last-keyboard-macro nil
  258.   "Remember the last register used for keyboard macro")
  259.  
  260. ;; Completion
  261.  
  262. (defconst vip-filename-complete nil
  263.   "*If t then enable filename completion.")
  264.  
  265. ;; Shell command histories. There should not be 2 of these.
  266.  
  267. (defvar vip-ex-last-shell-com nil
  268.   "last shell command executed by :! command")
  269.  
  270. (defvar vip-last-shell-com nil
  271.   "last shell command executed by ! command")
  272.  
  273. ;; VIP setup
  274.  
  275. (defvar vip-inhibit-startup-message nil)
  276.  
  277. (defconst vip-always t
  278.   "* Default vip-mode for files and buffers")
  279.  
  280. (defconst vip-custom-file-name "~/.vip"
  281.   "* Customisation file")
  282.  
  283. (defvar vip-is-vi nil
  284.   "Ultimate compatibility test")
  285.  
  286. ;; Misc
  287.  
  288. (defvar vip-quote-string "> "
  289.   "string inserted at the beginning of region")
  290.  
  291. (defvar vip-tags-file-name "TAGS")
  292.  
  293.  
  294. ;;;; CODE
  295.  
  296. ;;Epoch support
  297.  
  298. (defvar running-epoch)
  299.  
  300. (if (not (boundp 'running-epoch))
  301.     (setq running-epoch nil))
  302.  
  303.  
  304. ;; basic set up
  305.  
  306. (global-set-key vip-toggle-key 'vip-change-mode-to-vi)
  307.  
  308. (defun vip-redefine-toggle-key(key)
  309.   "Redefine the toggle key to be the ARG"
  310.   (global-unset-key key)
  311.   (define-key vip-mode-map key nil)
  312.   (setq vip-toggle-key key)
  313.   (global-set-key vip-toggle-key 'vip-change-mode-to-vi)
  314.   (define-key vip-mode-map vip-toggle-key 'vip-change-mode-to-emacs))
  315.  
  316. (defmacro vip-loop (count body)
  317.   "(COUNT BODY) Execute BODY COUNT times."
  318.   (list 'let (list (list 'count count))
  319.     (list 'while (list '> 'count 0)
  320.           body
  321.           (list 'setq 'count (list '1- 'count)))))
  322.  
  323. (defun vip-push-mark-silent (&optional location)
  324.   "Set mark at LOCATION (point, by default) and push old mark on mark ring.
  325. No message."
  326.   (if (null (mark))
  327.       nil
  328.     (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
  329.     (if (> (length mark-ring) mark-ring-max)
  330.     (progn
  331.       (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
  332.       (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
  333.   (set-mark (or location (point))))
  334.  
  335. (defun vip-goto-col (arg)
  336.   "Go to ARG's column."
  337.   (interactive "P")
  338.   (let ((val (vip-p-val arg))
  339.     (com (vip-getcom arg)))
  340.     (save-excursion
  341.       (end-of-line)
  342.       (if (> val (1+ (current-column))) (error "")))
  343.     (if com (move-marker vip-com-point (point)))
  344.     (beginning-of-line)
  345.     (forward-char (1- val))
  346.     (if com (vip-execute-com 'vip-goto-col val com))))
  347.  
  348. (defun vip-refresh-mode-line ()
  349.   "Redraw mode line."
  350.   (set-buffer-modified-p (buffer-modified-p)))
  351.  
  352. (defun vip-copy-keymap (map)
  353.   (if (null map) (make-sparse-keymap) (copy-keymap map)))
  354.  
  355.  
  356. ;; changing mode
  357.  
  358. (defun vip-change-mode (new-mode)
  359.   "Change mode to NEW-MODE.  NEW-MODE is either emacs-mode, vi-mode,
  360. or insert-mode."
  361.   (cond ((eq new-mode 'vi-mode)
  362.      (cond ((eq vip-current-mode 'insert-mode)
  363.         (setq vip-need-to-exit-overwrite t)
  364.         (if (eq vip-need-to-finish-change t)
  365.             (vip-finish-change)
  366.           (progn
  367.             (vip-copy-region-as-kill (point) vip-insert-point)
  368.             (vip-repeat-insert-command)))
  369.         (if vip-ex-style-motion
  370.             (if (not (bolp))
  371.             (backward-char 1))))
  372.            ;; to support multiple successive (vip-mode) calls
  373.            ;; with keymap changes in between.
  374.            ;; patch specifically for texinfo mode.
  375.            ((eq vip-current-mode 'vi-mode)
  376.         (if (not (eq vip-mode-map (current-local-map)))
  377.             (progn
  378.               (message "Warning: Local map changed under vi mode")
  379.               (setq vip-emacs-local-map (current-local-map)
  380.                 vip-insert-local-map (vip-copy-keymap
  381.                           (current-local-map))))))
  382.            (t
  383.         (setq vip-emacs-local-map (current-local-map)
  384.               vip-emacs-mode-line-buffer-identification
  385.               mode-line-buffer-identification
  386.               vip-insert-local-map (vip-copy-keymap
  387.                         (current-local-map)))))
  388.      (vip-change-mode-line "Vi:   ")
  389.      (use-local-map vip-mode-map))
  390.     ((eq new-mode 'insert-mode)
  391.      (cond ((eq vip-current-mode 'emacs-mode)
  392.         (move-marker vip-insert-point (point))
  393.         (setq vip-emacs-local-map (current-local-map)
  394.               vip-emacs-mode-line-buffer-identification
  395.               mode-line-buffer-identification
  396.               vip-insert-local-map (vip-copy-keymap
  397.                         (current-local-map))))
  398.            ((eq vip-current-mode 'insert-mode)
  399.         ;; Redo boundary lost, otherwise ok
  400.         (if (not (eq vip-insert-local-map (current-local-map)))
  401.             (progn
  402.               (message "Warning: Local map changed under insert mode!!!")
  403.               (setq vip-insert-local-map (vip-copy-keymap
  404.                           (current-local-map))))
  405.           (message "Warning: From insert mode to insert mode!!!")))
  406.            (t
  407.         (move-marker vip-insert-point (point))
  408.         (setq vip-insert-local-map (vip-copy-keymap
  409.                         vip-emacs-local-map))))
  410.      (vip-change-mode-line "Insert")
  411.      (use-local-map vip-insert-local-map)
  412.      (define-key vip-insert-local-map vip-ESC-key 'vip-exit-insert-mode)
  413.      (define-key vip-insert-local-map vip-toggle-key 'vip-alternate-ESC)
  414.      (vip-insert-mode-bindings))
  415.     ((eq new-mode 'emacs-mode) 
  416.      (vip-change-mode-line "Emacs:")
  417.      (use-local-map vip-emacs-local-map)))
  418.   (setq vip-current-mode new-mode)
  419.   (vip-refresh-mode-line))
  420.  
  421. ;; default insert mode bindings other than ESC and Meta
  422. ;; test fboundp to allow this function to be redefined before
  423. ;; or after loading.
  424.  
  425. ;; Define an insert mode map. It is used so that map! can be used to redefine
  426. ;; insert mode entries
  427.  
  428. (set 'vip-insert-mode-map (make-sparse-keymap))
  429.  
  430. (define-key vip-insert-mode-map "\C-c" 'vip-insert-quit)
  431. (define-key vip-insert-mode-map "\C-g" 'self-insert-command)
  432. (define-key vip-insert-mode-map "\C-v" 'quoted-insert)
  433. (define-key vip-insert-mode-map "\C-h" 
  434.   (if vip-help-in-insert-mode 'help-command 'delete-backward-char))
  435. (define-key vip-insert-mode-map "\t" 'self-insert-command)
  436. (define-key vip-insert-mode-map "\C-w" 'vip-delete-backward-word)
  437. (define-key vip-insert-mode-map "\C-u" 'vip-erase-line)
  438. (define-key vip-insert-mode-map "\C-t" 'vip-forward-indent)
  439. (define-key vip-insert-mode-map "\C-d" 'vip-backward-indent)
  440. (define-key vip-insert-mode-map "\177" 'delete-backward-char)
  441. ;;(define-key vip-insert-mode-map "\C-z" 'self-insert-command)
  442.  
  443. (or (fboundp 'vip-insert-mode-bindings)
  444.     (defun vip-insert-mode-bindings()
  445.       (if vip-insert-mode-vi-map
  446.       (progn
  447.         (vip-rebind-emacs-keys vip-insert-local-map 'self-insert-command)
  448.         (vip-rebind-other-keys vip-insert-local-map 'self-insert-command)
  449.         (vip-add-keymap vip-insert-mode-map vip-insert-local-map)
  450.         (if vip-auto-indent
  451.         (progn
  452.           (define-key vip-insert-local-map "\C-m" 'vip-autoindent)
  453.           (define-key vip-insert-local-map "\C-j" 'vip-autoindent)))
  454.         ;; Just for fun - see vip-become-vi
  455.         (if vip-is-vi
  456.         (define-key vip-insert-local-map "\C-x" 'self-insert-command))))
  457.       ))
  458.  
  459. ;;(defun vip-add-keymap(mapsrc mapdst)
  460. ;;  "Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse"
  461. ;;  (mapcar (function (lambda (p)
  462. ;;              (define-key mapdst (char-to-string (car p)) (cdr p))))
  463. ;;      (cdr mapsrc)))
  464.  
  465. (defun vip-add-keymap(mapsrc mapdst)
  466.   "Add contents of mapsrc to mapdst."
  467.   (map-keymap (function (lambda (kdl binding)
  468.               (define-key mapdst kdl binding)))
  469.           mapsrc))
  470.  
  471. (defun vip-copy-region-as-kill (beg end)
  472.   "If BEG and END do not belong to the same buffer, it copies empty region."
  473.   (condition-case nil
  474.       (copy-region-as-kill beg end)
  475.     (error (copy-region-as-kill beg beg))))
  476.  
  477. (defun vip-change-mode-line (string)
  478.   "Assuming that the mode line format contains the string \"Emacs:\", this
  479. function replaces the string by \"Vi:   \" etc."
  480.   (setq mode-line-buffer-identification
  481.     (if (string= string "Emacs:")
  482.         vip-emacs-mode-line-buffer-identification
  483.       (list (concat string " %17b")))))
  484.  
  485. (defun vip-mode ()
  486.   "Turn on VIP emulation of VI."
  487.   (interactive)
  488.   (if (not vip-inhibit-startup-message)
  489.       (progn
  490.     (setq vip-inhibit-startup-message t)
  491.     (switch-to-buffer "VIP Startup Message")
  492.     (erase-buffer)
  493.     (insert
  494.      (substitute-command-keys
  495.       "VIP is a VI emulation package for GNU Emacs.VIP provides most 
  496. VI and EX commands.The important differences from VI are:
  497.     1. VI EXIT functions (e.g. :wq) work on INDIVIDUAL files.
  498.     2. \"ZZ\" and ^X^C EXITS EMACS.
  499.     3. \"u\" will undo. Repeat undo by \".\". Another u changes direction.
  500.     5. ^X will invoke emacs functions; ^Z will toggle vi/emacs modes.
  501.     6. Emacs Meta functions are invoked by \"_\" instead of ESC.
  502.     7. Try ^C,^G repeatedly and \\[abort-recursive-edit] if something strange happens. 
  503. You can get more information on VIP by:
  504.     1.  Typing `M-x info' and selecting menu item \"vip\".
  505.     2.  Printing VIP manual which can be found as GNU/man/vip.texinfo
  506.     3.  Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex
  507. Ultimate compatibilty: Execute vip-become-vi. Emacs is suppressed.
  508.     
  509. This startup message appears whenever you load VIP unless you type `y' now.
  510. Type `n' to quit this window for now.\n"))
  511.     (goto-char (point-min))
  512.     (if (y-or-n-p "Inhibit VIP startup message? ")
  513.         (let ((buf (find-file-noselect (substitute-in-file-name vip-custom-file-name)))) 
  514.           (save-excursion
  515.         (set-buffer buf)
  516.         (goto-char (point-max))
  517.         (insert "\n(setq vip-inhibit-startup-message t)\n")
  518.         (save-buffer))
  519.           (kill-buffer buf)
  520.           (message "VIP startup message inhibited.")
  521.           (sit-for 2)))
  522.     (kill-buffer (current-buffer))
  523.     (message "")))
  524.   (vip-change-mode-to-vi))
  525.  
  526. (defun vip-exit-insert-mode ()
  527.   "Exit from insert mode to vi mode."
  528.   (interactive)
  529.   (vip-change-mode 'vi-mode))
  530. ;;   (if vip-ex-style-motion
  531. ;;       (if (and (eolp) (save-excursion (skip-chars-backward " \t") (bolp)))
  532. ;;       (while (not (bolp)) (delete-char -1))
  533. ;;     (if (not (bolp)) (backward-char 1)))))
  534. ;; ;; the crabwalk here isn't strictly correct... vip only backs up when the
  535. ;; ;; cursor is at the current indent level and only whitespace preceeds it
  536.  
  537. (defun vip-insert-quit ()
  538.   "Exit from insert mode to vi mode and do a keyboard quit."
  539.   (interactive)
  540.   (vip-exit-insert-mode)
  541.   (vip-keyboard-quit))
  542.  
  543. (defun vip-change-mode-to-vi ()
  544.   "Change mode to vi mode."
  545.   (interactive)
  546.   (vip-change-mode 'vi-mode))
  547.  
  548. (defun vip-change-mode-to-insert ()
  549.   "Change mode to insert mode."
  550.   (interactive)
  551.   (vip-change-mode 'insert-mode))
  552.  
  553. (defun vip-change-mode-to-emacs ()
  554.   "Change mode to emacs mode."
  555.   (interactive)
  556.   (vip-change-mode 'emacs-mode))
  557.  
  558.  
  559. ;; escape to emacs mode termporarilly
  560.  
  561. (defun vip-get-editor-command (l-map g-map &optional str)
  562.   "Read characters from keyboard until an editor command is formed, using
  563. local keymap L-MAP and global keymap G-MAP.  If the command is a
  564. self-insert-command, the character just read is returned instead.  Optional
  565. string STR is used as initial input string."
  566.   (let (char l-bind g-bind)
  567.     (setq char
  568.       (if (or (null str) (string= str ""))
  569.           (read-char)
  570.         (string-to-char str)))
  571.     (setq last-command-char char)
  572.     (setq l-bind (vip-binding-of char l-map))
  573.     (if (null l-bind)
  574.     ;; since local binding is empty, we concentrate on global one.
  575.     (progn
  576.       (setq g-bind (vip-binding-of char g-map))
  577.       (if (null g-bind)
  578.           nil ;; return nil, since both bindings are void.
  579.         (if (keymapp g-bind)
  580.         (vip-get-editor-command nil g-bind (vip-string-tail str))
  581.           (if (eq g-bind 'self-insert-command) char g-bind))))
  582.       ;; local binding is nonvoid
  583.       (if (keymapp l-bind)
  584.       ;; since l-bind is a keymap, we consider g-bind as well.
  585.       (progn
  586.         (setq g-bind (vip-binding-of char g-map))
  587.         (if (null g-bind)
  588.         (vip-get-editor-command l-bind nil (vip-string-tail str))
  589.           (if (keymapp g-bind)
  590.           ;; both bindings are keymap
  591.           (vip-get-editor-command l-bind g-bind (vip-string-tail str))
  592.         ;; l-bind is a keymap, so we neglect g-bind
  593.         (vip-get-editor-command l-bind nil (vip-string-tail str)))))
  594.     ;; l-bind is a command
  595.     (if (eq l-bind 'self-insert-command) char l-bind)))))
  596.  
  597. (defun vip-binding-of (char map)
  598.   "Return key-binding of CHAR under keymap MAP.  It is nil if the binding
  599. is void, or a command, or a keymap"
  600.   (let ((val (if (null map) nil (lookup-key map char))))
  601.     (cond ((null val) nil)
  602.       ((keymapp val)
  603.        (if (symbolp val) (symbol-function val) val))
  604.       (t
  605.        ;; otherwise, it is a function which is either a real function or
  606.        ;; a keymap fset to val.
  607.        (let ((fun (symbol-function val)))
  608.          (if (or (null fun) (keymapp fun)) fun val))))))
  609.  
  610. (defun vip-escape-to-emacs (arg &optional char)
  611.   "Escape to emacs mode and execute one emacs command and then return to
  612. vi mode.  ARG is used as the prefix value for the executed command.  If
  613. CHAR is given it becomes the first character of the command."
  614.   (interactive "P")
  615.   (let (com (buff (current-buffer)) (first t))
  616.     (if char (setq unread-command-char char
  617.            unread-command-event
  618.            (character-to-event char (allocate-event))))
  619.     (setq prefix-arg arg)
  620.     (while (or first (>= unread-command-char 0))
  621.       ;; this while loop is executed until unread command char will be
  622.       ;; exhausted.
  623.       (setq first nil)
  624.       (setq com (vip-get-editor-command vip-emacs-local-map global-map))
  625.       (if (numberp com)
  626.       (vip-loop (vip-p-val prefix-arg)
  627.             (insert (char-to-string com)))
  628.     (command-execute com prefix-arg)))
  629.     (setq prefix-arg nil)  ;; reset prefix arg
  630.     ))
  631.  
  632. (defun vip-message-conditions (conditions)
  633.   "Print CONDITIONS as a message."
  634.   (let ((case (car conditions)) (msg (cdr conditions)))
  635.     (if (null msg)
  636.     (message "%s" case)
  637.       (message "%s %s" case (prin1-to-string msg)))
  638.     (ding)))
  639.  
  640. (defun vip-ESC (arg)
  641.   "Emulate ESC key in Emacs mode. Prevent multiple escape keystrokes if
  642. vip-no-multiple-ESC is true. In that case \@ will be bound to ESC"
  643.   (interactive "P")
  644.   (if (or (not vip-no-multiple-ESC) (eq vip-current-mode 'insert-mode))
  645.       (vip-escape-to-emacs arg ?\e)
  646.     (ding)))
  647.  
  648. (defun vip-alternate-ESC (arg)
  649.   "ESC key without checking for multiple keystrokes"
  650.   (interactive "P")
  651.   (vip-escape-to-emacs arg ?\e))
  652.  
  653. (defun vip-ctl-c (arg)
  654.   "Emulate C-c key in Emacs mode."
  655.   (interactive "P")
  656.   (vip-escape-to-emacs arg ?\C-c))
  657.  
  658. (defun vip-ctl-x (arg)
  659.   "Emulate C-x key in Emacs mode."
  660.   (interactive "P")
  661.   (vip-escape-to-emacs arg ?\C-x))
  662.  
  663. (defun vip-ctl-h (arg)
  664.   "Emulate C-h key in Emacs mode."
  665.   (interactive "P")
  666.   (vip-escape-to-emacs arg ?\C-h))
  667.  
  668.  
  669. ;; prefix argmument for vi mode
  670.  
  671. ;; In vi mode, prefix argument is a dotted pair (NUM . COM) where NUM
  672. ;; represents the numeric value of the prefix argument and COM represents
  673. ;; command prefix such as "c", "d", "m" and "y".
  674.  
  675. (defun vip-prefix-arg-value (char value com)
  676.   "Compute numeric prefix arg value.  Invoked by CHAR.  VALUE is the value
  677. obtained so far, and COM is the command part obtained so far."
  678.   (while (and (>= char ?0) (<= char ?9))
  679.     (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)))        
  680.     (setq char (read-char)))
  681.   (setq prefix-arg value)
  682.   (if com (setq prefix-arg (cons prefix-arg com)))
  683.   (while (= char ?U)
  684.     (vip-describe-arg prefix-arg)
  685.     (setq char (read-char)))
  686.   (setq unread-command-char char
  687.     unread-command-event (character-to-event char (allocate-event))))
  688.  
  689. (defun vip-prefix-arg-com (char value com)
  690.   "Vi operator as prefix argument."
  691.   (let ((cont t))
  692.     (while (and cont
  693.         (or (= char ?c) (= char ?d) (= char ?y) 
  694.             (= char ?!) (= char ?<) (= char ?>) (= char ?=)
  695.             (= char ?#) (= char ?r) (= char ?R) (= char ?\")
  696.             (= char vip-buffer-search-char)))
  697.       (if com
  698.       ;; this means that we already have a command character, so we
  699.       ;; construct a com list and exit while.  however, if char is "
  700.       ;; it is an error.
  701.       (progn
  702.         ;; new com is (CHAR . OLDCOM)
  703.         (if (or (= char ?#) (= char ?\")) (error ""))
  704.         (setq com (cons char com))
  705.         (setq cont nil))
  706.     ;; if com is nil we set com as char, and read more.  again, if char
  707.     ;; is ", we read the name of register and store it in vip-use-register.
  708.     ;; if char is !, =, or #, a copmlete com is formed so we exit while.
  709.     (cond ((or (= char ?!) (= char ?=))
  710.            (setq com char)
  711.            (setq char (read-char))
  712.            (setq cont nil))
  713.           ((= char ?#)
  714.            ;; read a char and encode it as com
  715.            (setq com (+ 128 (read-char)))
  716.            (setq char (read-char)))
  717.           ((= char ?\")
  718.            (let ((reg (read-char)))
  719.          (if (or (and (<= ?A reg) (<= reg ?z))
  720.              (and (<= ?1 reg) (<= reg ?9)))
  721.              (setq vip-use-register reg)
  722.            (error ""))
  723.          (setq char (read-char))))
  724.           (t
  725.            (setq com char)
  726.            (setq char (read-char)))))))
  727.   (if (atom com)
  728.       ;; com is a single char, so we construct prefix-arg 
  729.       ;; and if char is ?, describe prefix arg, otherwise exit by
  730.       ;; pushing the char back
  731.       (progn
  732.     (setq prefix-arg (cons value com))
  733.     (while (= char ?U)
  734.       (vip-describe-arg prefix-arg)
  735.       (setq char (read-char)))
  736.     (setq unread-command-char char
  737.           unread-command-event (character-to-event char (allocate-event))))
  738.     ;; as com is non-nil, this means that we have a command to execute
  739.     (if (or (= (car com) ?r) (= (car com) ?R))
  740.     ;; execute apropriate region command.
  741.     (let ((char (car com)) (com (cdr com)))
  742.       (setq prefix-arg (cons value com))
  743.       (if (= char ?r) (vip-region prefix-arg)
  744.         (vip-Region prefix-arg))
  745.       ;; reset prefix-arg
  746.       (setq prefix-arg nil))
  747.       ;; otherwise, reset prefix arg and call appropriate command
  748.       (setq value (if (null value) 1 value))
  749.       (setq prefix-arg nil)
  750.       (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C)))
  751.         ((equal com '(?d . ?d)) (vip-line (cons value ?D)))
  752.         ((equal com '(?d . ?y)) (vip-yank-defun))
  753.         ((equal com '(?y . ?y)) (vip-line (cons value ?Y)))
  754.         ((equal com '(?< . ?<)) (vip-line (cons value ?<)))
  755.         ((equal com '(?> . ?>)) (vip-line (cons value ?>)))
  756.         ((equal com '(?! . ?!)) (vip-line (cons value ?!)))
  757.         ((equal com '(?= . ?=)) (vip-line (cons value ?=)))
  758.         (t (error ""))))))
  759.  
  760. (defun vip-describe-arg (arg)
  761.   (let (val com)
  762.     (setq val (vip-P-val arg)
  763.       com (vip-getcom arg))
  764.     (if (null val)
  765.     (if (null com)
  766.         (message "Value is nil, and commmand is nil.")
  767.       (message "Value is nil, and command is %c." com))
  768.       (if (null com)
  769.       (message "Value is %d, and command is nil." val)
  770.     (message "Value is %d, and command is %c." val com)))))
  771.  
  772. (defun vip-digit-argument (arg)
  773.   "Begin numeric argument for the next command."
  774.   (interactive "P")
  775.   (vip-prefix-arg-value last-command-char nil
  776.             (if (consp arg) (cdr arg) nil)))
  777.  
  778. (defun vip-command-argument (arg)
  779.   "Accept a motion command as an argument."
  780.   (interactive "P")
  781.   (condition-case conditions
  782.       (vip-prefix-arg-com
  783.        last-command-char   
  784.        (cond ((null arg) nil)
  785.          ((consp arg) (car arg))
  786.          ((numberp arg) arg)
  787.          (t (error "strange arg")))
  788.        (cond ((null arg) nil)
  789.          ((consp arg) (cdr arg))
  790.          ((numberp arg) nil)
  791.          (t (error "strange arg"))))
  792.     (quit
  793.      (setq vip-use-register nil)
  794.      (signal 'quit nil))))
  795.  
  796. (defun vip-p-val (arg)
  797.   "Get value part of prefix-argument ARG."
  798.   (cond ((null arg) 1)
  799.     ((consp arg) (if (null (car arg)) 1 (car arg)))
  800.     (t arg)))
  801.  
  802. (defun vip-P-val (arg)
  803.   "Get value part of prefix-argument ARG."
  804.   (cond ((consp arg) (car arg))
  805.     (t arg)))
  806.  
  807. (defun vip-getcom (arg)
  808.   "Get com part of prefix-argument ARG."
  809.   (cond ((null arg) nil)
  810.     ((consp arg) (cdr arg))
  811.     (t nil)))
  812.  
  813. (defun vip-getCom (arg)
  814.   "Get com part of prefix-argument ARG and modify it."
  815.   (let ((com (vip-getcom arg)))
  816.     (cond ((equal com ?c) ?C)
  817.       ((equal com ?d) ?D)
  818.       ((equal com ?y) ?Y)
  819.       (t com))))
  820.  
  821.  
  822. ;; repeat last destructive command
  823.  
  824. (defun vip-append-to-register (reg start end)
  825.   "Append region to text in register REG.
  826. START and END are buffer positions indicating what to append."
  827.   (set-register reg (concat (or (get-register reg) "")
  828.                 (buffer-substring start end))))
  829.  
  830. (defun vip-execute-com (m-com val com)
  831.   "(M-COM VAL COM)  Execute command COM. The list (M-COM VAL COM) is set
  832. to vip-d-com for later use by vip-repeat"
  833.   (let ((reg vip-use-register))
  834.     (if com
  835.     (cond ((= com ?c) (vip-change vip-com-point (point)))
  836.           ((= com (- ?c)) (vip-change-subr vip-com-point (point)))
  837.           ((or (= com ?C) (= com (- ?C)))
  838.            (save-excursion
  839.          (set-mark vip-com-point)
  840.          (vip-enlarge-region (mark) (point))
  841.          (if vip-use-register
  842.              (progn
  843.                (cond ((and (<= ?a vip-use-register)
  844.                    (<= vip-use-register ?z))
  845.                   (copy-to-register
  846.                    vip-use-register (mark) (point) nil))
  847.                  ((and (<= ?A vip-use-register)
  848.                    (<= vip-use-register ?Z))
  849.                   (vip-append-to-register
  850.                    (+ vip-use-register 32) (mark) (point)))
  851.                  (t (setq vip-use-register nil)
  852.                 (error "")))
  853.                (setq vip-use-register nil)))
  854.          (delete-region (mark) (point)))
  855.            (open-line 1)
  856.            (if (= com ?C) (vip-change-mode-to-insert) (yank)))
  857.           ((= com ?d)
  858.            (if vip-use-register
  859.            (progn
  860.              (cond ((and (<= ?a vip-use-register)
  861.                  (<= vip-use-register ?z))
  862.                 (copy-to-register
  863.                  vip-use-register vip-com-point (point) nil))
  864.                ((and (<= ?A vip-use-register)
  865.                  (<= vip-use-register ?Z))
  866.                 (vip-append-to-register
  867.                  (+ vip-use-register 32) vip-com-point (point)))
  868.                (t (setq vip-use-register nil)
  869.                   (error "")))
  870.              (setq vip-use-register nil)))
  871.            (setq last-command
  872.              (if (eq last-command 'd-command) 'kill-region nil))
  873.            (kill-region vip-com-point (point))
  874.            (setq this-command 'd-command)
  875.            (if vip-ex-style-motion
  876.            (if (and (eolp) (not (bolp))) (backward-char 1))))
  877.           ((= com ?D)
  878.            (save-excursion
  879.          (set-mark vip-com-point)
  880.          (vip-enlarge-region (mark) (point))
  881.          (if vip-use-register
  882.              (progn
  883.                (cond ((and (<= ?a vip-use-register)
  884.                    (<= vip-use-register ?z))
  885.                   (copy-to-register
  886.                    vip-use-register (mark) (point) nil))
  887.                  ((and (<= ?A vip-use-register)
  888.                    (<= vip-use-register ?Z))
  889.                   (vip-append-to-register
  890.                    (+ vip-use-register 32) (mark) (point)))
  891.                  (t (setq vip-use-register nil)
  892.                 (error "")))
  893.                (setq vip-use-register nil)))
  894.          (setq last-command
  895.                (if (eq last-command 'D-command) 'kill-region nil))
  896.          (kill-region (mark) (point))
  897.          (if (eq m-com 'vip-line) (setq this-command 'D-command)))
  898.            (back-to-indentation))
  899.           ((= com ?y)
  900.            (if vip-use-register
  901.            (progn
  902.              (cond ((and (<= ?a vip-use-register)
  903.                  (<= vip-use-register ?z))
  904.                 (copy-to-register
  905.                  vip-use-register vip-com-point (point) nil))
  906.                ((and (<= ?A vip-use-register)
  907.                  (<= vip-use-register ?Z))
  908.                 (vip-append-to-register
  909.                  (+ vip-use-register 32) vip-com-point (point)))
  910.                (t (setq vip-use-register nil)
  911.                   (error "")))
  912.              (setq vip-use-register nil)))
  913.            (setq last-command nil)
  914.            (copy-region-as-kill vip-com-point (point))
  915.            (goto-char vip-com-point))
  916.           ((= com ?Y)
  917.            (save-excursion
  918.          (set-mark vip-com-point)
  919.          (vip-enlarge-region (mark) (point))
  920.          (if vip-use-register
  921.              (progn
  922.                (cond ((and (<= ?a vip-use-register)
  923.                    (<= vip-use-register ?z))
  924.                   (copy-to-register
  925.                    vip-use-register (mark) (point) nil))
  926.                  ((and (<= ?A vip-use-register)
  927.                    (<= vip-use-register ?Z))
  928.                   (vip-append-to-register
  929.                    (+ vip-use-register 32) (mark) (point)))
  930.                  (t (setq vip-use-register nil)
  931.                 (error "")))
  932.                (setq vip-use-register nil)))
  933.          (setq last-command nil)
  934.          (copy-region-as-kill (mark) (point)))
  935.            (goto-char vip-com-point))
  936.           ((or (= com ?!) (= com (- ?!)))
  937.            (save-excursion
  938.          (set-mark vip-com-point)
  939.          (vip-enlarge-region (mark) (point))
  940.          (shell-command-on-region
  941.           (mark) (point)
  942.           (if (= com ?!)
  943.               (setq vip-last-shell-com (vip-read-string "!"))
  944.             vip-last-shell-com)
  945.           t)))
  946.           ((= com ?=)
  947.            (save-excursion
  948.          (set-mark vip-com-point)
  949.          (vip-enlarge-region (mark) (point))
  950.          (if (> (mark) (point)) (exchange-point-and-mark))
  951.          (indent-region (mark) (point) nil)))
  952.           ((= com ?<)
  953.            (save-excursion
  954.          (set-mark vip-com-point)
  955.          (vip-enlarge-region (mark) (point))
  956.          (indent-rigidly (mark) (point) (- vip-shift-width)))
  957.            (goto-char vip-com-point))
  958.           ((= com ?>)
  959.            (save-excursion
  960.          (set-mark vip-com-point)
  961.          (vip-enlarge-region (mark) (point))
  962.          (indent-rigidly (mark) (point) vip-shift-width))
  963.            (goto-char vip-com-point))
  964.           ((>= com 128)
  965.            ;; this is special command #
  966.            (vip-special-prefix-com (- com 128)))
  967.           ((= com vip-buffer-search-char)
  968.            (setq vip-s-string (buffer-substring (point) vip-com-point))
  969.            (setq vip-s-forward t)
  970.            ;; read gmhist.el to grasp this.
  971.            (if vip-want-history
  972.            (progn
  973.              (put 'vip-search-history 'default vip-s-string)
  974.              (setq vip-search-history
  975.                (cons vip-s-string vip-search-history))))
  976.            (vip-search vip-s-string vip-s-forward 1))
  977.           ))
  978.     (if (or (= com vip-buffer-search-char)) nil
  979.       (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!))
  980.                       (- com) com)
  981.                 reg)))))
  982.  
  983. (defun vip-repeat (arg)
  984.   "(ARG)  Re-excute last destructive command.  vip-d-com has the form
  985. (COM ARG CH REG), where COM is the command to be re-executed, ARG is the
  986. argument for COM, CH is a flag for repeat, and REG is optional and if exists
  987. is the name of the register for COM."
  988.   (interactive "P")
  989.   (if (eq last-command 'vip-undo)
  990.       ;; if the last command was vip-undo, then undo-more
  991.       (vip-undo-more)
  992.     ;; otherwise execute the command stored in vip-d-com.  if arg is non-nil
  993.     ;; its prefix value is used as new prefix value for the command.
  994.     (let ((m-com (car vip-d-com))
  995.       (val (vip-P-val arg))
  996.       (com (car (cdr (cdr vip-d-com))))
  997.       (reg (nth 3 vip-d-com)))
  998.       (if (null val) (setq val (car (cdr vip-d-com))))
  999.       (if (null m-com) (error "No previous command to repeat."))
  1000.       (setq vip-use-register reg)
  1001.       (funcall m-com (cons val com)))))
  1002.  
  1003. (defun vip-special-prefix-com (char)
  1004.   "This command is invoked interactively by the key sequence #<char>"
  1005.   (cond ((= char ?c)
  1006.      (downcase-region (min vip-com-point (point))
  1007.               (max vip-com-point (point))))
  1008.     ((= char ?C)
  1009.      (upcase-region (min vip-com-point (point))
  1010.             (max vip-com-point (point))))
  1011.     ((= char ?g)
  1012.      (set-mark vip-com-point)
  1013.      (vip-global-execute))
  1014.     ((= char ?q)
  1015.      (set-mark vip-com-point)
  1016.      (vip-quote-region))
  1017.     ((= char ?s) (spell-region vip-com-point (point)))))
  1018.  
  1019.  
  1020. ;; undoing
  1021.  
  1022. (defun vip-undo ()
  1023.   "Undo previous change."
  1024.   (interactive)
  1025.   (message "undo!")
  1026.   (let ((modified (buffer-modified-p)))
  1027.     (undo-start)
  1028.     (undo-more 2)
  1029.     (if (and (eolp) (not (bolp))) (backward-char 1))
  1030.     (if (not modified) (set-buffer-modified-p t)))
  1031.   (setq this-command 'vip-undo))
  1032.  
  1033. (defun vip-undo-more ()
  1034.   "Continue undoing previous changes."
  1035.   (message "undo more!")
  1036.   (undo-more 1)
  1037.   (if (and (eolp) (not (bolp))) (backward-char 1))
  1038.   (setq this-command 'vip-undo))
  1039.  
  1040.  
  1041. ;; utilities
  1042.  
  1043. (defun vip-string-tail (str)
  1044.   (if (or (null str) (string= str "")) nil
  1045.     (substring str 1)))
  1046.  
  1047. (defun vip-yank-defun ()
  1048.   (mark-defun)
  1049.   (copy-region-as-kill (point) (mark)))
  1050.  
  1051. (defun vip-enlarge-region (beg end)
  1052.   "Enlarge region between BEG and END."
  1053.   (if (< beg end)
  1054.       (progn (goto-char beg) (set-mark end))
  1055.     (goto-char end)
  1056.     (set-mark beg))
  1057.   (beginning-of-line)
  1058.   (exchange-point-and-mark)
  1059.   (if (or (not (eobp)) (not (bolp))) (next-line 1))
  1060.   (beginning-of-line)
  1061.   (if (> beg end) (exchange-point-and-mark)))
  1062.  
  1063. (defun vip-global-execute ()
  1064.   "Call last keyboad macro for each line in the region."
  1065.   (if (> (point) (mark)) (exchange-point-and-mark))
  1066.   (beginning-of-line)
  1067.   (call-last-kbd-macro)
  1068.   (while (< (point) (mark))
  1069.     (forward-line 1)
  1070.     (beginning-of-line)
  1071.     (call-last-kbd-macro)))
  1072.  
  1073. (defun vip-quote-region ()
  1074.   "Quote region by inserting the user supplied string at the beginning of
  1075. each line in the region."
  1076.   (setq vip-quote-string
  1077.     (let ((str
  1078.            (vip-read-string "quote-string:" vip-quote-string)))
  1079.       (if (string= str "") vip-quote-string str)))
  1080.   (vip-enlarge-region (point) (mark))
  1081.   (if (> (point) (mark)) (exchange-point-and-mark))
  1082.   (insert vip-quote-string)
  1083.   (beginning-of-line)
  1084.   (forward-line 1)
  1085.   (while (and (< (point) (mark)) (bolp))
  1086.     (insert vip-quote-string)
  1087.     (beginning-of-line)
  1088.     (forward-line 1)))
  1089.  
  1090. (defun vip-end-with-a-newline-p (string)
  1091.   "Check if the string ends with a newline."
  1092.   (or (string= string "")
  1093.       (= (aref string (1- (length string))) ?\n)))
  1094.  
  1095. (defun vip-read-string-complete ()
  1096.   (interactive)
  1097.   (completer-complete-goto
  1098.     "^ \t\n\""
  1099.     completer-words
  1100.     'read-file-name-internal
  1101.     default-directory))
  1102.  
  1103. (defun vip-read-string-help ()
  1104.   (interactive)
  1105.   (completer-help))
  1106.     
  1107. (defun vip-read-string (prompt &optional init history-var)
  1108.   (let ((save-minibuffer-local-map (copy-keymap minibuffer-local-map)))
  1109.     (define-key minibuffer-local-map "\C-h" 'delete-backward-char)
  1110.     (define-key minibuffer-local-map "\C-w" 'delete-backward-word)
  1111.     (define-key minibuffer-local-map "\C-c" 'abort-recursive-edit)
  1112.     (define-key minibuffer-local-map "\C-v" 'quoted-insert)
  1113.     (define-key minibuffer-local-map vip-ESC-key 'exit-minibuffer)
  1114.     (if vip-filename-complete
  1115.     (progn
  1116.       (define-key minibuffer-local-map "\t" 'vip-read-string-complete)
  1117.       (define-key minibuffer-local-map "?" 'vip-read-string-help)))
  1118.     (let (str)
  1119.       (condition-case conditions
  1120.       (setq str (if vip-want-history
  1121.             (read-with-history-in
  1122.               (if history-var history-var 'vip-history)
  1123.               prompt init)
  1124.             (read-string prompt init)))
  1125.     (quit
  1126.       (setq minibuffer-local-map save-minibuffer-local-map)
  1127.       (signal 'quit nil)))
  1128.       (setq minibuffer-local-map save-minibuffer-local-map)
  1129.       str)))
  1130.  
  1131.  
  1132. ;; insertion commands
  1133.  
  1134. (defun vip-repeat-insert-command ()
  1135.   "This function is called when mode changes from insertion mode to
  1136. vi command mode.  It will repeat the insertion command if original insertion
  1137. command was invoked with argument > 1."
  1138.   (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com))))
  1139.     (if (and val (> val 1)) ;; first check that val is non-nil
  1140.     (progn        
  1141.       (setq vip-d-com (list i-com (1- val) ?r))
  1142.       (vip-repeat nil)
  1143.       (setq vip-d-com (list i-com val ?r))))))
  1144.  
  1145. (defun vip-insert (arg) ""
  1146.   (interactive "P")
  1147.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1148.     (setq vip-d-com (list 'vip-insert val ?r))
  1149.     (if com (vip-loop val (yank))
  1150.       (vip-change-mode-to-insert))))
  1151.  
  1152. (defun vip-append (arg)
  1153.   "Append after point."
  1154.   (interactive "P")
  1155.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1156.     (setq vip-d-com (list 'vip-append val ?r))
  1157.     (if (not (eolp)) (forward-char))
  1158.     (if (equal com ?r)
  1159.     (vip-loop val (yank))
  1160.       (vip-change-mode-to-insert))))
  1161.  
  1162. (defun vip-Append (arg)
  1163.   "Append at end of line."
  1164.   (interactive "P")
  1165.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1166.     (setq vip-d-com (list 'vip-Append val ?r))
  1167.     (end-of-line)
  1168.     (if (equal com ?r)
  1169.     (vip-loop val (yank))
  1170.       (vip-change-mode-to-insert))))
  1171.  
  1172. (defun vip-Insert (arg)
  1173.   "Insert before first non-white."
  1174.   (interactive "P")
  1175.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1176.     (setq vip-d-com (list 'vip-Insert val ?r))
  1177.     (back-to-indentation)
  1178.     (if (equal com ?r)
  1179.     (vip-loop val (yank))
  1180.       (vip-change-mode-to-insert))))
  1181.  
  1182. (defun vip-open-line (arg)
  1183.   "Open line below."
  1184.   (interactive "P")
  1185.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1186.     (setq vip-d-com (list 'vip-open-line val ?r))
  1187.     (let ((col (current-indentation)))
  1188.       (if (equal com ?r)
  1189.       (vip-loop val
  1190.             (progn
  1191.               (end-of-line)
  1192.               (newline 1)
  1193.               (if vip-auto-indent 
  1194.               (progn (setq vip-cted t) (indent-to col)))
  1195.               (yank)))
  1196.     (end-of-line)
  1197.     (newline 1)
  1198.     (if vip-auto-indent (progn (setq vip-cted t) (indent-to col)))
  1199.     (vip-change-mode-to-insert)))))
  1200.  
  1201. (defun vip-Open-line (arg)
  1202.   "Open line above."
  1203.   (interactive "P")
  1204.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1205.     (setq vip-d-com (list 'vip-Open-line val ?r))
  1206.     (let ((col (current-indentation)))
  1207.       (if (equal com ?r)
  1208.       (vip-loop val
  1209.             (progn
  1210.               (beginning-of-line)
  1211.               (open-line 1)
  1212.               (if vip-auto-indent 
  1213.               (progn (setq vip-cted t) (indent-to col)))
  1214.               (yank)))
  1215.     (beginning-of-line)
  1216.     (open-line 1)
  1217.     (if vip-auto-indent (progn (setq vip-cted t) (indent-to col)))
  1218.     (vip-change-mode-to-insert)))))
  1219.  
  1220. (defun vip-open-line-at-point (arg)
  1221.   "Open line at point."
  1222.   (interactive "P")
  1223.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1224.     (setq vip-d-com (list 'vip-open-line-at-point val ?r))
  1225.     (if (equal com ?r)
  1226.     (vip-loop val
  1227.           (progn
  1228.             (open-line 1)
  1229.             (yank)))
  1230.       (open-line 1)
  1231.       (vip-change-mode-to-insert))))
  1232.  
  1233. (defun vip-substitute (arg)
  1234.   "Substitute characters."
  1235.   (interactive "P")
  1236.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1237.       (set-mark (point))
  1238.       (forward-char val)
  1239.       (if (equal com ?r)
  1240.       (vip-change-subr (mark) (point))
  1241.     (vip-change (mark) (point)))
  1242.     (setq vip-d-com (list 'vip-substitute val ?r))))
  1243.  
  1244. (defun vip-substitute-line (arg)
  1245.   "Substitute lines."
  1246.   (interactive "p")
  1247.   (vip-line (cons arg ?C)))
  1248.  
  1249. (defun vip-overwrite-execute (&optional arg exclusive limit)
  1250.   (interactive)
  1251.   (let (com overrun (cont t))
  1252.     (if limit
  1253.     (if (> limit (point))
  1254.         (set-mark limit)
  1255.       (setq cont nil)))
  1256.     (while (and (not vip-need-to-exit-overwrite) cont)
  1257.       (setq com (vip-get-editor-command vip-insert-local-map global-map))
  1258.       (if (numberp com)
  1259.       (progn
  1260.         (if exclusive
  1261.         (progn
  1262.           (if (eolp) (forward-char 1))
  1263.           (insert (char-to-string com))
  1264.           (delete-char 1))
  1265.           (insert (char-to-string com))
  1266.           (if (not overrun)
  1267.           (if (not (eolp))
  1268.               (delete-char 1)
  1269.             (setq overrun t))))
  1270.         (if (and limit (= (point) (mark)))
  1271.         (progn
  1272.           (setq cont nil)
  1273.           (vip-change-mode-line "Insert")
  1274.           (vip-refresh-mode-line))))
  1275.     (command-execute com arg)))))
  1276.  
  1277. (defun vip-change-mode-to-overwrite (&optional arg exclusive limit)
  1278.   "Change mode to overwrite mode until optional limit is reached.
  1279. Also implement actual overwrite mode, eventually overwriting multiple
  1280. lines if exclusive is set to true."
  1281.   (interactive)
  1282.   (setq vip-need-to-exit-overwrite nil)
  1283.   (vip-change-mode-to-insert)
  1284.   (vip-change-mode-line "Replac")
  1285.   (vip-refresh-mode-line)
  1286.   (let ((echo echo-keystrokes))
  1287.     (setq echo-keystrokes 0)
  1288.     (vip-overwrite-execute arg exclusive limit)
  1289.     (setq echo-keystrokes echo)))
  1290.  
  1291. (defun vip-overwrite (arg) ""
  1292.   (interactive "P")
  1293.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1294.     (setq vip-d-com (list 'vip-overwrite val ?r))
  1295.     (if com
  1296.     (vip-loop val (yank))
  1297.       (setq last-command 'vip-overwrite)
  1298.       (vip-change-mode-to-overwrite arg))))
  1299.  
  1300.  
  1301. ;; line command
  1302.  
  1303. (defun vip-line (arg)
  1304.   (let ((val (car arg)) (com (cdr arg)))
  1305.     (move-marker vip-com-point (point))
  1306.     (next-line (1- val))
  1307.     (vip-execute-com 'vip-line val com)))
  1308.  
  1309. (defun vip-yank-line (arg)
  1310.   "Yank ARG lines (in vi's sense)"
  1311.   (interactive "P")
  1312.   (let ((val (vip-p-val arg)))
  1313.     (vip-line (cons val ?Y))))
  1314.  
  1315.  
  1316. ;; region command
  1317.  
  1318. (defun vip-region (arg)
  1319.   (interactive "P")
  1320.   (let ((val (vip-P-val arg))
  1321.     (com (vip-getcom arg)))
  1322.     (move-marker vip-com-point (point))
  1323.     (exchange-point-and-mark)
  1324.     (vip-execute-com 'vip-region val com)))
  1325.  
  1326. (defun vip-Region (arg)
  1327.   (interactive "P")
  1328.   (let ((val (vip-P-val arg))
  1329.     (com (vip-getCom arg)))
  1330.     (move-marker vip-com-point (point))
  1331.     (exchange-point-and-mark)
  1332.     (vip-execute-com 'vip-Region val com)))
  1333.  
  1334. (defun vip-replace-char (arg)
  1335.   "Replace the following ARG chars by the character read."
  1336.   (interactive "P")
  1337.   (if (and (eolp) (bolp)) (error "No character to replace"))
  1338.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)) (at-end nil))
  1339.     (if (eolp) (backward-char 1))
  1340.     (setq vip-d-com (list 'vip-replace-char val ?r))
  1341.     (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val)))
  1342.  
  1343. (defun vip-replace-char-subr (char arg)
  1344.   (delete-char arg t)
  1345.   (setq vip-d-char char)
  1346.   (vip-loop (if (> arg 0) arg (- arg)) 
  1347.         (if (eq char ?\C-m) (insert "\n") (insert char)))
  1348.   (backward-char arg))
  1349.  
  1350. (defun vip-replace-string ()
  1351.   "Replace string.  If you supply null string as the string to be replaced,
  1352. the query replace mode will toggle between string replace and regexp replace."
  1353.   (interactive)
  1354.   (let (str)
  1355.     (setq str (vip-read-string
  1356.            (if vip-re-replace "Replace regexp: " "Replace string: ")))
  1357.     (if (string= str "")
  1358.     (progn
  1359.       (setq vip-re-replace (not vip-re-replace))
  1360.       (message (format "Replace mode changed to %s."
  1361.                (if vip-re-replace "regexp replace"
  1362.                  "string replace"))))
  1363.       (if vip-re-replace
  1364.       (replace-regexp
  1365.        str
  1366.        (vip-read-string (format "Replace regexp \"%s\" with: " str)))
  1367.     (replace-string
  1368.      str
  1369.      (vip-read-string (format "Replace \"%s\" with: " str)))))))
  1370.  
  1371.  
  1372. ;; basic cursor movement.  j, k, l, h commands.
  1373.  
  1374. (defun vip-forward-char (arg)
  1375.   "Move point right ARG characters (left if ARG negative).On reaching end
  1376. of line, stop and signal error."
  1377.   (interactive "P")
  1378.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1379.     (if com (move-marker vip-com-point (point)))
  1380.     (if vip-ex-style-motion
  1381.     (progn
  1382.       ;; the boundary condition check gets weird here because forward-char
  1383.       ;; may be the parameter of a delete, and 'dl' works just like 'x' for
  1384.       ;; the last char on a line, so we have to allow the forward motion
  1385.       ;; before the 'vip-execute-com', but of course 'dl' doesn't work on 
  1386.       ;; an empty line, so we have to recognize that condition before the
  1387.       ;; 'vip-execute-com'
  1388.       (if (and (eolp) (bolp)) (error "") (forward-char val))
  1389.       (if com (vip-execute-com 'vip-forward-char val com))
  1390.       (if (eolp) (progn (backward-char 1) (error ""))))
  1391.       (forward-char val)
  1392.       (if com (vip-execute-com 'vip-forward-char val com)))))
  1393.  
  1394. (defun vip-backward-char (arg)
  1395.   "Move point left ARG characters (right if ARG negative).  On reaching
  1396. beginning of line, stop and signal error."
  1397.   (interactive "P")
  1398.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1399.     (if com (move-marker vip-com-point (point)))
  1400.     (if vip-ex-style-motion
  1401.     (progn
  1402.       (if (bolp) (error "") (backward-char val))
  1403.       (if com (vip-execute-com 'vip-backward-char val com)))
  1404.       (backward-char val)
  1405.       (if com (vip-execute-com 'vip-backward-char val com)))))
  1406.  
  1407.  
  1408. ;; word command
  1409. ;; vip is remarkably inconsistent in its backward and forward word movements
  1410. ;; there are also a couple of bugs in my vi. All these are hopefully
  1411. ;; removed in the following. Inheriting from ex, vip does not like to
  1412. ;; do deletions across lines, and makes a mess of them. The mess is
  1413. ;; reproduced below - to understand the code, just bring up vi and test
  1414. ;; its behavior. Generally speaking, words are formed from alpha's and
  1415. ;; nonalphas - <sp>,\t\n are separators for word movement. When executed
  1416. ;; with a destructive command, \n is usually left untouched for the
  1417. ;; last word. - Aamod
  1418.  
  1419. ;; skip only one \n
  1420. (defun vip-skip-separators(forward)
  1421.   (if forward
  1422.       (progn
  1423.     (skip-chars-forward " \t")
  1424.     (if (looking-at "\n")
  1425.         (progn
  1426.           (forward-char)
  1427.           (skip-chars-forward " \t"))))
  1428.     (skip-chars-backward " \t")
  1429.     (backward-char)
  1430.     (if (looking-at "\n")
  1431.     (skip-chars-backward " \t")
  1432.       (forward-char))))
  1433.  
  1434. (defun vip-forward-word-kernel(val)
  1435.   (while (> val 0)
  1436.     (cond ((looking-at (concat "[" vip-word-chars-alpha "]"))
  1437.        (skip-chars-forward vip-word-chars-alpha)
  1438.        (vip-skip-separators t))
  1439.       ((looking-at (concat "[" vip-word-chars-separator "]"))
  1440.        (vip-skip-separators t))
  1441.       ((looking-at (concat "[" vip-word-chars-nonalpha "]"))
  1442.        (skip-chars-forward vip-word-chars-nonalpha)
  1443.        (vip-skip-separators t)))
  1444.     (setq val (1- val))))
  1445.  
  1446. (defun vip-forward-word (arg)
  1447.   "Forward word."
  1448.   (interactive "P")
  1449.   (let ((val (vip-p-val arg))
  1450.     (com (vip-getcom arg)))
  1451.     (if com (move-marker vip-com-point (point)))
  1452.     (vip-forward-word-kernel val)
  1453.     (if com
  1454.     (progn
  1455.       (cond ((or (= com ?c) (= com (- ?c)))
  1456.          (skip-chars-backward " \t\n"))
  1457.         ((or (= com ?y) (= com (- ?y)))
  1458.          (skip-chars-backward "\n"))
  1459.         ((or (= com ?d) (= com (- ?d)))
  1460.          (skip-chars-backward "\n")))
  1461.       (vip-execute-com 'vip-forward-word val com)))))
  1462.  
  1463. (defun vip-forward-Word (arg)
  1464.   "Forward word delimited by white character."
  1465.   (interactive "P")
  1466.   (let ((val (vip-p-val arg))
  1467.     (com (vip-getcom arg)))
  1468.     (if com (move-marker vip-com-point (point)))
  1469.     (vip-loop val
  1470.           (progn
  1471.         (skip-chars-forward "^ \t\n")
  1472.         (vip-skip-separators t)))
  1473.     (if com 
  1474.     (progn
  1475.       (cond ((or (= com ?c) (= com (- ?c)))
  1476.          (skip-chars-backward " \t\n"))
  1477.           ((or (= com ?y) (= com (- ?y)))
  1478.          (skip-chars-backward "\n"))
  1479.         ((or (= com ?d) (= com (- ?d)))
  1480.          (skip-chars-backward "\n")))
  1481.       (vip-execute-com 'vip-forward-Word val com)))))
  1482.  
  1483. ;; end of word is a mess probably because I tried to reuse
  1484. ;; forward word -- someday it should be rewritten. All those looking-ats
  1485. ;; are not pretty. Whats more, the vip-word-chars etc. was a wrong choice
  1486. ;; too long. When I feel brave, I'll shorten 'em all.
  1487.  
  1488. (defun vip-end-of-word-kernel(val)
  1489.   (let ((was-sep (looking-at (concat "[" vip-word-chars-separator "]")))
  1490.     (next-sep 
  1491.      (save-excursion (forward-char) 
  1492.              (looking-at 
  1493.               (concat "[" vip-word-chars-separator "]")))))
  1494.     (if (vip-end-of-word-p) (forward-char))
  1495.     (if (looking-at "[ \t]*\n")
  1496.     (skip-chars-forward " \t\n")
  1497.       (if (vip-one-char-word-p) nil
  1498.     (vip-forward-word-kernel 1)
  1499.     (if (or was-sep (and next-sep (eq val 1)))
  1500.         (vip-forward-word-kernel 1))
  1501.     (vip-skip-separators nil)
  1502.     (backward-char)))))
  1503.  
  1504. (defun vip-end-of-word-p()
  1505.   (if (eobp) t
  1506.     (save-excursion
  1507.       (cond ((looking-at (concat "[" vip-word-chars-alpha "]"))
  1508.          (forward-char)
  1509.          (looking-at (concat "[^" vip-word-chars-alpha "]")))
  1510.         ((looking-at (concat "[" vip-word-chars-nonalpha "]"))
  1511.          (forward-char)
  1512.          (looking-at (concat "[" vip-word-chars-alpha 
  1513.                  vip-word-chars-separator "]")))))))
  1514.  
  1515. (defun vip-one-char-word-p()
  1516.   (let ((step 2))
  1517.     (save-excursion
  1518.       (cond ((looking-at (concat "[" vip-word-chars-alpha "]"))
  1519.          (if (bobp) (setq step 1) (backward-char))
  1520.          (if (or (bobp) (looking-at (concat "[^" vip-word-chars-alpha "]")))
  1521.          (progn
  1522.            (forward-char step)
  1523.            (looking-at (concat "[^" vip-word-chars-alpha "]")))
  1524.            nil))
  1525.         ((looking-at (concat "[" vip-word-chars-nonalpha "]"))
  1526.          (if (bobp) (setq step 1) (backward-char))
  1527.          (if (or (bobp) (looking-at (concat "[" vip-word-chars-alpha 
  1528.                         vip-word-chars-separator "]")))
  1529.          (progn
  1530.            (forward-char step)
  1531.            (looking-at (concat "[" vip-word-chars-alpha
  1532.                        vip-word-chars-separator  "]")))
  1533.            nil))))))
  1534.  
  1535. (defun vip-end-of-word (arg)
  1536.   "Move point to end of current word."
  1537.   (interactive "P")
  1538.   (let ((val (vip-p-val arg))
  1539.     (com (vip-getcom arg)))
  1540.     (if com (move-marker vip-com-point (point)))
  1541.     (vip-loop val (vip-end-of-word-kernel 1))
  1542.     (if com 
  1543.     (progn
  1544.       (forward-char)
  1545.       (vip-execute-com 'vip-end-of-word val com)))))
  1546.  
  1547. (defun vip-end-of-Word (arg)
  1548.   "Forward to end of word delimited by white character."
  1549.   (interactive "P")
  1550.   (let ((val (vip-p-val arg))
  1551.     (com (vip-getcom arg)))
  1552.     (if com (move-marker vip-com-point (point)))
  1553.     (vip-loop val
  1554.     (progn
  1555.       (vip-end-of-word-kernel 1)
  1556.       (if (not (re-search-forward 
  1557.             (concat "[" vip-word-chars-separator "]") nil t 1))
  1558.           (goto-char (point-max)))
  1559.       (skip-chars-backward " \t\n")
  1560.       (backward-char)))
  1561.     (if com 
  1562.     (progn
  1563.       (forward-char)
  1564.       (vip-execute-com 'vip-end-of-Word val com)))))
  1565.  
  1566. (defun vip-backward-word-kernel(val)
  1567.   (while (> val 0)
  1568.     (backward-char)
  1569.     (cond ((looking-at (concat "[" vip-word-chars-alpha "]"))
  1570.        (skip-chars-backward vip-word-chars-alpha))
  1571.       ((looking-at (concat "["  vip-word-chars-separator  "]"))
  1572.        (forward-char)
  1573.        (vip-skip-separators nil)
  1574.        (backward-char)
  1575.        (cond ((looking-at (concat "[" vip-word-chars-alpha "]"))
  1576.           (skip-chars-backward vip-word-chars-alpha))
  1577.          ((looking-at (concat "[" vip-word-chars-nonalpha "]"))
  1578.           (skip-chars-backward vip-word-chars-nonalpha))
  1579.          (t (forward-char))))
  1580.       ((looking-at (concat "[" vip-word-chars-nonalpha "]"))
  1581.        (skip-chars-backward vip-word-chars-nonalpha)))
  1582.     (setq val (1- val))))
  1583.  
  1584. (defun vip-backward-word (arg)
  1585.   "Backward word."
  1586.   (interactive "P")
  1587.   (let ((val (vip-p-val arg))
  1588.     (com (vip-getcom arg)))
  1589.     (if com
  1590.     (let (i)
  1591.       (if (setq i (save-excursion (backward-char) (looking-at "\n")))
  1592.           (backward-char))
  1593.       (move-marker vip-com-point (point))
  1594.       (if i (forward-char))))
  1595.     (vip-backward-word-kernel val)
  1596.     (if com (vip-execute-com 'vip-backward-word val com))))
  1597.  
  1598. (defun vip-backward-Word (arg)
  1599.   "Backward word delimited by white character."
  1600.   (interactive "P")
  1601.   (let ((val (vip-p-val arg))
  1602.     (com (vip-getcom arg)))
  1603.     (if com
  1604.     (let (i)
  1605.       (if (setq i (save-excursion (backward-char) (looking-at "\n")))
  1606.           (backward-char))
  1607.       (move-marker vip-com-point (point))
  1608.       (if i (forward-char))))
  1609.     (vip-loop val
  1610.           (progn 
  1611.         (vip-skip-separators nil)
  1612.         (skip-chars-backward "^ \t\n")))
  1613.     (if com (vip-execute-com 'vip-backward-Word val com))))
  1614.  
  1615.  
  1616. ;; line commands
  1617.  
  1618. (defun vip-beginning-of-line (arg)
  1619.   "Go to beginning of line."
  1620.   (interactive "P")
  1621.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1622.     (if com (move-marker vip-com-point (point)))
  1623.     (beginning-of-line val)
  1624.     (if com (vip-execute-com 'vip-beginning-of-line val com))))
  1625.  
  1626. (defun vip-bol-and-skip-white (arg)
  1627.   "Beginning of line at first non-white character."
  1628.   (interactive "P")
  1629.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1630.     (if com (move-marker vip-com-point (point)))
  1631.     (forward-to-indentation (1- val))
  1632.     (if com (vip-execute-com 'vip-bol-and-skip-white val com))))
  1633.  
  1634. (defun vip-goto-eol (arg)
  1635.   "Go to end of line."
  1636.   (interactive "P")
  1637.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1638.     (if com (move-marker vip-com-point (point)))
  1639.     (end-of-line val)
  1640.     (if com (vip-execute-com 'vip-goto-eol val com))
  1641.     (if vip-ex-style-motion
  1642.     (if (and (eolp) (not (bolp))) (backward-char 1)))))
  1643.  
  1644. (defun vip-next-line (arg)
  1645.   "Go to next line."
  1646.   (interactive "P")
  1647.   (save-excursion
  1648.     (end-of-line)
  1649.     (if (eobp) (error "Last line in buffer")))
  1650.   (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
  1651.     (if com (move-marker vip-com-point (point)))
  1652.     (next-line val)
  1653.     (if vip-ex-style-motion
  1654.     (if (and (eolp) (not (bolp))) (backward-char 1)))
  1655.     (setq this-command 'next-line)
  1656.     (if com (vip-execute-com 'vip-next-line val com))))
  1657.  
  1658. (defun vip-next-line-at-bol (arg)
  1659.   "Next line at beginning of line."
  1660.   (interactive "P")
  1661.   (save-excursion
  1662.     (end-of-line)
  1663.     (if (eobp) (error "Last line in buffer")))
  1664.   (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
  1665.     (if com (move-marker vip-com-point (point)))
  1666.     (next-line val)
  1667.     (back-to-indentation)
  1668.     (if com (vip-execute-com 'vip-next-line-at-bol val com))))
  1669.  
  1670. (defun vip-previous-line (arg)
  1671.   "Go to previous line."
  1672.   (interactive "P")
  1673.   (save-excursion
  1674.     (beginning-of-line)
  1675.     (if (bobp) (error "First line in buffer")))
  1676.   (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
  1677.     (if com (move-marker vip-com-point (point)))
  1678.     (next-line (- val))
  1679.     (if vip-ex-style-motion
  1680.     (if (and (eolp) (not (bolp))) (backward-char 1)))
  1681.     (setq this-command 'previous-line)
  1682.     (if com (vip-execute-com 'vip-previous-line val com))))
  1683.  
  1684. (defun vip-previous-line-at-bol (arg)
  1685.   "Previous line at beginning of line."
  1686.   (interactive "P")
  1687.   (save-excursion
  1688.     (beginning-of-line)
  1689.     (if (bobp) (error "First line in buffer")))
  1690.   (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
  1691.     (if com (move-marker vip-com-point (point)))
  1692.     (next-line (- val))
  1693.     (back-to-indentation)
  1694.     (if com (vip-execute-com 'vip-previous-line val com))))
  1695.  
  1696. (defun vip-change-to-eol (arg)
  1697.   "Change to end of line."
  1698.   (interactive "P")
  1699.   (vip-goto-eol (cons arg ?c)))
  1700.  
  1701. (defun vip-kill-line (arg)
  1702.   "Delete line."
  1703.   (interactive "P")
  1704.   (vip-goto-eol (cons arg ?d)))
  1705.  
  1706. (defun vip-erase-line (arg)
  1707.   "Erase line."
  1708.   (interactive "P")
  1709.   (vip-beginning-of-line (cons arg ?d)))
  1710.  
  1711.  
  1712. ;; moving around
  1713.  
  1714. (defun vip-goto-line (arg)
  1715.   "Go to ARG's line.  Without ARG go to end of buffer."
  1716.   (interactive "P")
  1717.   (let ((val (vip-P-val arg)) (com (vip-getCom arg)))
  1718.     (move-marker vip-com-point (point))
  1719.     (set-mark (point))
  1720.     (if (null val)
  1721.     (goto-char (point-max))
  1722.       (goto-char (point-min))
  1723.       (forward-line (1- val)))
  1724.     (back-to-indentation)
  1725.     (if com (vip-execute-com 'vip-goto-line val com))))
  1726.  
  1727. (defun vip-find-char (arg char forward offset)
  1728.   "Find ARG's occurence of CHAR on the current line.  If FORWARD then
  1729. search is forward, otherwise backward.  OFFSET is used to adjust point
  1730. after search."
  1731.   (let ((arg (if forward arg (- arg))) point)
  1732.     (save-excursion
  1733.       (save-restriction
  1734.     (if (> arg 0)
  1735.         (narrow-to-region
  1736.          ;; forward search begins here
  1737.          (if (eolp) (error "") (point))
  1738.          ;; forward search ends here
  1739.          (progn (next-line 1) (beginning-of-line) (point)))
  1740.       (narrow-to-region
  1741.        ;; backward search begins from here
  1742.        (if (bolp) (error "") (point))
  1743.        ;; backward search ends here
  1744.        (progn (beginning-of-line) (point))))
  1745.     ;; if arg > 0, point is forwarded before search.
  1746.     (if (> arg 0) (goto-char (1+ (point-min)))
  1747.       (goto-char (point-max)))
  1748.     (let ((case-fold-search nil))
  1749.       (search-forward (char-to-string char) nil 0 arg))
  1750.     (setq point (point))
  1751.     (if (or (and (> arg 0) (= point (point-max)))
  1752.         (and (< arg 0) (= point (point-min))))
  1753.         (error ""))))
  1754.     (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0))))))
  1755.  
  1756. (defun vip-find-char-forward (arg)
  1757.   "Find char on the line.  If called interactively read the char to find
  1758. from the terminal, and if called from vip-repeat, the char last used is
  1759. used.  This behaviour is controlled by the sign of prefix numeric value."
  1760.   (interactive "P")
  1761.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1762.     (if (> val 0)
  1763.     ;; this means that the function was called interactively
  1764.     (setq vip-f-char (read-char)
  1765.           vip-f-forward t
  1766.           vip-f-offset nil)
  1767.       (setq val (- val)))
  1768.     (if com (move-marker vip-com-point (point)))
  1769.     (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil)
  1770.     (setq val (- val))
  1771.     (if com
  1772.     (progn
  1773.       (setq vip-F-char vip-f-char);; set new vip-F-char
  1774.       (forward-char)
  1775.       (vip-execute-com 'vip-find-char-forward val com)))))
  1776.  
  1777. (defun vip-goto-char-forward (arg)
  1778.   "Go up to char ARG forward on line."
  1779.   (interactive "P")
  1780.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1781.     (if (> val 0)
  1782.     ;; this means that the function was called interactively
  1783.     (setq vip-f-char (read-char)
  1784.           vip-f-forward t
  1785.           vip-f-offset t)
  1786.       (setq val (- val)))
  1787.     (if com (move-marker vip-com-point (point)))
  1788.     (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t)
  1789.     (setq val (- val))
  1790.     (if com
  1791.     (progn
  1792.       (setq vip-F-char vip-f-char);; set new vip-F-char
  1793.       (forward-char)
  1794.       (vip-execute-com 'vip-goto-char-forward val com)))))
  1795.  
  1796. (defun vip-find-char-backward (arg)
  1797.   "Find char ARG on line backward."
  1798.   (interactive "P")
  1799.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1800.     (if (> val 0)
  1801.     ;; this means that the function was called interactively
  1802.     (setq vip-f-char (read-char)
  1803.           vip-f-forward nil
  1804.           vip-f-offset nil)
  1805.       (setq val (- val)))
  1806.     (if com (move-marker vip-com-point (point)))
  1807.     (vip-find-char
  1808.      val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil)
  1809.     (setq val (- val))
  1810.     (if com
  1811.     (progn
  1812.       (setq vip-F-char vip-f-char);; set new vip-F-char
  1813.       (vip-execute-com 'vip-find-char-backward val com)))))
  1814.  
  1815. (defun vip-goto-char-backward (arg)
  1816.   "Go up to char ARG backward on line."
  1817.   (interactive "P")
  1818.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1819.     (if (> val 0)
  1820.     ;; this means that the function was called interactively
  1821.     (setq vip-f-char (read-char)
  1822.           vip-f-forward nil
  1823.           vip-f-offset t)
  1824.       (setq val (- val)))
  1825.     (if com (move-marker vip-com-point (point)))
  1826.     (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t)
  1827.     (setq val (- val))
  1828.     (if com
  1829.     (progn
  1830.       (setq vip-F-char vip-f-char);; set new vip-F-char
  1831.       (vip-execute-com 'vip-goto-char-backward val com)))))
  1832.  
  1833. (defun vip-repeat-find (arg)
  1834.   "Repeat previous find command."
  1835.   (interactive "P")
  1836.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1837.     (if com (move-marker vip-com-point (point)))
  1838.     (vip-find-char val vip-f-char vip-f-forward vip-f-offset)
  1839.     (if com
  1840.     (progn
  1841.       (if vip-f-forward (forward-char))
  1842.       (vip-execute-com 'vip-repeat-find val com)))))
  1843.  
  1844. (defun vip-repeat-find-opposite (arg)
  1845.   "Repeat previous find command in the opposite direction."
  1846.   (interactive "P")
  1847.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  1848.     (if com (move-marker vip-com-point (point)))
  1849.     (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset)
  1850.     (if com
  1851.     (progn
  1852.       (if vip-f-forward (forward-char))
  1853.       (vip-execute-com 'vip-repeat-find-opposite val com)))))
  1854.  
  1855.  
  1856. ;; window scrolling etc.
  1857.  
  1858. (defun vip-other-window (arg)
  1859.   "Switch to other window."
  1860.   (interactive "p")
  1861.   (other-window arg)
  1862.   (or (not (eq vip-current-mode 'emacs-mode))
  1863.       (string= (buffer-name (current-buffer)) " *Minibuf-1*")
  1864.       (vip-change-mode-to-vi)))
  1865.  
  1866. (defun vip-window-top (arg)
  1867.   "Go to home window line."
  1868.   (interactive "P")
  1869.   (let ((val (vip-p-val arg))
  1870.     (com (vip-getCom arg)))
  1871.     (if com (move-marker vip-com-point (point)))
  1872.     (move-to-window-line (1- val))
  1873.     (if (not com) (back-to-indentation))
  1874.     (if com (vip-execute-com 'vip-window-top val com))))
  1875.  
  1876. (defun vip-window-middle (arg)
  1877.   "Go to middle window line."
  1878.   (interactive "P")
  1879.   (let ((val (vip-p-val arg))
  1880.     (com (vip-getCom arg)))
  1881.     (if com (move-marker vip-com-point (point)))
  1882.     (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
  1883.     (if (not com) (back-to-indentation))
  1884.     (if com (vip-execute-com 'vip-window-middle val com))))
  1885.  
  1886. (defun vip-window-bottom (arg)
  1887.   "Go to last window line."
  1888.   (interactive "P")
  1889.   (let ((val (vip-p-val arg))
  1890.     (com (vip-getCom arg)))
  1891.     (if com (move-marker vip-com-point (point)))
  1892.     (move-to-window-line (- val))
  1893.     (if (not com) (back-to-indentation))
  1894.     (if com (vip-execute-com 'vip-window-bottom val com))))
  1895.  
  1896. (defun vip-line-to-top (arg)
  1897.   "Put current line on the home line."
  1898.   (interactive "p")
  1899.   (recenter (1- arg)))
  1900.  
  1901. (defun vip-line-to-middle (arg)
  1902.   "Put current line on the middle line."
  1903.   (interactive "p")
  1904.   (recenter (+ (1- arg) (/ (1- (window-height)) 2))))
  1905.  
  1906. (defun vip-line-to-bottom (arg)
  1907.   "Put current line on the last line."
  1908.   (interactive "p")
  1909.   (recenter (- (window-height) (1+ arg))))
  1910.  
  1911.  
  1912. ;; paren match
  1913. ;; must correct this to only match ( to ) etc. On the other hand
  1914. ;; it is good that paren match gets confused, because that way you
  1915. ;; catch _all_ imbalances. - Aamod
  1916.  
  1917. (defun vip-paren-match (arg)
  1918.   "Go to the matching parenthesis."
  1919.   (interactive "P")
  1920.   (let ((com (vip-getcom arg)))
  1921.     (if (numberp arg)
  1922.     (if (or (> arg 99) (< arg 1))
  1923.         (error "Prefix must be between 1 and 99.")
  1924.       (goto-char
  1925.        (if (> (point-max) 80000)
  1926.            (* (/ (point-max) 100) arg)
  1927.          (/ (* (point-max) arg) 100)))
  1928.       (back-to-indentation))
  1929.       (let (lim)
  1930.     (if (and (eolp) (not (bolp))) (forward-char -1))
  1931.     (save-excursion
  1932.       (end-of-line)
  1933.       (setq lim (point)))
  1934.     (if (re-search-forward "[][(){}]" lim t) 
  1935.         (backward-char) 
  1936.       (error "No matchable character on line")))
  1937.       (cond ((looking-at "[\(\[{]")
  1938.          (if com (move-marker vip-com-point (point)))
  1939.          (forward-sexp 1)
  1940.          (if com
  1941.          (vip-execute-com 'vip-paren-match nil com)
  1942.            (backward-char)))
  1943.         ((looking-at "[])}]")
  1944.          (forward-char)
  1945.          (if com (move-marker vip-com-point (point)))
  1946.          (backward-sexp 1)
  1947.          (if com (vip-execute-com 'vip-paren-match nil com)))
  1948.         (t (error ""))))))
  1949.  
  1950.  
  1951. ;; sentence ,paragraph and heading
  1952.  
  1953. (defun vip-forward-sentence (arg)
  1954.   "Forward sentence."
  1955.   (interactive "P")
  1956.   (let ((val (vip-p-val arg))
  1957.     (com (vip-getcom arg)))
  1958.     (if com (move-marker vip-com-point (point)))
  1959.     (forward-sentence val)
  1960.     (if com (vip-execute-com 'vip-forward-sentence nil com))))
  1961.  
  1962. (defun vip-backward-sentence (arg)
  1963.   "Backward sentence."
  1964.   (interactive "P")
  1965.   (let ((val (vip-p-val arg))
  1966.     (com (vip-getcom arg)))
  1967.     (if com (move-marker vip-com-point (point)))
  1968.     (backward-sentence val)
  1969.     (if com (vip-execute-com 'vip-backward-sentence nil com))))
  1970.  
  1971. (defun vip-forward-paragraph (arg)
  1972.   "Forward paragraph."
  1973.   (interactive "P")
  1974.   (let ((val (vip-p-val arg))
  1975.     (com (vip-getCom arg)))
  1976.     (if com (move-marker vip-com-point (point)))
  1977.     (forward-paragraph val)
  1978.     (if com (vip-execute-com 'vip-forward-paragraph nil com))))
  1979.  
  1980. (defun vip-backward-paragraph (arg)
  1981.   "Backward paragraph."
  1982.   (interactive "P")
  1983.   (let ((val (vip-p-val arg))
  1984.     (com (vip-getCom arg)))
  1985.     (if com (move-marker vip-com-point (point)))
  1986.     (backward-paragraph val)
  1987.     (if com (vip-execute-com 'vip-backward-paragraph nil com))))
  1988.  
  1989. ;; should be mode-specific etc.
  1990.  
  1991. (defun vip-prev-heading(arg)
  1992.   (interactive "P")
  1993.   (let ((val (vip-p-val arg))
  1994.     (com (vip-getCom arg)))
  1995.     (if com (move-marker vip-com-point (point)))
  1996.     (re-search-backward vip-heading-start nil t val)
  1997.     (goto-char (match-beginning 0))
  1998.     (if com (vip-execute-com 'vip-prev-heading nil com))))
  1999.  
  2000. (defun vip-heading-end(arg)
  2001.   (interactive "P")
  2002.   (let ((val (vip-p-val arg))
  2003.     (com (vip-getCom arg)))
  2004.     (if com (move-marker vip-com-point (point)))
  2005.     (re-search-forward vip-heading-end nil t val)
  2006.     (goto-char (match-beginning 0))
  2007.     (if com (vip-execute-com 'vip-heading-end nil com))))
  2008.  
  2009. (defun vip-next-heading(arg)
  2010.   (interactive "P")
  2011.   (let ((val (vip-p-val arg))
  2012.     (com (vip-getCom arg)))
  2013.     (if com (move-marker vip-com-point (point)))
  2014.     (end-of-line)
  2015.     (re-search-forward vip-heading-start nil t val)
  2016.     (goto-char (match-beginning 0))
  2017.     (if com (vip-execute-com 'vip-next-heading nil com))))
  2018.  
  2019.  
  2020. ;; scrolling
  2021.  
  2022. (defun vip-scroll (arg)
  2023.   "Scroll to next screen."
  2024.   (interactive "p")
  2025.   (if (> arg 0)
  2026.       (while (> arg 0)
  2027.     (scroll-up)
  2028.     (setq arg (1- arg)))
  2029.     (while (> 0 arg)
  2030.       (scroll-down)
  2031.       (setq arg (1+ arg)))))
  2032.  
  2033. (defun vip-scroll-back (arg)
  2034.   "Scroll to previous screen."
  2035.   (interactive "p")
  2036.   (vip-scroll (- arg)))
  2037.  
  2038. (defun vip-scroll-down (arg)
  2039.   "Scroll up half screen."
  2040.   (interactive "P")
  2041.   (if (null arg) (scroll-down (/ (window-height) 2))
  2042.     (scroll-down arg)))
  2043.  
  2044. (defun vip-scroll-down-one (arg)
  2045.   "Scroll up one line."
  2046.   (interactive "p")
  2047.   (scroll-down arg))
  2048.  
  2049. (defun vip-scroll-up (arg)
  2050.   "Scroll down half screen."
  2051.   (interactive "P")
  2052.   (if (null arg) (scroll-up (/ (window-height) 2))
  2053.     (scroll-up arg)))
  2054.  
  2055. (defun vip-scroll-up-one (arg)
  2056.   "Scroll down one line."
  2057.   (interactive "p")
  2058.   (scroll-up arg))
  2059.  
  2060. ;; actually, emacs usually scrolls too slowly for this, but I still remember
  2061. ;; my surprise when emacs scrolled by half a page...
  2062.  
  2063. (setq scroll-step 1)
  2064.  
  2065.  
  2066. ;; splitting window
  2067.  
  2068. (defun vip-buffer-in-two-windows ()
  2069.   "Show current buffer in two windows."
  2070.   (interactive)
  2071.   (delete-other-windows)
  2072.   (split-window-vertically nil))
  2073.  
  2074.  
  2075. ;; searching
  2076.  
  2077. (defun vip-if-string(prompt)
  2078.   (let ((s (vip-read-string prompt "" 'vip-search-history)))
  2079.     (if (not (string= s ""))
  2080.     (setq vip-s-string s))))
  2081.  
  2082. (defun vip-search-forward (arg)
  2083.   "Search a string forward.  ARG is used to find the ARG's occurence
  2084. of the string.  Null string will repeat previous search"
  2085.   (interactive "P")
  2086.   (let ((val (vip-P-val arg)) (com (vip-getcom arg)))
  2087.     (setq vip-s-forward t)
  2088.     (vip-if-string "/")
  2089.     (vip-search vip-s-string t val)
  2090.     (if com
  2091.     (progn
  2092.       (move-marker vip-com-point (mark))
  2093.       (vip-execute-com 'vip-search-next val com)))))
  2094.  
  2095. (defun vip-search-backward (arg)
  2096.   "Search a string backward.  ARG is used to find the ARG's occurence
  2097. of the string.  Null string will repeat previous search"
  2098.   (interactive "P")
  2099.   (let ((val (vip-P-val arg)) (com (vip-getcom arg)))
  2100.     (setq vip-s-forward nil)
  2101.     (vip-if-string "?")
  2102.     (vip-search vip-s-string nil val)
  2103.     (if com
  2104.     (progn
  2105.       (move-marker vip-com-point (mark))
  2106.       (vip-execute-com 'vip-search-next val com)))))
  2107.  
  2108. (defun vip-search (string forward arg &optional no-offset init-point)
  2109.   "(STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of
  2110. STRING.  Search will be forward if FORWARD, otherwise backward."
  2111.   (let ((val (vip-p-val arg)) (com (vip-getcom arg))
  2112.     (null-arg (null (vip-P-val arg))) (offset (not no-offset))
  2113.     (case-fold-search vip-case-fold-search)
  2114.     (start-point (or init-point (point))))
  2115.     (if forward
  2116.     (condition-case conditions
  2117.         (progn
  2118.           (if (and offset (not (eobp))) (forward-char))
  2119.           (if vip-re-search
  2120.           (progn
  2121.             (re-search-forward string nil nil val)
  2122.             (re-search-backward string))
  2123.         (search-forward string nil nil val)
  2124.         (search-backward string))
  2125.           (push-mark start-point))
  2126.       (search-failed
  2127.        (if (and null-arg vip-search-wrap-around-t)
  2128.            (progn
  2129.          (goto-char (point-min))
  2130.          (vip-search string forward (cons 1 com) t start-point))
  2131.          (goto-char start-point)
  2132.          (signal 'search-failed (cdr conditions)))))
  2133.       (condition-case conditions
  2134.       (progn
  2135.         (if vip-re-search
  2136.         (re-search-backward string nil nil val)
  2137.           (search-backward string nil nil val))
  2138.         (push-mark start-point))
  2139.     (search-failed
  2140.      (if (and null-arg vip-search-wrap-around-t)
  2141.          (progn
  2142.            (goto-char (point-max))
  2143.            (vip-search string forward (cons 1 com) t start-point))
  2144.        (goto-char start-point)
  2145.        (signal 'search-failed (cdr conditions))))))))
  2146.  
  2147. (defun vip-search-next (arg)
  2148.   "Repeat previous search."
  2149.   (interactive "P")
  2150.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  2151.     (if (null vip-s-string) (error "No previous search string."))
  2152.     (vip-search vip-s-string vip-s-forward arg)
  2153.     (if com
  2154.     (progn
  2155.       (move-marker vip-com-point (mark))
  2156.       (vip-execute-com 'vip-search-next val com)))))
  2157.  
  2158. (defun vip-search-Next (arg)
  2159.   "Repeat previous search in the reverse direction."
  2160.   (interactive "P")
  2161.   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
  2162.     (if (null vip-s-string) (error "No previous search string."))
  2163.     (vip-search vip-s-string (not vip-s-forward) arg)
  2164.     (if com
  2165.     (progn
  2166.       (move-marker vip-com-point (mark))
  2167.       (vip-execute-com 'vip-search-Next val com)))))
  2168.  
  2169. ;; search contents of buffer defined by one of vip's motion commands
  2170. ;; repeatable via n and N
  2171.  
  2172. (defun vip-buffer-search-enable(&optional c)
  2173.   (if c (setq vip-buffer-search-char c))
  2174.   (define-key vip-mode-map (char-to-string vip-buffer-search-char)
  2175.     'vip-command-argument))
  2176.  
  2177.  
  2178. ;; visiting and killing files, buffers
  2179.  
  2180. (defun vip-switch-to-buffer ()
  2181.   "Switch to buffer in the current window."
  2182.   (interactive)
  2183.   (let (buffer)
  2184.     (setq buffer
  2185.       (read-buffer
  2186.        (format "switch to buffer \(%s\): "
  2187.            (buffer-name (other-buffer (current-buffer))))))
  2188.     (switch-to-buffer buffer)
  2189.     (vip-change-mode-to-vi)))
  2190.  
  2191. (defun vip-switch-to-buffer-other-window ()
  2192.   "Switch to buffer in another window."
  2193.   (interactive)
  2194.   (let (buffer)
  2195.     (setq buffer
  2196.       (read-buffer
  2197.        (format "Switch to buffer \(%s\): "
  2198.            (buffer-name (other-buffer (current-buffer))))))
  2199.     (switch-to-buffer-other-window buffer)
  2200.     (vip-change-mode-to-vi)))
  2201.  
  2202. (defun vip-kill-buffer ()
  2203.   "Kill a buffer."
  2204.   (interactive)
  2205.   (let (buffer buffer-name)
  2206.     (setq buffer-name
  2207.       (read-buffer
  2208.        (format "Kill buffer \(%s\): "
  2209.            (buffer-name (current-buffer)))))
  2210.     (setq buffer
  2211.       (if (null buffer-name)
  2212.           (current-buffer)
  2213.         (get-buffer buffer-name)))
  2214.     (if (null buffer) (error "Buffer %s nonexistent." buffer-name))
  2215.     (if (or (not (buffer-modified-p buffer))
  2216.         (y-or-n-p "Buffer is modified, are you sure? "))
  2217.     (kill-buffer buffer)
  2218.       (error "Buffer not killed."))))
  2219.  
  2220. (defun vip-find-file ()
  2221.   "Visit file in the current window."
  2222.   (interactive)
  2223.   (let (file)
  2224.     (setq file (read-file-name "visit file: "))
  2225.     (switch-to-buffer (find-file-noselect file))
  2226.     (vip-change-mode-to-vi)))
  2227.  
  2228. (defun vip-find-file-other-window ()
  2229.   "Visit file in another window."
  2230.   (interactive)
  2231.   (let (file)
  2232.     (setq file (read-file-name "Visit file: "))
  2233.     (switch-to-buffer-other-window (find-file-noselect file))
  2234.     (vip-change-mode-to-vi)))
  2235.  
  2236. (defun vip-info-on-file ()
  2237.   "Give information of the file associated to the current buffer."
  2238.   (interactive)
  2239.   (message "\"%s\"%s line %d of %d"
  2240.        (if (buffer-file-name) (buffer-file-name) "")
  2241.        (if (buffer-modified-p) " [Modified]" "")
  2242.        (let ((l (count-lines (point-min) (point)))) 
  2243.          (if (bolp) (1+ l) l))
  2244.        (1+ (count-lines (point-min) (point-max)))))
  2245.  
  2246.  
  2247. ;; yank and pop
  2248.  
  2249. (defun vip-yank (text)
  2250.   "yank TEXT silently."
  2251.   (save-excursion
  2252.     (vip-push-mark-silent (point))
  2253.     (insert text)
  2254.     (exchange-point-and-mark))
  2255.   (skip-chars-forward " \t"))
  2256.  
  2257. (defun vip-put-back (arg)
  2258.   "Put back after point/below line."
  2259.   (interactive "P")
  2260.   (let ((val (vip-p-val arg))
  2261.     (text (if vip-use-register
  2262.           (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9))
  2263.               (nth (- vip-use-register 49) kill-ring-yank-pointer)
  2264.             (get-register (downcase vip-use-register)))
  2265.         (car kill-ring-yank-pointer))))
  2266.     (if (null text)
  2267.     (if vip-use-register
  2268.         (let ((reg vip-use-register))
  2269.           (setq vip-use-register nil)
  2270.           (error "Nothing in register %c" reg))
  2271.       (error "")))
  2272.     (setq vip-use-register nil)
  2273.     (if (vip-end-with-a-newline-p text)
  2274.     (progn
  2275.       (next-line 1)
  2276.       (beginning-of-line))
  2277.       (if (and (not (eolp)) (not (eobp))) (forward-char)))
  2278.     (setq vip-d-com (list 'vip-put-back val nil vip-use-register))
  2279.     (vip-loop val (vip-yank text))))
  2280.  
  2281. (defun vip-Put-back (arg)
  2282.   "Put back at point/above line."
  2283.   (interactive "P")
  2284.   (let ((val (vip-p-val arg))
  2285.     (text (if vip-use-register
  2286.           (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9))
  2287.               (nth (- vip-use-register 49) kill-ring-yank-pointer)
  2288.             (get-register (downcase vip-use-register)))
  2289.         (car kill-ring-yank-pointer))))
  2290.     (if (null text)
  2291.     (if vip-use-register
  2292.         (let ((reg vip-use-register))
  2293.           (setq vip-use-register nil)
  2294.           (error "Nothing in register %c" reg))
  2295.       (error "")))
  2296.     (setq vip-use-register nil)
  2297.     (if (vip-end-with-a-newline-p text) (beginning-of-line))
  2298.     (setq vip-d-com (list 'vip-Put-back val nil vip-use-register))
  2299.     (vip-loop val (vip-yank text))))
  2300.  
  2301. (defun vip-delete-char (arg)
  2302.   "Delete character."
  2303.   (interactive "P")
  2304.   (let ((val (vip-p-val arg)))
  2305.     (setq vip-d-com (list 'vip-delete-char val nil))
  2306.     (if (> val 1)
  2307.     (save-excursion
  2308.       (let ((here (point)))
  2309.         (end-of-line)
  2310.         (if (> val (- (point) here))
  2311.         (setq val (- (point) here))))))
  2312.     (if (eq val 0) (setq val 1))
  2313.     (if vip-use-register
  2314.     (progn
  2315.       (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z))
  2316.           (vip-append-to-register
  2317.            (+ vip-use-register 32) (point) (- (point) val))
  2318.         (copy-to-register vip-use-register (point) (- (point) val) nil))
  2319.       (setq vip-use-register nil)))
  2320.     (if vip-ex-style-motion
  2321.     (progn
  2322.       (delete-char val t)
  2323.       (if (and (eolp) (not (bolp))) (backward-char 1)))
  2324.       (if (eolp)
  2325.       (delete-backward-char val t)
  2326.     (delete-char val t)))))
  2327.  
  2328. (defun vip-delete-backward-char (arg)
  2329.   "Delete previous character."
  2330.   (interactive "P")
  2331.   (let ((val (vip-p-val arg)))
  2332.     (setq vip-d-com (list 'vip-delete-backward-char val nil))
  2333.     (if (> val 1)
  2334.     (save-excursion
  2335.       (let ((here (point)))
  2336.         (beginning-of-line)
  2337.         (if (> val (- here (point)))
  2338.         (setq val (- here (point)))))))
  2339.     (if vip-use-register
  2340.     (progn
  2341.       (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z))
  2342.           (vip-append-to-register
  2343.            (+ vip-use-register 32) (point) (+ (point) val))
  2344.         (copy-to-register vip-use-register (point) (+ (point) val) nil))
  2345.       (setq vip-use-register nil)))
  2346.     (if (bolp) (ding)
  2347.       (delete-backward-char val t))))
  2348.  
  2349.  
  2350. ;; join lines.
  2351.  
  2352. (defun vip-join-lines (arg)
  2353.   "Join this line to next, if ARG is nil.  Otherwise, join ARG lines"
  2354.   (interactive "*P")
  2355.   (let ((val (vip-P-val arg)))
  2356.     (setq vip-d-com (list 'vip-join-lines val nil))
  2357.     (vip-loop (if (null val) 1 (1- val))
  2358.           (progn
  2359.         (end-of-line)
  2360.         (if (not (eobp))
  2361.             (progn
  2362.               (forward-line 1)
  2363.               (delete-region (point) (1- (point)))
  2364.               (fixup-whitespace)))))))
  2365.  
  2366.  
  2367. ;; making small changes
  2368.  
  2369. (defvar c-string)            ;Not the best name
  2370.  
  2371. (defun vip-finish-change ()
  2372.   (setq c-string (buffer-substring vip-change-beg-point (point)))
  2373.   (if (and (= (count-lines vip-change-beg-point vip-change-end-point) 1)
  2374.        (>= (point) vip-change-beg-point)
  2375.        (< (point) vip-change-end-point))
  2376.       (kill-region (point) vip-change-end-point))
  2377.   (setq vip-need-to-finish-change nil))
  2378.  
  2379. (defun vip-change (beg end)
  2380.   (if vip-use-register
  2381.       (progn
  2382.         (copy-to-register vip-use-register beg end nil)
  2383.         (setq vip-use-register nil)))
  2384.   (if (<= beg end)
  2385.       (progn
  2386.     (move-marker vip-change-beg-point beg)
  2387.     (move-marker vip-change-end-point end))
  2388.     (move-marker vip-change-beg-point end)
  2389.     (move-marker vip-change-end-point beg))
  2390.   (setq vip-need-to-finish-change t)
  2391.   (if (= (count-lines vip-change-beg-point vip-change-end-point) 1)
  2392.       (progn
  2393.     (goto-char vip-change-end-point)
  2394.     (delete-backward-char 1)
  2395.     (insert "$")
  2396.     (setq vip-change-end-point (point-marker))
  2397.     (goto-char vip-change-beg-point)
  2398.     (vip-change-mode-to-overwrite nil nil vip-change-end-point))
  2399.     (kill-region vip-change-beg-point vip-change-end-point)
  2400.     (vip-change-mode-to-insert)))
  2401.  
  2402. (defun vip-change-subr (beg end)
  2403.   (if vip-use-register
  2404.       (progn
  2405.     (copy-to-register vip-use-register beg end nil)
  2406.     (setq vip-use-register nil)))
  2407.   (kill-region beg end)
  2408.   (setq this-command 'vip-change)
  2409.   (insert c-string))
  2410.  
  2411. (defun vip-toggle-case (arg)
  2412.   "toggle character case."
  2413.   (interactive "P")
  2414.   (let ((val (vip-p-val arg)) (c))
  2415.     (setq vip-d-com (list 'vip-toggle-case val nil))
  2416.     (while (> val 0)
  2417.       (setq c (following-char))
  2418.       (delete-char 1 nil)
  2419.       (if (eq c (upcase c))
  2420.       (insert-char (downcase c) 1)
  2421.     (insert-char (upcase c) 1))
  2422.       (setq val (1- val)))))
  2423.  
  2424.  
  2425. ;; query replace
  2426.  
  2427. (defun vip-query-replace ()
  2428.   "Query replace.  If you supply null string as the string to be replaced,
  2429. the query replace mode will toggle between string replace and regexp replace."
  2430.   (interactive)
  2431.   (let (str)
  2432.     (setq str (vip-read-string
  2433.            (if vip-re-query-replace "Query replace regexp: "
  2434.          "Query replace: ")))
  2435.     (if (string= str "")
  2436.     (progn
  2437.       (setq vip-re-query-replace (not vip-re-query-replace))
  2438.       (message "Query replace mode changed to %s."
  2439.            (if vip-re-query-replace "regexp replace"
  2440.              "string replace")))
  2441.       (if vip-re-query-replace
  2442.       (query-replace-regexp
  2443.        str
  2444.        (vip-read-string (format "Query replace regexp \"%s\" with: " str)))
  2445.     (query-replace
  2446.      str
  2447.      (vip-read-string (format "Query replace \"%s\" with: " str)))))))
  2448.  
  2449.  
  2450. ;; marking
  2451.  
  2452. (defun vip-mark-beginning-of-buffer ()
  2453.   (interactive)
  2454.   (set-mark (point))
  2455.   (goto-char (point-min))
  2456.   (exchange-point-and-mark)
  2457.   (message "mark set at the beginning of buffer"))
  2458.  
  2459. (defun vip-mark-end-of-buffer ()
  2460.   (interactive)
  2461.   (set-mark (point))
  2462.   (goto-char (point-max))
  2463.   (exchange-point-and-mark)
  2464.   (message "mark set at the end of buffer"))
  2465.  
  2466. (defun vip-mark-point (char)
  2467.   (interactive "c")
  2468.   (cond ((and (<= ?a char) (<= char ?z))
  2469.      (point-to-register (- char (- ?a ?\C-a))))
  2470.     ((= char ?<) (vip-mark-beginning-of-buffer))
  2471.     ((= char ?>) (vip-mark-end-of-buffer))
  2472.     ((= char ?.) (push-mark))
  2473.     ((= char ?,) (set-mark-command 1))
  2474.     ((= char ?D) (mark-defun))
  2475.     (t (error ""))))
  2476.  
  2477. (defun vip-goto-mark (arg)
  2478.   "Go to mark."
  2479.   (interactive "P")
  2480.   (let ((char (read-char)) (com (vip-getcom arg)))
  2481.     (vip-goto-mark-subr char com nil)))
  2482.  
  2483. (defun vip-goto-mark-and-skip-white (arg)
  2484.   "Go to mark and skip to first non-white on line."
  2485.   (interactive "P")
  2486.   (let ((char (read-char)) (com (vip-getCom arg)))
  2487.     (vip-goto-mark-subr char com t)))
  2488.  
  2489. (defun vip-goto-mark-subr (char com skip-white)
  2490.   (cond ((and (<= ?a char) (<= char ?z))
  2491.      (let ((buff (current-buffer)))
  2492.        (if com (move-marker vip-com-point (point)))
  2493.        (goto-char (register-to-point (- char (- ?a ?\C-a))))
  2494.        (if skip-white (back-to-indentation))
  2495.        (vip-change-mode-to-vi)
  2496.        (if com
  2497.            (if (equal buff (current-buffer))
  2498.            (vip-execute-com (if skip-white
  2499.                     'vip-goto-mark-and-skip-white
  2500.                       'vip-goto-mark)
  2501.                     nil com)
  2502.          (switch-to-buffer buff)
  2503.          (goto-char vip-com-point)
  2504.          (vip-change-mode-to-vi)
  2505.          (error "")))))
  2506.     ((and (not skip-white) (= char ?`))
  2507.      (if com (move-marker vip-com-point (point)))
  2508.      (exchange-point-and-mark)
  2509.      (if com (vip-execute-com 'vip-goto-mark nil com)))
  2510.     ((and skip-white (= char ?'))
  2511.      (if com (move-marker vip-com-point (point)))
  2512.      (exchange-point-and-mark)
  2513.      (back-to-indentation)
  2514.      (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com)))
  2515.     (t (error ""))))
  2516.  
  2517. (defun vip-exchange-point-and-mark ()
  2518.   (interactive)
  2519.   (exchange-point-and-mark)
  2520.   (back-to-indentation))
  2521.  
  2522. ;; Input Mode Indentation
  2523.  
  2524. (defun vip-forward-indent()
  2525.   "Indent forward - C-d in VI"
  2526.   (interactive)
  2527.   (setq vip-cted t)
  2528.   (indent-to (+ (current-column) vip-shift-width)))
  2529.  
  2530. (defun vip-backward-indent()
  2531.   "Backtab, C-t in VI"
  2532.   (interactive)
  2533.   (if vip-cted
  2534.       (let ((p (point)) (c (current-column)) bol (indent t))
  2535.     (if (vip-looking-back "[0^]")
  2536.         (progn
  2537.           (if (= ?^ (preceding-char)) (setq vip-preserve-indent t))
  2538.           (delete-backward-char 1)
  2539.           (setq p (point))
  2540.           (setq indent nil)))
  2541.     (save-excursion
  2542.       (beginning-of-line)
  2543.       (setq bol (point)))
  2544.     (if (re-search-backward "[^ \t]" bol 1) (forward-char))
  2545.     (delete-region (point) p)
  2546.     (if indent
  2547.         (indent-to (- c vip-shift-width)))
  2548.     (if (or (bolp) (vip-looking-back "[^ \t]"))
  2549.         (setq vip-cted nil)))))
  2550.  
  2551. (defun vip-autoindent()
  2552.   "Auto Indentation, VI style"
  2553.   (interactive)
  2554.   (let ((col (current-indentation)))
  2555.     (if (not vip-preserve-indent)
  2556.     (setq vip-current-indent col)
  2557.       (setq vip-preserve-indent nil))
  2558.     (newline 1)
  2559.     (if vip-auto-indent
  2560.     (progn
  2561.       (setq vip-cted t)
  2562.       (indent-to vip-current-indent)))))
  2563.  
  2564. ;; Keyboard macros in registers
  2565.  
  2566. (defvar vip-last-macro-reg)
  2567.  
  2568. (defun vip-register-macro(count)
  2569.   "Keyboard macros in registers - a modified \@ command"
  2570.   (interactive "P")
  2571.   (let ((reg (downcase (read-char))))
  2572.     (cond ((or (and (<= ?a reg) (<= reg ?z)))
  2573.        (setq vip-last-macro-reg reg)
  2574.        (if defining-kbd-macro
  2575.            (progn
  2576.          (end-kbd-macro)
  2577.          (if (get-register reg)
  2578.              (if (not (y-or-n-p "Register contains data. Overwrite?"))
  2579.              (error "Keyboard macro defined but not written")))
  2580.          (set-register reg last-kbd-macro))
  2581.          (execute-kbd-macro (get-register reg) count)))
  2582.       ((or (= ?@ reg) (= ?\^j reg) (= ?\^m reg))
  2583.        (execute-kbd-macro (get-register vip-last-macro-reg) count))
  2584.       ((= ?\# reg)
  2585.        (start-kbd-macro count))
  2586.       ((= ?! reg)
  2587.        (setq reg (downcase (read-char)))
  2588.        (if (or (and (<= ?a reg) (<= reg ?z)))
  2589.            (progn
  2590.            (setq vip-last-macro-reg reg)
  2591.          (if (get-register reg)
  2592.              (if (not (y-or-n-p "Register contains data. Overwrite?"))
  2593.              (error "Keyboard macro defined but not written")))
  2594.            (set-register reg last-kbd-macro))))
  2595.       (t
  2596.        (error (format "Unknown register %c" reg))))))
  2597.        
  2598. ;; Viewing registers
  2599.  
  2600. (defun vip-ket-function(arg)
  2601.   "Function called by \], the ket. View registers and call \]\]"
  2602.   (interactive "P")
  2603.   (let ((reg (read-char)))
  2604.     (cond ((and (<= ?a reg) (<= reg ?z))
  2605.        (view-register reg))
  2606.       ((and (<= ?1 reg) (<= reg ?9))
  2607.        (let ((text (nth (- reg 49) kill-ring-yank-pointer)))
  2608.          (save-excursion 
  2609.            (set-buffer (get-buffer-create "*Output*"))
  2610.            (delete-region (point-min) (point-max))
  2611.            (insert (format "Register %c contains the string:\n" reg))
  2612.            (insert text)
  2613.            (goto-char (point-min)))
  2614.          (display-buffer "*Output*")))
  2615.       ((= ?\] reg)
  2616.        (vip-next-heading arg))
  2617.       (t (error "Invalid Command %c%c" last-command-char reg)))))
  2618.  
  2619. (defun vip-brac-function(arg)
  2620.   "Function called by \[, the brac. View textmarkers and call \[\["
  2621.   (interactive "P")
  2622.   (let ((reg (read-char)))
  2623.     (cond ((= ?\[ reg)
  2624.        (vip-prev-heading arg))
  2625.       ((= ?\] reg)
  2626.        (vip-heading-end arg))
  2627.       ((and (<= ?a reg) (<= reg ?z))
  2628.        (let* ((val (get-register (- reg (- ?a ?\C-a))))
  2629.           (buf 
  2630.            (if (not val) 
  2631.                (error 
  2632.             (format "Textmarker %c does not point anywhere" reg)) 
  2633.              (marker-buffer val))) 
  2634.           (pos (marker-position val))
  2635.           line-no text (s pos) (e pos))
  2636.          (save-excursion 
  2637.            (set-buffer (get-buffer-create "*Output*"))
  2638.            (delete-region (point-min) (point-max))
  2639.            (if (and buf pos)
  2640.            (progn
  2641.              (save-excursion 
  2642.                (set-buffer buf)
  2643.                (setq line-no (1+ (count-lines (point-min) val)))
  2644.                (goto-char pos)
  2645.                (beginning-of-line)
  2646.                (if (re-search-backward "[^ \t]" nil t)
  2647.                (progn
  2648.                  (beginning-of-line)
  2649.                  (setq s (point))))
  2650.                (goto-char pos)
  2651.                (forward-line 1)
  2652.                (if (re-search-forward "[^ \t]" nil t)
  2653.                (progn
  2654.                  (end-of-line)
  2655.                  (setq e (point))))
  2656.                (setq text (buffer-substring s e))
  2657.                (setq text (format "%s<%c>%s" 
  2658.                       (substring text 0 (- pos s)) 
  2659.                       reg (substring text (- pos s)))))
  2660.              (insert (format "Textmarker %c is in buffer %s at line %d.\n"
  2661.                      reg (buffer-name buf) line-no))
  2662.              (insert (format "Here is some text around %c:\n\n %s" 
  2663.                      reg text)))
  2664.          (insert (format "Textmarker %c not set anywhere" reg)))
  2665.            (goto-char (point-min)))
  2666.          (display-buffer "*Output*")))
  2667.       (t (error (format "Invalid Command %c%c" last-command-char reg))))))
  2668.   
  2669.  
  2670. ;; Misc
  2671.  
  2672. (defun vip-keyboard-quit ()
  2673.   "Abort partially formed or running command."
  2674.   (interactive)
  2675.   (setq vip-use-register nil)
  2676.   (keyboard-quit))
  2677.  
  2678. (defun vip-ctl-c-equivalent (arg)
  2679.   "Emulate C-c in Emacs mode."
  2680.   (interactive "P")
  2681.   (vip-ctl-key-equivalent "\C-c" arg))
  2682.  
  2683. (defun vip-ctl-x-equivalent (arg)
  2684.   "Emulate C-x in Emacs mode."
  2685.   (interactive "P")
  2686.   (vip-ctl-key-equivalent "\C-x" arg))
  2687.  
  2688. (defun vip-ctl-key-equivalent (key arg)
  2689.   (let ((char (read-char)))
  2690.     (if (and (<= ?A char) (<= char ?Z))
  2691.     (setq char (- char (- ?A ?\C-a))))
  2692.     (setq prefix-arg arg)
  2693.     (command-execute
  2694.      (vip-get-editor-command
  2695.       vip-emacs-local-map global-map
  2696.       (format "%s%s" key (char-to-string char))))))
  2697.  
  2698.  
  2699. ;; commands in insertion mode
  2700.  
  2701. (defun vip-delete-backward-word (arg)
  2702.   "Delete previous word."
  2703.   (interactive "p")
  2704.   (save-excursion
  2705.     (set-mark (point))
  2706.     (backward-word arg)
  2707.     (delete-region (point) (mark))))
  2708.  
  2709.  
  2710. ;; key bindings
  2711.  
  2712. (set 'vip-mode-map (make-keymap))
  2713.  
  2714. (define-key vip-mode-map "\C-^" 
  2715.   (function (lambda () (interactive) (vip-ex "e#"))))
  2716. (define-key vip-mode-map "\C-b" 'vip-scroll-back)
  2717. (define-key vip-mode-map "\C-d" 'vip-scroll-up)
  2718. (define-key vip-mode-map "\C-e" 'vip-scroll-up-one)
  2719. (define-key vip-mode-map "\C-f" 'vip-scroll)
  2720. (define-key vip-mode-map "\C-h" 'help-command)
  2721. (define-key vip-mode-map "\C-m" 'vip-next-line-at-bol)
  2722. (define-key vip-mode-map "\C-u" 'vip-scroll-down)
  2723. (define-key vip-mode-map "\C-x" 'vip-ctl-x)
  2724. (define-key vip-mode-map "\C-y" 'vip-scroll-down-one)
  2725. ;; vip-toggle-key is C-z by default
  2726. (define-key vip-mode-map vip-toggle-key 'vip-change-mode-to-emacs)
  2727. (define-key vip-mode-map vip-ESC-key 'vip-ESC)
  2728.  
  2729. ;; Suppress emacs keys that are not bound above.
  2730.  
  2731. (defun vip-make-emacs-keys-invisible(&optional map)
  2732.   (if (not map) (setq map vip-mode-map))
  2733.   (define-key map "\C-a" 'vip-nil)
  2734.   (define-key map "\C-c" 'vip-keyboard-quit)
  2735.   (define-key map "\C-g" 'vip-info-on-file)
  2736.   (define-key map "\C-i" 'vip-nil)
  2737.   (define-key map "\C-k" 'vip-nil)
  2738.   (define-key map "\C-l" 'redraw-display)
  2739.   (define-key map "\C-n" 'vip-next-line)
  2740.   (define-key map "\C-o" 'vip-nil)
  2741.   (define-key map "\C-p" 'vip-previous-line)
  2742.   (define-key map "\C-q" 'vip-nil)
  2743.   (define-key map "\C-r" 'redraw-display)
  2744.   (define-key map "\C-s" 'vip-nil)
  2745.   (define-key map "\C-t" 'vip-nil)
  2746.   (define-key map "\C-v" 'vip-nil)
  2747.   (define-key map "\C-w" 'vip-nil)
  2748.   )
  2749. (vip-make-emacs-keys-invisible)
  2750.  
  2751. ;; (defun vip-swap-cc-cg()
  2752. ;;   (define-key vip-mode-map "\C-c" 'vip-info-on-file)
  2753. ;;   (setq keyboard-translate-table (make-string 128 0))
  2754. ;;   (let ((i 0))
  2755. ;;     (while (< i 128)
  2756. ;;       (aset keyboard-translate-table i i)
  2757. ;;       (setq i (1+ i))))
  2758. ;;   (aset keyboard-translate-table ?\^c ?\^g)
  2759. ;;   (aset keyboard-translate-table ?\^g ?\^c))
  2760.  
  2761. ;; Unsuppress the emacs  key bindings
  2762.  
  2763. (defun vip-rebind-emacs-keys(&optional map fun)
  2764.   "Unsuppress emacs key bindings that were hidden for strict vi compatitibilty"
  2765.   (if (not map) (setq map vip-mode-map))
  2766.   (define-key map "\C-a" fun)
  2767.   (define-key map "\C-c" fun)
  2768.   (define-key map "\C-g" fun)
  2769.   (define-key map "\C-i" fun)
  2770.   (define-key map "\C-k" fun)
  2771.   (define-key map "\C-l" fun)
  2772.   (define-key map "\C-n" fun)
  2773.   (define-key map "\C-o" fun)
  2774.   (define-key map "\C-p" fun)
  2775.   (define-key map "\C-q" fun)
  2776.   (define-key map "\C-r" fun)
  2777.   (define-key map "\C-s" fun)
  2778.   (define-key map "\C-t" fun)
  2779.   (define-key map "\C-v" fun)
  2780.   (define-key map "\C-w" fun))
  2781.  
  2782. ;; For diddling with control keys not handled in the suppressor
  2783. ;; and unsuppressor
  2784.  
  2785. (defun vip-rebind-other-keys(&optional map fun)
  2786.   "Rebind"
  2787.   (if (not map) (setq map vip-mode-map))
  2788.   (define-key map "\C-b" fun)
  2789.   (define-key map "\C-e" fun)
  2790.   (define-key map "\C-f" fun)
  2791.   (define-key map "\C-g" fun)
  2792.   (define-key map "\C-u" fun)
  2793.   (define-key map "\C-y" fun)
  2794.   (define-key map "\C-z" fun)
  2795.   (define-key map "\C-]" fun)
  2796.   (define-key map "\C-_" fun)
  2797.   )
  2798.  
  2799. ;; unsuppress emacs keys in insert mode and vi-mode
  2800.  
  2801. (defun vip-make-emacs-keys-visible()
  2802.   (setq-default vip-insert-mode-vi-map nil)
  2803.   (setq vip-insert-mode-vi-map nil)
  2804. ;;  (fset 'vip-insert-mode-bindings (function (lambda() nil)))
  2805.   (vip-rebind-emacs-keys)
  2806.   (define-key vip-mode-map "\C-c" 'vip-ctl-c)
  2807.   (define-key vip-mode-map "\C-g" 'vip-keyboard-quit)
  2808.   )
  2809.  
  2810.  
  2811. ;; Just for the fun of it....
  2812. ;; Can the user now distinguish using keystrokes?? :-)
  2813.  
  2814. (defun vip-become-vi()
  2815.   (define-key vip-mode-map "@" 'vip-nil)
  2816.   (define-key vip-mode-map "*" 'vip-nil)
  2817.   (define-key vip-mode-map "#" 'vip-nil)
  2818.   (define-key vip-mode-map "\C-x" 'vip-nil)
  2819.   (define-key vip-mode-map "\C-z" 'suspend-emacs)
  2820.   (define-key vip-mode-map "\C-h" 'vip-backward-char)
  2821.   (define-key vip-mode-map "\C-_" 'vip-nil)
  2822.   (define-key vip-mode-map "\C-]" 'vip-nil);; This is actually tags.
  2823.   (setq vip-is-vi t)
  2824.   (global-set-key "\C-c" 'keyboard-quit))
  2825.  
  2826. (define-key vip-mode-map " " 'vip-forward-char)
  2827. (define-key vip-mode-map "!" 'vip-command-argument)
  2828. (define-key vip-mode-map "\"" 'vip-command-argument)
  2829. (define-key vip-mode-map "#" 'vip-command-argument)
  2830. (define-key vip-mode-map "$" 'vip-goto-eol)
  2831. (define-key vip-mode-map "%" 'vip-paren-match)
  2832. (define-key vip-mode-map "&" (function (lambda () (interactive) (vip-ex "&"))))
  2833. (define-key vip-mode-map "'" 'vip-goto-mark-and-skip-white)
  2834. (define-key vip-mode-map "(" 'vip-backward-sentence)
  2835. (define-key vip-mode-map ")" 'vip-forward-sentence)
  2836. (define-key vip-mode-map "*" 'call-last-kbd-macro)
  2837. (define-key vip-mode-map "+" 'vip-next-line-at-bol)
  2838. (define-key vip-mode-map "," 'vip-repeat-find-opposite)
  2839. (define-key vip-mode-map "-" 'vip-previous-line-at-bol)
  2840. (define-key vip-mode-map "." 'vip-repeat)
  2841. (define-key vip-mode-map "/" 'vip-search-forward)
  2842.  
  2843. (define-key vip-mode-map "0" 'vip-beginning-of-line)
  2844. (define-key vip-mode-map "1" 'vip-digit-argument)
  2845. (define-key vip-mode-map "2" 'vip-digit-argument)
  2846. (define-key vip-mode-map "3" 'vip-digit-argument)
  2847. (define-key vip-mode-map "4" 'vip-digit-argument)
  2848. (define-key vip-mode-map "5" 'vip-digit-argument)
  2849. (define-key vip-mode-map "6" 'vip-digit-argument)
  2850. (define-key vip-mode-map "7" 'vip-digit-argument)
  2851. (define-key vip-mode-map "8" 'vip-digit-argument)
  2852. (define-key vip-mode-map "9" 'vip-digit-argument)
  2853.  
  2854. (define-key vip-mode-map ":" 'vip-ex)
  2855. (define-key vip-mode-map ";" 'vip-repeat-find)
  2856. (define-key vip-mode-map "<" 'vip-command-argument)
  2857. (define-key vip-mode-map "=" 'vip-command-argument)
  2858. (define-key vip-mode-map ">" 'vip-command-argument)
  2859. (define-key vip-mode-map "?" 'vip-search-backward)
  2860. (define-key vip-mode-map "@" 'vip-register-macro)
  2861.  
  2862. (define-key vip-mode-map "A" 'vip-Append)
  2863. (define-key vip-mode-map "B" 'vip-backward-Word)
  2864. (define-key vip-mode-map "C" 'vip-change-to-eol)
  2865. (define-key vip-mode-map "D" 'vip-kill-line)
  2866. (define-key vip-mode-map "E" 'vip-end-of-Word)
  2867. (define-key vip-mode-map "F" 'vip-find-char-backward)
  2868. (define-key vip-mode-map "G" 'vip-goto-line)
  2869. (define-key vip-mode-map "H" 'vip-window-top)
  2870. (define-key vip-mode-map "I" 'vip-Insert)
  2871. (define-key vip-mode-map "J" 'vip-join-lines)
  2872. (define-key vip-mode-map "K" 'vip-nil)
  2873. (define-key vip-mode-map "L" 'vip-window-bottom)
  2874. (define-key vip-mode-map "M" 'vip-window-middle)
  2875. (define-key vip-mode-map "N" 'vip-search-Next)
  2876. (define-key vip-mode-map "O" 'vip-Open-line)
  2877. (define-key vip-mode-map "P" 'vip-Put-back)
  2878. (define-key vip-mode-map "Q" 'vip-query-replace)
  2879. (define-key vip-mode-map "R" 'vip-overwrite)
  2880. (define-key vip-mode-map "S" 'vip-substitute-line)
  2881. (define-key vip-mode-map "T" 'vip-goto-char-backward)
  2882. (define-key vip-mode-map "U" 'vip-undo)
  2883. (define-key vip-mode-map "V" 'vip-find-file-other-window)
  2884. (define-key vip-mode-map "W" 'vip-forward-Word)
  2885. (define-key vip-mode-map "X" 'vip-delete-backward-char)
  2886. (define-key vip-mode-map "Y" 'vip-yank-line)
  2887. (define-key vip-mode-map "ZZ" 'save-buffers-kill-emacs)
  2888.  
  2889. ;;(define-key vip-mode-map "\\" 'vip-escape-to-emacs)
  2890. (define-key vip-mode-map "\\" 'vip-nil)
  2891. (define-key vip-mode-map "[" 'vip-brac-function)
  2892. (define-key vip-mode-map "]" 'vip-ket-function)
  2893. (define-key vip-mode-map "_" 'vip-alternate-ESC)
  2894. (define-key vip-mode-map "^" 'vip-bol-and-skip-white)
  2895. (define-key vip-mode-map "`" 'vip-goto-mark)
  2896.  
  2897. (define-key vip-mode-map "a" 'vip-append)
  2898. (define-key vip-mode-map "b" 'vip-backward-word)
  2899. (define-key vip-mode-map "c" 'vip-command-argument)
  2900. (define-key vip-mode-map "d" 'vip-command-argument)
  2901. (define-key vip-mode-map "e" 'vip-end-of-word)
  2902. (define-key vip-mode-map "f" 'vip-find-char-forward)
  2903. (define-key vip-mode-map "g" 'vip-nil)
  2904. (define-key vip-mode-map "h" 'vip-backward-char)
  2905. (define-key vip-mode-map "i" 'vip-insert)
  2906. (define-key vip-mode-map "j" 'vip-next-line)
  2907. (define-key vip-mode-map "k" 'vip-previous-line)
  2908. (define-key vip-mode-map "l" 'vip-forward-char)
  2909. (define-key vip-mode-map "m" 'vip-mark-point)
  2910. (define-key vip-mode-map "n" 'vip-search-next)
  2911. (define-key vip-mode-map "o" 'vip-open-line)
  2912. (define-key vip-mode-map "p" 'vip-put-back)
  2913. (define-key vip-mode-map "q" 'vip-nil)
  2914. (define-key vip-mode-map "r" 'vip-replace-char)
  2915. (define-key vip-mode-map "s" 'vip-substitute)
  2916. (define-key vip-mode-map "t" 'vip-goto-char-forward)
  2917. (define-key vip-mode-map "u" 'vip-undo)
  2918. (define-key vip-mode-map "v" 'vip-find-file)
  2919. (define-key vip-mode-map "w" 'vip-forward-word)
  2920. (define-key vip-mode-map "x" 'vip-delete-char)
  2921. (define-key vip-mode-map "y" 'vip-command-argument)
  2922. (define-key vip-mode-map "zH" 'vip-line-to-top)
  2923. (define-key vip-mode-map "zM" 'vip-line-to-middle)
  2924. (define-key vip-mode-map "zL" 'vip-line-to-bottom)
  2925. (define-key vip-mode-map "z\C-m" 'vip-line-to-top)
  2926. (define-key vip-mode-map "z." 'vip-line-to-middle)
  2927. (define-key vip-mode-map "z-" 'vip-line-to-bottom)
  2928.  
  2929. (define-key vip-mode-map "{" 'vip-backward-paragraph)
  2930. (define-key vip-mode-map "|" 'vip-goto-col)
  2931. (define-key vip-mode-map "}" 'vip-forward-paragraph)
  2932. (define-key vip-mode-map "~" 'vip-toggle-case)
  2933. (define-key vip-mode-map "\177" 'vip-delete-backward-char)
  2934.  
  2935. ;;(define-key ctl-x-map "3" 'vip-buffer-in-two-windows)
  2936. ;;(define-key ctl-x-map "\C-i" 'insert-file)
  2937.  
  2938.  
  2939. (defun vip-get-history()
  2940.   (if (fboundp 'gmhist-define-keys)
  2941.       (message "WARNING: gmhist already loaded - cannot change mappings")
  2942.     (fset 'gmhist-define-keys 
  2943.       (function 
  2944.        (lambda (map)
  2945.          "Bind the standard history commands in MAP, a key map."
  2946.          (define-key map "\C-p" 'gmhist-previous)
  2947.          (define-key map "\C-n" 'gmhist-next)
  2948.          (define-key map "\C-r" 'gmhist-search-backward)
  2949.          (define-key map "\C-s" 'gmhist-search-forward)
  2950.          (define-key map "\C-t" 'gmhist-beginning)
  2951.          (define-key map "\C-l" 'gmhist-end)
  2952.          (define-key map "\C-o" 'gmhist-show)
  2953.          (define-key map "\C-h" 'delete-backward-char)
  2954.          (define-key map "\C-w" 'delete-backward-word)
  2955.          (define-key map "\C-u" 'vip-erase-line)
  2956.          (define-key map "\C-c" 'abort-recursive-edit)
  2957.          (define-key map "\C-v" 'quoted-insert)
  2958.          (if vip-filename-complete
  2959.          (define-key map "\t" 'vip-read-string-complete)
  2960.            (define-key map "?" 'vip-read-string-help))
  2961.          (define-key map vip-ESC-key 'exit-minibuffer)))))
  2962.   
  2963.   (require 'gmhist)
  2964.   (setq vip-want-history t)
  2965.   )
  2966.  
  2967. (defun vip-version ()
  2968.   (interactive)
  2969.   (message "VIP version 4.3 of October 1, 1991"))
  2970.  
  2971.  
  2972. ;; implement ex commands
  2973.  
  2974. (defvar ex-token-type nil
  2975.   "type of token.  if non-nil, gives type of address.  if nil, it
  2976. is a command.")
  2977.  
  2978. (defvar ex-token nil
  2979.   "value of token.")
  2980.  
  2981. (defvar ex-addresses nil
  2982.   "list of ex addresses")
  2983.  
  2984. (defvar ex-flag nil
  2985.   "flag for ex flag")
  2986.  
  2987. (defvar ex-buffer nil
  2988.   "name of ex buffer")
  2989.  
  2990. (defvar ex-count nil
  2991.   "value of ex count")
  2992.  
  2993. (defvar ex-g-flag nil
  2994.   "flag for global command")
  2995.  
  2996. (defvar ex-g-variant nil
  2997.   "if t global command is executed on lines not matching ex-g-pat")
  2998.  
  2999. (defvar ex-reg-exp nil
  3000.   "save reg-exp used in substitute")
  3001.  
  3002.  
  3003. (defvar ex-repl nil
  3004.   "replace pattern for substitute")
  3005.  
  3006. (defvar ex-g-pat nil
  3007.   "pattern for global command")
  3008.  
  3009. (defvar ex-map (make-sparse-keymap)
  3010.   "save commands for mapped keys")
  3011.  
  3012. (defvar ex-ins-map (make-sparse-keymap)
  3013.   "save commands for map!ped keys")
  3014.  
  3015. (defconst ex-find-file-shell "csh"
  3016.   "Shell in which to interpret wildcards")
  3017.  
  3018. (defvar ex-tag nil
  3019.   "save ex tag")
  3020.  
  3021. (defvar ex-file nil)
  3022.  
  3023. (defvar ex-variant nil)
  3024.  
  3025. (defvar ex-offset nil)
  3026.  
  3027. (defvar ex-append nil)
  3028.  
  3029. (defvar ex-cmdfile nil)
  3030.  
  3031. (defconst ex-cycle-other-window t
  3032.   "* :n cycles through files in other window")
  3033.  
  3034. (defconst ex-cycle-through-non-files nil
  3035.   "* cycle through *scratch* etc.")
  3036.  
  3037. (defun vip-nil ()
  3038.   (interactive)
  3039.   (error ""))
  3040.  
  3041. (defun vip-looking-back (str)
  3042.   "returns t if looking back reg-exp STR before point."
  3043.   (and (save-excursion (re-search-backward str nil t))
  3044.        (= (point) (match-end 0))))
  3045.  
  3046. (defun vip-check-sub (str)
  3047.   "check if ex-token is an initial segment of STR"
  3048.   (let ((length (length ex-token)))
  3049.     (if (and (<= length (length str))
  3050.          (string= ex-token (substring str 0 length)))
  3051.     (setq ex-token str)
  3052.       (setq ex-token-type "non-command"))))
  3053.  
  3054. (defun vip-get-ex-com-subr ()
  3055.   "get a complete ex command"
  3056.   (set-mark (point))
  3057.   (re-search-forward "[a-z][a-z]*")
  3058.   (setq ex-token-type "command")
  3059.   (setq ex-token (buffer-substring (point) (mark)))
  3060.   (exchange-point-and-mark)
  3061.   (cond ((looking-at "a")
  3062.      (cond ((looking-at "ab") (vip-check-sub "abbreviate"))
  3063.            ((looking-at "ar") (vip-check-sub "args"))
  3064.            (t (vip-check-sub "append"))))
  3065.     ((looking-at "[bh]") (setq ex-token-type "non-command"))
  3066.     ((looking-at "c")
  3067.      (cond ((looking-at "cd") (vip-check-sub "cd"))
  3068.            ((looking-at "ch") (vip-check-sub "chdir"))
  3069.            ((looking-at "co") (vip-check-sub "copy"))
  3070.            (t (vip-check-sub "change"))))
  3071.     ((looking-at "d") (vip-check-sub "delete"))
  3072.     ((looking-at "e")
  3073.      (if (looking-at "ex") (vip-check-sub "ex")
  3074.        (vip-check-sub "edit")))
  3075.     ((looking-at "f") (vip-check-sub "file"))
  3076.     ((looking-at "g") (vip-check-sub "global"))
  3077.     ((looking-at "i") (vip-check-sub "insert"))
  3078.     ((looking-at "j") (vip-check-sub "join"))
  3079.     ((looking-at "l") (vip-check-sub "list"))
  3080.     ((looking-at "m")
  3081.      (cond ((looking-at "map") (vip-check-sub "map"))
  3082.            ((looking-at "mar") (vip-check-sub "mark"))
  3083.            (t (vip-check-sub "move"))))
  3084.     ((looking-at "n")
  3085.      (if (looking-at "nu") (vip-check-sub "number")
  3086.        (vip-check-sub "next")))
  3087.     ((looking-at "o") (vip-check-sub "open"))
  3088.     ((looking-at "p")
  3089.      (cond ((looking-at "pre") (vip-check-sub "preserve"))
  3090.            ((looking-at "pu") (vip-check-sub "put"))
  3091.            ((looking-at "pw") (vip-check-sub "pwd"))
  3092.            (t (vip-check-sub "print"))))
  3093.     ((looking-at "q") (vip-check-sub "quit"))
  3094.     ((looking-at "r")
  3095.      (cond ((looking-at "rec") (vip-check-sub "recover"))
  3096.            ((looking-at "rew") (vip-check-sub "rewind"))
  3097.            (t (vip-check-sub "read"))))
  3098.     ((looking-at "s")
  3099.      (cond ((looking-at "se") (vip-check-sub "set"))
  3100.            ((looking-at "sh") (vip-check-sub "shell"))
  3101.            ((looking-at "so") (vip-check-sub "source"))
  3102.            ((looking-at "sr") (vip-check-sub "sr"))
  3103.            ((looking-at "st") (vip-check-sub "stop"))
  3104.            ((looking-at "sus") (vip-check-sub "suspend"))
  3105.            (t (vip-check-sub "substitute"))))
  3106.     ((looking-at "t")
  3107.      (if (looking-at "ta") (vip-check-sub "tag")
  3108.        (vip-check-sub "t")))
  3109.     ((looking-at "u")
  3110.      (cond ((looking-at "una") (vip-check-sub "unabbreviate"))
  3111.            ((looking-at "unm") (vip-check-sub "unmap"))
  3112.            (t (vip-check-sub "undo"))))
  3113.     ((looking-at "v")
  3114.      (cond ((looking-at "ve") (vip-check-sub "version"))
  3115.            ((looking-at "vi") (vip-check-sub "visual"))
  3116.            (t (vip-check-sub "v"))))
  3117.     ((looking-at "w")
  3118.      (if (looking-at "wq") (vip-check-sub "wq")
  3119.        (vip-check-sub "write")))
  3120.     ((looking-at "x") (vip-check-sub "xit"))
  3121.     ((looking-at "y") (vip-check-sub "yank"))
  3122.     ((looking-at "z") (vip-check-sub "z")))
  3123.   (exchange-point-and-mark))
  3124.  
  3125. (defun vip-get-ex-token ()
  3126.   "get an ex-token which is either an address or a command.
  3127. a token has type \(command, address, end-mark\) and value."
  3128.   (save-window-excursion
  3129.     (set-buffer " *ex-working-space*")
  3130.     (skip-chars-forward " \t|")
  3131.     (cond ((looking-at "[k#]")
  3132.        (setq ex-token-type "command")
  3133.        (setq ex-token (char-to-string (following-char)))
  3134.        (forward-char 1))
  3135.       ((looking-at "[a-z]") (vip-get-ex-com-subr))
  3136.       ((looking-at "\\.")
  3137.        (forward-char 1)
  3138.        (setq ex-token-type "dot"))
  3139.       ((looking-at "[0-9]")
  3140.        (set-mark (point))
  3141.        (re-search-forward "[0-9]*")
  3142.        (setq ex-token-type
  3143.          (cond ((string= ex-token-type "plus") "add-number")
  3144.                ((string= ex-token-type "minus") "sub-number")
  3145.                (t "abs-number")))
  3146.        (setq ex-token (string-to-int (buffer-substring (point) (mark)))))
  3147.       ((looking-at "\\$")
  3148.        (forward-char 1)
  3149.        (setq ex-token-type "end"))
  3150.       ((looking-at "%")
  3151.        (forward-char 1)
  3152.        (setq ex-token-type "whole"))
  3153.       ((looking-at "+")
  3154.        (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
  3155.           (forward-char 1)
  3156.           (insert "1")
  3157.           (backward-char 1)
  3158.           (setq ex-token-type "plus"))
  3159.          ((looking-at "+[0-9]")
  3160.           (forward-char 1)
  3161.           (setq ex-token-type "plus"))
  3162.          (t
  3163.           (error "Badly formed address"))))
  3164.       ((looking-at "-")
  3165.        (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
  3166.           (forward-char 1)
  3167.           (insert "1")
  3168.           (backward-char 1)
  3169.           (setq ex-token-type "minus"))
  3170.          ((looking-at "-[0-9]")
  3171.           (forward-char 1)
  3172.           (setq ex-token-type "minus"))
  3173.          (t
  3174.           (error "Badly formed address"))))
  3175.       ((looking-at "/")
  3176.        (forward-char 1)
  3177.        (set-mark (point))
  3178.        (let ((cont t))
  3179.          (while (and (not (eolp)) cont)
  3180.            ;;(re-search-forward "[^/]*/")
  3181.            (re-search-forward "[^/]*\\(/\\|\n\\)")
  3182.            (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
  3183.            (setq cont nil))))
  3184.        (backward-char 1)
  3185.        (setq ex-token (buffer-substring (point) (mark)))
  3186.        (if (looking-at "/") (forward-char 1))
  3187.        (setq ex-token-type "search-forward"))
  3188.       ((looking-at "\\?")
  3189.        (forward-char 1)
  3190.        (set-mark (point))
  3191.        (let ((cont t))
  3192.          (while (and (not (eolp)) cont)
  3193.            ;;(re-search-forward "[^\\?]*\\?")
  3194.            (re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
  3195.            (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
  3196.            (setq cont nil))
  3197.            (backward-char 1)
  3198.            (if (not (looking-at "\n")) (forward-char 1))))
  3199.        (setq ex-token-type "search-backward")
  3200.        (setq ex-token (buffer-substring (1- (point)) (mark))))
  3201.       ((looking-at ",")
  3202.        (forward-char 1)
  3203.        (setq ex-token-type "comma"))
  3204.       ((looking-at ";")
  3205.        (forward-char 1)
  3206.        (setq ex-token-type "semi-colon"))
  3207.       ((looking-at "[!=><&~]")
  3208.        (setq ex-token-type "command")
  3209.        (setq ex-token (char-to-string (following-char)))
  3210.        (forward-char 1))
  3211.       ((looking-at "'")
  3212.        (setq ex-token-type "goto-mark")
  3213.        (forward-char 1)
  3214.        (cond ((looking-at "'") (setq ex-token nil))
  3215.          ((looking-at "[a-z]") (setq ex-token (following-char)))
  3216.          (t (error "Marks are ' and a-z")))
  3217.        (forward-char 1))
  3218.       ((looking-at "\n")
  3219.        (setq ex-token-type "end-mark")
  3220.        (setq ex-token "goto"))
  3221.       (t
  3222.        (error "illegal token")))))
  3223.  
  3224. (defun vip-ex (&optional string)
  3225.   "ex commands within VIP."
  3226.   (interactive)
  3227.   (or string
  3228.       (setq ex-g-flag nil
  3229.         ex-g-variant nil))
  3230.   (let ((com-str (or string (vip-read-string ":" "" 'vip-ex-history)))
  3231.     (address nil) (cont t) (dot (point)))
  3232.     (save-window-excursion
  3233.       (set-buffer (get-buffer-create " *ex-working-space*"))
  3234.       (delete-region (point-min) (point-max))
  3235.       (insert com-str "\n")
  3236.       (goto-char (point-min)))
  3237.     (setq ex-token-type "")
  3238.     (setq ex-addresses nil)
  3239.     (while cont
  3240.       (vip-get-ex-token)
  3241.       (cond ((or (string= ex-token-type "command")
  3242.          (string= ex-token-type "end-mark"))
  3243.          (if address (setq ex-addresses (cons address ex-addresses)))
  3244.          (cond ((string= ex-token "global")
  3245.             (ex-global nil)
  3246.             (setq cont nil))
  3247.            ((string= ex-token "v")
  3248.             (ex-global t)
  3249.             (setq cont nil))
  3250.            (t
  3251.             (vip-execute-ex-command)
  3252.             (save-window-excursion
  3253.               (set-buffer " *ex-working-space*")
  3254.               (skip-chars-forward " \t")
  3255.               (cond ((looking-at "|")
  3256.                  (forward-char 1))
  3257.                 ((looking-at "\n")
  3258.                  (setq cont nil))
  3259.                 (t (error "Extra character at end of a command")))))))
  3260.         ((string= ex-token-type "non-command")
  3261.          (error (format "%s: Not an editor command" ex-token)))
  3262.         ((string= ex-token-type "whole")
  3263.          (setq ex-addresses
  3264.            (cons (point-max) (cons (point-min) ex-addresses))))
  3265.         ((string= ex-token-type "comma")
  3266.          (setq ex-addresses
  3267.            (cons (if (null address) (point) address) ex-addresses)))
  3268.         ((string= ex-token-type "semi-colon")
  3269.          (if address (setq dot address))
  3270.          (setq ex-addresses
  3271.            (cons (if (null address) (point) address) ex-addresses)))
  3272.         (t (let ((ans (vip-get-ex-address-subr address dot)))
  3273.          (if ans (setq address ans))))))))
  3274.  
  3275. (defun vip-get-ex-pat ()
  3276.   "get a regular expression and set ex-variant if found"
  3277.   (save-window-excursion
  3278.     (set-buffer " *ex-working-space*")
  3279.     (skip-chars-forward " \t")
  3280.     (if (looking-at "!")
  3281.     (progn
  3282.       (setq ex-g-variant (not ex-g-variant)
  3283.         ex-g-flag (not ex-g-flag))
  3284.       (forward-char 1)
  3285.       (skip-chars-forward " \t")))
  3286.     (let ((c (following-char)))
  3287.       (if (looking-at "[^\\\\\n]")
  3288.       (progn
  3289.         (forward-char 1)
  3290.         (set-mark (point))
  3291.         (let ((cont t))
  3292.           (while (and (not (eolp)) cont)
  3293.         (re-search-forward (format "[^%c]*\\(%c\\|\n\\)" c c))
  3294.         ;;(re-search-forward "[^/]*/")
  3295.         (if (not (vip-looking-back
  3296.               (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c)))
  3297.             (setq cont nil))))
  3298.         (setq ex-token
  3299.           (if (= (mark) (point)) ""
  3300.             (buffer-substring (1- (point)) (mark))))
  3301.         (backward-char 1))
  3302.     (setq ex-token nil))
  3303.       c)))
  3304.  
  3305. (defun vip-get-ex-command ()
  3306.   "get an ex command"
  3307.   (save-window-excursion
  3308.     (set-buffer " *ex-working-space*")
  3309.     (if (looking-at "/") (forward-char 1))
  3310.     (skip-chars-forward " \t")
  3311.     (cond ((looking-at "[a-z]")
  3312.        (vip-get-ex-com-subr)
  3313.        (if (string= ex-token-type "non-command")
  3314.            (error "%s: not an editor command" ex-token)))
  3315.       ((looking-at "[!=><&~]")
  3316.        (setq ex-token (char-to-string (following-char)))
  3317.        (forward-char 1))
  3318.       (t (error "Could not find an ex command")))))
  3319.  
  3320. (defun vip-get-ex-opt-gc (c)
  3321.   "get an ex option g or c"
  3322.   (save-window-excursion
  3323.     (set-buffer " *ex-working-space*")
  3324.     (if (looking-at (format "%c" c)) (forward-char 1))
  3325.     (skip-chars-forward " \t")
  3326.     (cond ((looking-at "g")
  3327.        (setq ex-token "g")
  3328.        (forward-char 1)
  3329.        t)
  3330.       ((looking-at "c")
  3331.        (setq ex-token "c")
  3332.        (forward-char 1)
  3333.        t)
  3334.       (t nil))))
  3335.  
  3336. (defun vip-default-ex-addresses (&optional whole-flag)
  3337.   "compute default addresses.  whole-flag means whole buffer."
  3338.   (cond ((null ex-addresses)
  3339.      (setq ex-addresses
  3340.            (if whole-flag
  3341.            (cons (point-max) (cons (point-min) nil))
  3342.          (cons (point) (cons (point) nil)))))
  3343.     ((null (cdr ex-addresses))
  3344.      (setq ex-addresses
  3345.            (cons (car ex-addresses) ex-addresses)))))
  3346.  
  3347. (defun vip-get-ex-address ()
  3348.   "get an ex-address as a marker and set ex-flag if a flag is found"
  3349.   (let ((address (point-marker)) (cont t))
  3350.     (setq ex-token "")
  3351.     (setq ex-flag nil)
  3352.     (while cont
  3353.       (vip-get-ex-token)
  3354.       (cond ((string= ex-token-type "command")
  3355.          (if (or (string= ex-token "print") (string= ex-token "list")
  3356.              (string= ex-token "#"))
  3357.          (progn
  3358.            (setq ex-flag t)
  3359.            (setq cont nil))
  3360.            (error "address expected")))
  3361.         ((string= ex-token-type "end-mark")
  3362.          (setq cont nil))
  3363.         ((string= ex-token-type "whole")
  3364.          (error "a trailing address is expected"))
  3365.         ((string= ex-token-type "comma")
  3366.          (error "Extra characters after an address"))
  3367.         (t (let ((ans (vip-get-ex-address-subr address (point-marker))))
  3368.          (if ans (setq address ans))))))
  3369.     address))
  3370.  
  3371. (defun vip-get-ex-address-subr (old-address dot)
  3372.   "returns an address as a point"
  3373.   (let ((address nil))
  3374.     (if (null old-address) (setq old-address dot))
  3375.     (cond ((string= ex-token-type "dot")
  3376.        (setq address dot))
  3377.       ((string= ex-token-type "add-number")
  3378.        (save-excursion
  3379.          (goto-char old-address)
  3380.          (forward-line (if (= old-address 0) (1- ex-token) ex-token))
  3381.          (setq address (point-marker))))
  3382.       ((string= ex-token-type "sub-number")
  3383.        (save-excursion
  3384.          (goto-char old-address)
  3385.          (forward-line (- ex-token))
  3386.          (setq address (point-marker))))
  3387.       ((string= ex-token-type "abs-number")
  3388.        (save-excursion
  3389.          (goto-char (point-min))
  3390.          (if (= ex-token 0) (setq address 0)
  3391.            (forward-line (1- ex-token))
  3392.            (setq address (point-marker)))))
  3393.       ((string= ex-token-type "end")
  3394.        (setq address (point-max-marker)))
  3395.       ((string= ex-token-type "plus") t);; do nothing
  3396.       ((string= ex-token-type "minus") t);; do nothing
  3397.       ((string= ex-token-type "search-forward")
  3398.        (save-excursion
  3399.          (ex-search-address t)
  3400.          (setq address (point-marker))))
  3401.       ((string= ex-token-type "search-backward")
  3402.        (save-excursion
  3403.          (ex-search-address nil)
  3404.          (setq address (point-marker))))
  3405.       ((string= ex-token-type "goto-mark")
  3406.        (save-excursion
  3407.          (if (null ex-token)
  3408.          (exchange-point-and-mark)
  3409.            (goto-char (register-to-point (- ex-token (- ?a ?\C-a)))))
  3410.          (setq address (point-marker)))))
  3411.     address))
  3412.  
  3413. (defun ex-search-address (forward)
  3414.   "search pattern and set address"
  3415.   (if (string= ex-token "")
  3416.       (if (null vip-s-string) (error "No previous search string")
  3417.     (setq ex-token vip-s-string))
  3418.     (setq vip-s-string ex-token))
  3419.   (if forward
  3420.       (progn
  3421.     (forward-line 1)
  3422.     (re-search-forward ex-token))
  3423.     (forward-line -1)
  3424.     (re-search-backward ex-token)))
  3425.  
  3426. (defun vip-get-ex-buffer ()
  3427.   "get a buffer name and set ex-count and ex-flag if found"
  3428.   (setq ex-buffer nil)
  3429.   (setq ex-count nil)
  3430.   (setq ex-flag nil)
  3431.   (save-window-excursion
  3432.     (set-buffer " *ex-working-space*")
  3433.     (skip-chars-forward " \t")
  3434.     (if (looking-at "[a-zA-Z]")
  3435.     (progn
  3436.       (setq ex-buffer (following-char))
  3437.       (forward-char 1)
  3438.       (skip-chars-forward " \t")))
  3439.     (if (looking-at "[0-9]")
  3440.     (progn
  3441.       (set-mark (point))
  3442.       (re-search-forward "[0-9][0-9]*")
  3443.       (setq ex-count (string-to-int (buffer-substring (point) (mark))))
  3444.       (skip-chars-forward " \t")))
  3445.     (if (looking-at "[pl#]")
  3446.     (progn
  3447.       (setq ex-flag t)
  3448.       (forward-char 1)))
  3449.     (if (not (looking-at "[\n|]"))
  3450.     (error "Illegal extra characters"))))
  3451.  
  3452. (defun vip-get-ex-count ()
  3453.   (setq ex-variant nil
  3454.     ex-count nil
  3455.     ex-flag nil)
  3456.   (save-window-excursion
  3457.     (set-buffer " *ex-working-space*")
  3458.     (skip-chars-forward " \t")
  3459.     (if (looking-at "!")
  3460.     (progn
  3461.       (setq ex-variant t)
  3462.       (forward-char 1)))
  3463.     (skip-chars-forward " \t")
  3464.     (if (looking-at "[0-9]")
  3465.     (progn
  3466.       (set-mark (point))
  3467.       (re-search-forward "[0-9][0-9]*")
  3468.       (setq ex-count (string-to-int (buffer-substring (point) (mark))))
  3469.       (skip-chars-forward " \t")))
  3470.     (if (looking-at "[pl#]")
  3471.     (progn
  3472.       (setq ex-flag t)
  3473.       (forward-char 1)))
  3474.     (if (not (looking-at "[\n|]"))
  3475.     (error "Illegal extra characters"))))
  3476.  
  3477. (defun ex-expand-filsyms (cmd buf)
  3478.   "expand \% and \# in ex command"
  3479.   (let (cf pf ret)
  3480.     (save-excursion 
  3481.       (set-buffer buf)
  3482.       (setq cf buffer-file-name)
  3483.       (setq pf (ex-next t)))
  3484.     (if (and (null cf) (string-match "[^\\]%\\|\\`%" cmd))
  3485.     (error "No current file to substitute for \%"))
  3486.     (if (and (null pf) (string-match "[^\\]#\\|\\`#" cmd))
  3487.     (error "No alternate file to substitute for #"))
  3488.     (save-excursion
  3489.       (set-buffer (get-buffer-create " ex-tmp"))
  3490.       (insert cmd)
  3491.       (goto-char (point-min))
  3492.       (while (re-search-forward "%\\|#" nil t)
  3493.     (let ((data (match-data)) 
  3494.           (char (buffer-substring (match-beginning 0) (match-end 0))))
  3495.       (if (vip-looking-back (concat "\\\\" char))
  3496.           (replace-match char)
  3497.         (store-match-data data)
  3498.         (if (string= char "%")
  3499.         (replace-match cf)
  3500.           (replace-match pf)))))
  3501.       (end-of-line)
  3502.       (setq ret (buffer-substring (point-min) (point)))
  3503.       (kill-buffer (current-buffer))
  3504.       (message "%s" ret))
  3505.     ret))
  3506.  
  3507. (defun vip-get-ex-file ()
  3508.   "get a file name and set ex-variant, ex-append and ex-offset if found"
  3509.   (let ((file-buf (current-buffer)))
  3510.     (setq ex-file nil
  3511.       ex-variant nil
  3512.       ex-append nil
  3513.       ex-offset nil
  3514.       ex-cmdfile nil)
  3515.     (save-window-excursion
  3516.       (set-buffer " *ex-working-space*")
  3517.       (skip-chars-forward " \t")
  3518.       (if (looking-at "!")
  3519.       (if (or (not (vip-looking-back "[ \t]"))
  3520.           (save-excursion
  3521.             (forward-char 1)
  3522.             (looking-at "[ \t]")))
  3523.           (progn
  3524.         (setq ex-variant t)
  3525.         (forward-char 1)
  3526.         (skip-chars-forward " \t"))
  3527.         (setq ex-cmdfile t)
  3528.         (forward-char 1)))
  3529.       (if (looking-at ">>")
  3530.       (progn
  3531.         (setq ex-append t
  3532.           ex-variant t)
  3533.         (forward-char 2)
  3534.         (skip-chars-forward " \t")))
  3535.       (if (looking-at "+")
  3536.       (progn
  3537.         (forward-char 1)
  3538.         (set-mark (point))
  3539.         (re-search-forward "[ \t\n]")
  3540.         (backward-char 1)
  3541.         (setq ex-offset (buffer-substring (point) (mark)))
  3542.         (forward-char 1)
  3543.         (skip-chars-forward " \t")))
  3544.       (set-mark (point))
  3545.       (re-search-forward "[ \t\n|]")
  3546.       (backward-char 1)
  3547.       (setq ex-file 
  3548.         (ex-expand-filsyms (buffer-substring (point) (mark)) file-buf)))))
  3549.  
  3550. (defun vip-execute-ex-command ()
  3551.   "execute ex command using the value of addresses."
  3552.   (cond ((string= ex-token "args") (ex-args))
  3553.     ((string= ex-token "copy") (ex-copy nil))
  3554.     ((string= ex-token "cd") (ex-cd))
  3555.     ((string= ex-token "chdir") (ex-cd))
  3556.     ((string= ex-token "delete") (ex-delete))
  3557.     ((string= ex-token "edit") (ex-edit))
  3558.     ((string= ex-token "file") (vip-info-on-file))
  3559.     ((string= ex-token "goto") (ex-goto))
  3560.     ;;((string= ex-token "global") (ex-global nil))
  3561.     ((string= ex-token "join") (ex-line "join"))
  3562.     ((string= ex-token "k") (ex-mark))
  3563.     ((string= ex-token "mark") (ex-mark))
  3564.     ((string= ex-token "map") (ex-map))
  3565.     ((string= ex-token "move") (ex-copy t))
  3566.     ((string= ex-token "next") (ex-next))
  3567.     ((string= ex-token "put") (ex-put))
  3568.     ((string= ex-token "pwd") (ex-pwd))
  3569.     ((string= ex-token "preserve") (ex-preserve))
  3570.     ((string= ex-token "quit") (ex-quit))
  3571.     ((string= ex-token "read") (ex-read))
  3572.     ((string= ex-token "recover") (ex-recover))
  3573.     ((string= ex-token "rewind") (ex-rewind))
  3574.     ((string= ex-token "set") (ex-set))
  3575.     ((string= ex-token "shell") (ex-shell))
  3576.     ((string= ex-token "source") (ex-source))
  3577.     ((string= ex-token "sr") (ex-substitute t t))
  3578.     ((string= ex-token "substitute") (ex-substitute))
  3579.     ((string= ex-token "suspend") (suspend-emacs))
  3580.     ((string= ex-token "stop") (suspend-emacs))
  3581.     ((string= ex-token "t") (ex-copy nil))
  3582.     ((string= ex-token "tag") (ex-tag))
  3583.     ((string= ex-token "undo") (vip-undo))
  3584.     ((string= ex-token "unmap") (ex-unmap))
  3585.     ;;((string= ex-token "v") (ex-global t))
  3586.     ((string= ex-token "version") (vip-version))
  3587.     ((string= ex-token "visual") (ex-edit))
  3588.     ((string= ex-token "write") (ex-write nil))
  3589.     ((string= ex-token "wq") (ex-write t))
  3590.     ((string= ex-token "xit") (ex-write t))
  3591.     ((string= ex-token "yank") (ex-yank))
  3592.     ((string= ex-token "!") (ex-command))
  3593.     ((string= ex-token "=") (ex-line-no))
  3594.     ((string= ex-token ">") (ex-line "right"))
  3595.     ((string= ex-token "<") (ex-line "left"))
  3596.     ((string= ex-token "&") (ex-substitute t))
  3597.     ((string= ex-token "~") (ex-substitute t t))
  3598.     ((or (string= ex-token "append")
  3599.          (string= ex-token "change")
  3600.          (string= ex-token "insert")
  3601.          (string= ex-token "open")
  3602.          )
  3603.      (error (format "%s: no such command from VIP" ex-token)))
  3604.     ((or (string= ex-token "abbreviate")
  3605.          (string= ex-token "list")
  3606.          (string= ex-token "print")
  3607.          (string= ex-token "unabbreviate")
  3608.          (string= ex-token "z")
  3609.          )
  3610.      (error (format "%s: not implemented in VIP" ex-token)))
  3611.     (t (error (format "%s: Not an editor command" ex-token)))))
  3612.  
  3613. (defun vip-undisplayed-files()
  3614.   (mapcar
  3615.    (function 
  3616.     (lambda (b) 
  3617.       (if (null (get-buffer-window b))
  3618.       (let ((f (buffer-file-name b)))
  3619.         (if f f
  3620.           (if ex-cycle-through-non-files 
  3621.           (let ((s (buffer-name b)))
  3622.             (if (string= " " (substring s 0 1))
  3623.             nil
  3624.               s))
  3625.         nil)))
  3626.     nil)))
  3627.    (buffer-list)))
  3628.  
  3629. (defun ex-args()
  3630.   (let ((l (vip-undisplayed-files))
  3631.     (args "") (insert-point (point)) end-point 
  3632.     (file-count 1) 
  3633.     (modified (buffer-modified-p)))
  3634.     (while (not (null l))
  3635.       (if (car l) 
  3636.       (setq args (format "%s %d) %s" args file-count (car l))
  3637.         file-count (1+ file-count)))
  3638.       (setq l (cdr l)))
  3639.     (if (string= args "")
  3640.     (message "All files are displayed")
  3641.       (unwind-protect
  3642.       (save-excursion
  3643.         (insert "\n\nThese files are not displayed in any window.")
  3644.         (insert "\n=============\n" args "\n=============\n")
  3645.         (insert "The numbers can be given as counts to :next. ")
  3646.         (insert "Press any key to continue.\n\n")
  3647.         (message "Undisplayed files. Press any key to continue")
  3648.         (setq end-point (point))
  3649.         (read-char))
  3650.     (delete-region insert-point end-point)
  3651.     (set-buffer-modified-p modified)))))
  3652.  
  3653. (defun ex-cd ()
  3654.   "ex cd. Default directory of this buffer changes"
  3655.   (vip-get-ex-file)
  3656.   (if (string= ex-file "")
  3657.       (setq ex-file "~"))
  3658.   (setq default-directory (file-name-as-directory (expand-file-name ex-file))))
  3659.  
  3660. (defun ex-copy (del-flag)
  3661.   "ex copy and move command.  DEL-FLAG means delete."
  3662.   (vip-default-ex-addresses)
  3663.   (let ((address (vip-get-ex-address))
  3664.     (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
  3665.     (goto-char end)
  3666.     (save-excursion
  3667.       (set-mark beg)
  3668.       (vip-enlarge-region (mark) (point))
  3669.       (if del-flag (kill-region (point) (mark))
  3670.     (copy-region-as-kill (point) (mark)))
  3671.       (if ex-flag
  3672.       (progn
  3673.         (with-output-to-temp-buffer "*copy text*"
  3674.           (princ
  3675.            (if (or del-flag ex-g-flag ex-g-variant)
  3676.            (car kill-ring-yank-pointer)
  3677.          (buffer-substring (point) (mark)))))
  3678.         (condition-case nil
  3679.         (progn
  3680.           (vip-read-string "[Hit return to continue] ")
  3681.           (save-excursion (kill-buffer "*copy text*")))
  3682.           (quit
  3683.            (save-excursion (kill-buffer "*copy text*"))
  3684.            (signal 'quit nil))))))
  3685.     (if (= address 0)
  3686.     (goto-char (point-min))
  3687.       (goto-char address)
  3688.       (forward-line 1))
  3689.     (insert (car kill-ring-yank-pointer))))
  3690.  
  3691. (defun ex-delete ()
  3692.   "ex delete"
  3693.   (vip-default-ex-addresses)
  3694.   (vip-get-ex-buffer)
  3695.   (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
  3696.     (if (> beg end) (error "First address exceeds second"))
  3697.     (save-excursion
  3698.       (vip-enlarge-region beg end)
  3699.       (exchange-point-and-mark)
  3700.       (if ex-count
  3701.       (progn
  3702.         (set-mark (point))
  3703.         (forward-line (1- ex-count)))
  3704.     (set-mark end))
  3705.       (vip-enlarge-region (point) (mark))
  3706.       (if ex-flag
  3707.       ;; show text to be deleted and ask for confirmation
  3708.       (progn
  3709.         (with-output-to-temp-buffer " *delete text*"
  3710.           (princ (buffer-substring (point) (mark))))
  3711.         (condition-case conditions
  3712.         (vip-read-string "[Hit return to continue] ")
  3713.           (quit
  3714.            (save-excursion (kill-buffer " *delete text*"))
  3715.            (error "")))
  3716.         (save-excursion (kill-buffer " *delete text*")))
  3717.     (if ex-buffer
  3718.         (if (and (<= ?A ex-buffer) (<= ex-buffer ?Z))
  3719.         (vip-append-to-register
  3720.          (+ ex-buffer 32) (point) (mark))
  3721.           (copy-to-register ex-buffer (point) (mark) nil)))
  3722.     (delete-region (point) (mark))))))
  3723.  
  3724.  
  3725. (defun vip-ex-find-buf(buf)
  3726.   (funcall (if running-epoch
  3727.       'find-buffer-other-screen 'switch-to-buffer) buf))
  3728.  
  3729. (defun vip-ex-kill-buf(buf)
  3730.    (if running-epoch
  3731.        (mapcar 'epoch::delete-screen (epoch::screens-of-buffer (get-buffer buf))))
  3732.    (kill-buffer buf))
  3733.  
  3734. (defun ex-edit (&optional file)
  3735.   "ex-edit"
  3736.   (if (not file)
  3737.       (vip-get-ex-file))
  3738.   (if (and (not ex-variant) (buffer-modified-p) buffer-file-name)
  3739.       (error "No write since last change \(:e! overrides\)"))
  3740.   (if (string= ex-file "")
  3741.       (if ex-variant
  3742.       (progn
  3743.         (setq ex-file (buffer-file-name))
  3744.         (set-buffer-modified-p nil)
  3745.         (vip-ex-kill-buf (current-buffer)))
  3746.     (if (y-or-n-p
  3747.          (format "No file specified. Dired %s ?" default-directory))
  3748.         (setq ex-file default-directory)
  3749.       (error ""))))
  3750.   (if (null (setq file (get-file-buffer ex-file)))
  3751.       (ex-find-file ex-file)
  3752.     (vip-ex-find-buf file))
  3753.   (vip-change-mode-to-vi)
  3754.   (goto-char (point-min))
  3755.   (if ex-offset
  3756.       (progn
  3757.     (save-window-excursion
  3758.       (set-buffer " *ex-working-space*")
  3759.       (delete-region (point-min) (point-max))
  3760.       (insert ex-offset "\n")
  3761.       (goto-char (point-min)))
  3762.     (goto-char (vip-get-ex-address))
  3763.     (beginning-of-line))))
  3764.  
  3765. (defun ex-find-file(filespec)
  3766.   (let (s f)
  3767.     (if (string-match "[^a-zA-Z0-9_.-/]" filespec)
  3768.     (progn
  3769.       (save-excursion 
  3770.         (set-buffer (get-buffer-create " ex-tmp"))
  3771.         (call-process ex-find-file-shell nil t nil "-c" 
  3772.               (format "echo %s | tr ' ' '\\012'" filespec))
  3773.         (goto-char (point-min))
  3774.         (while (not (eobp))
  3775.           (setq s (point))
  3776.           (end-of-line)
  3777.           (setq f (buffer-substring s (point)))
  3778.           (find-file-noselect f)
  3779.           (forward-to-indentation 1))
  3780.         (kill-buffer (current-buffer))))
  3781.       (find-file-noselect (setq f filespec)))
  3782.     (vip-ex-find-buf 
  3783.      (file-name-nondirectory
  3784.       (if (not (file-directory-p f)) 
  3785.       f
  3786.     (directory-file-name f))))))
  3787.  
  3788. (defun ex-global (variant)
  3789.   "ex global command"
  3790.   (if (or ex-g-flag ex-g-variant)
  3791.       (error "Global within global not allowed")
  3792.     (if variant
  3793.     (setq ex-g-flag nil
  3794.           ex-g-variant t)
  3795.       (setq ex-g-flag t
  3796.         ex-g-variant nil)))
  3797.   (vip-get-ex-pat)
  3798.   (if (null ex-token)
  3799.       (error "Missing regular expression for global command"))
  3800.   (if (string= ex-token "")
  3801.       (if (null vip-s-string) (error "No previous search string")
  3802.     (setq ex-g-pat vip-s-string))
  3803.     (setq ex-g-pat ex-token
  3804.       vip-s-string ex-token))
  3805.   (if (null ex-addresses)
  3806.       (setq ex-addresses (list (point-max) (point-min))))
  3807.   (let ((marks nil) (mark-count 0)
  3808.     com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
  3809.     (if (> beg end) (error "First address exceeds second"))
  3810.     (save-excursion
  3811.       (vip-enlarge-region beg end)
  3812.       (exchange-point-and-mark)
  3813.       (let ((cont t) (limit (point-marker)))
  3814.     (exchange-point-and-mark)
  3815.     ;; skip the last line if empty
  3816.     (beginning-of-line)
  3817.     (if (and (eobp) (not (bobp))) (backward-char 1))
  3818.     (while (and cont (not (bobp)) (>= (point) limit))
  3819.       (beginning-of-line)
  3820.       (set-mark (point))
  3821.       (end-of-line)
  3822.       (let ((found (re-search-backward ex-g-pat (mark) t)))
  3823.         (if (or (and ex-g-flag found)
  3824.             (and ex-g-variant (not found)))
  3825.         (progn
  3826.           (end-of-line)
  3827.           (setq mark-count (1+ mark-count))
  3828.           (setq marks (cons (point-marker) marks)))))
  3829.       (beginning-of-line)
  3830.       (if (bobp) (setq cont nil)
  3831.         (forward-line -1)
  3832.         (end-of-line)))))
  3833.     (save-window-excursion
  3834.       (set-buffer " *ex-working-space*")
  3835.       (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
  3836.     (while marks
  3837.       (goto-char (car marks))
  3838. ; report progress of execution on a slow machine.
  3839. ;(message "Executing global command...")
  3840. ;(if (zerop (% mark-count 10))
  3841. ;(message "Executing global command...%d" mark-count))
  3842.       (vip-ex com-str)
  3843.       (setq mark-count (1- mark-count))
  3844.       (setq marks (cdr marks)))))
  3845. ;(message "Executing global command...done")))
  3846.  
  3847. (defun ex-goto ()
  3848.   "ex goto command"
  3849.   (if (null ex-addresses)
  3850.       (setq ex-addresses (cons (point) nil)))
  3851.   (push-mark (point))
  3852.   (goto-char (car ex-addresses))
  3853.   (beginning-of-line))
  3854.  
  3855. (defun ex-line (com)
  3856.   "ex line commands.  COM is join, shift-right or shift-left."
  3857.   (vip-default-ex-addresses)
  3858.   (vip-get-ex-count)
  3859.   (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point)
  3860.     (if (> beg end) (error "First address exceeds second"))
  3861.     (save-excursion
  3862.       (vip-enlarge-region beg end)
  3863.       (exchange-point-and-mark)
  3864.       (if ex-count
  3865.       (progn
  3866.         (set-mark (point))
  3867.         (forward-line ex-count)))
  3868.       (if ex-flag
  3869.       ;; show text to be joined and ask for confirmation
  3870.       (progn
  3871.         (with-output-to-temp-buffer " *text*"
  3872.           (princ (buffer-substring (point) (mark))))
  3873.         (condition-case conditions
  3874.         (progn
  3875.           (vip-read-string "[Hit return to continue] ")
  3876.           (ex-line-subr com (point) (mark)))
  3877.           (quit
  3878.            (ding)))
  3879.         (save-excursion (kill-buffer " *text*")))
  3880.     (ex-line-subr com (point) (mark)))
  3881.       (setq point (point)))
  3882.     (goto-char (1- point))
  3883.     (beginning-of-line)))
  3884.  
  3885. (defun ex-line-subr (com beg end)
  3886.   (cond ((string= com "join")
  3887.      (goto-char (min beg end))
  3888.      (while (and (not (eobp)) (< (point) (max beg end)))
  3889.        (end-of-line)
  3890.        (if (and (<= (point) (max beg end)) (not (eobp)))
  3891.            (progn
  3892.          (forward-line 1)
  3893.          (delete-region (point) (1- (point)))
  3894.          (if (not ex-variant) (fixup-whitespace))))))
  3895.     ((or (string= com "right") (string= com "left"))
  3896.      (indent-rigidly
  3897.       (min beg end) (max beg end)
  3898.       (if (string= com "right") vip-shift-width (- vip-shift-width)))
  3899.      (goto-char (max beg end))
  3900.      (end-of-line)
  3901.      (forward-char 1))))
  3902.  
  3903. (defun ex-mark ()
  3904.   "ex mark"
  3905.   (let (char)
  3906.     (if (null ex-addresses)
  3907.     (setq ex-addresses
  3908.           (cons (point) nil)))
  3909.     (save-window-excursion
  3910.       (set-buffer " *ex-working-space*")
  3911.       (skip-chars-forward " \t")
  3912.       (if (looking-at "[a-z]")
  3913.       (progn
  3914.         (setq char (following-char))
  3915.         (forward-char 1)
  3916.         (skip-chars-forward " \t")
  3917.         (if (not (looking-at "[\n|]"))
  3918.         (error "Extra characters at end of \"k\" command")))
  3919.     (if (looking-at "[\n|]")
  3920.         (error "\"k\" requires a following letter")
  3921.       (error "Mark must specify a letter"))))
  3922.     (save-excursion
  3923.       (goto-char (car ex-addresses))
  3924.       (point-to-register (- char (- ?a ?\C-a))))))
  3925.  
  3926. (defun ex-map ()
  3927.   "ex map"
  3928.   (let (char string ins)
  3929.     (save-window-excursion
  3930.       (set-buffer " *ex-working-space*")
  3931.       (if (looking-at "!") (progn (setq ins t) (forward-char 1)))
  3932.       (skip-chars-forward " \t")
  3933.       (setq char (char-to-string (following-char)))
  3934.       (forward-char 1)
  3935.       (if (not (looking-at "[ \t]")) (error "Usage: :map char string"))
  3936.       (skip-chars-forward " \t")
  3937.       (if (looking-at "[\n|]") (error "Missing rhs"))
  3938.       (set-mark (point))
  3939.       (end-of-buffer)
  3940.       (backward-char 1)
  3941.       (setq string (buffer-substring (mark) (point))))
  3942.     (if ins
  3943.     (progn
  3944.       (if (not (lookup-key ex-ins-map char))
  3945.           (define-key ex-ins-map char
  3946.         (or (lookup-key vip-insert-mode-map char) 'vip-nil)))
  3947.       (define-key vip-insert-mode-map char
  3948.         (eval
  3949.          (list 'quote
  3950.            (cons 'lambda
  3951.              (list '(count)
  3952.                    '(interactive "p")
  3953.                    (list 'execute-kbd-macro string 'count)))))))
  3954.       
  3955.       (if (not (lookup-key ex-map char))
  3956.       (define-key ex-map char
  3957.         (or (lookup-key vip-mode-map char) 'vip-nil)))
  3958.       (define-key vip-mode-map char
  3959.     (eval
  3960.      (list 'quote
  3961.            (cons 'lambda
  3962.              (list '(count)
  3963.                '(interactive "p")
  3964.                (list 'execute-kbd-macro string 'count)))))))))
  3965.  
  3966. (defun ex-unmap ()
  3967.   "ex unmap"
  3968.   (let (char ins)
  3969.     (save-window-excursion
  3970.       (set-buffer " *ex-working-space*")
  3971.       (if (looking-at "!") (progn (setq ins t) (forward-char 1)))
  3972.       (skip-chars-forward " \t")
  3973.       (setq char (char-to-string (following-char)))
  3974.       (forward-char 1)
  3975.       (skip-chars-forward " \t")
  3976.       (if (not (looking-at "[\n|]")) (error "Macro must be a character")))
  3977.     (if ins
  3978.     (progn
  3979.      (if (not (lookup-key ex-ins-map char))
  3980.          (error "That macro wasn't mapped"))
  3981.      (define-key vip-insert-mode-map char (lookup-key ex-map char))
  3982.      (define-key ex-ins-map char nil))
  3983.       (if (not (lookup-key ex-map char))
  3984.       (error "That macro wasn't mapped"))
  3985.       (define-key vip-mode-map char (lookup-key ex-map char))
  3986.       (define-key ex-map char nil))))
  3987.  
  3988. (defun ex-next (&optional previous)
  3989.   (catch 'ex-edit
  3990.     (let (count l)
  3991.       (if (not previous) 
  3992.       (progn
  3993.         (vip-get-ex-file)
  3994.         (if (or (char-or-string-p ex-offset)
  3995.             (and (not (string= "" ex-file)) 
  3996.              (not (string-match "[0-9]+" ex-file))))
  3997.         (progn
  3998.           (ex-edit t)
  3999.           (throw 'ex-edit nil))
  4000.           (setq count (string-to-int ex-file))
  4001.           (if (= count 0) (setq count 1))
  4002.           (if (< count 0) (error "Usage: next (count >= 0)"))))
  4003.     (setq count 1))
  4004.       (setq l (vip-undisplayed-files))
  4005.       (while (> count 0)
  4006.     (while (and (not (null l)) (null (car l)))
  4007.       (setq l (cdr l)))
  4008.     (setq count (1- count))
  4009.     (if (> count 0)
  4010.         (setq l (cdr l))))
  4011.       (if previous (car l)
  4012.     (progn
  4013.       (if (car l)
  4014.           (let* ((w (if ex-cycle-other-window
  4015.                 (get-lru-window) (selected-window)))
  4016.              k   (b (window-buffer w)))
  4017.         (set-window-buffer w (get-file-buffer (car l)))
  4018.         (bury-buffer b))
  4019.         (error "Not that many undisplayed files")))))))
  4020.  
  4021. (defun ex-preserve ()
  4022.   "Force auto save"
  4023.   (message "Autosaving all buffers that need to be saved...")
  4024.   (do-auto-save t))
  4025.  
  4026. (defun ex-put ()
  4027.   "ex put"
  4028.   (let ((point (if (null ex-addresses) (point) (car ex-addresses))))
  4029.     (vip-get-ex-buffer)
  4030.     (setq vip-use-register ex-buffer)
  4031.     (goto-char point)
  4032.     (if (= point 0) (vip-Put-back 1) (vip-put-back 1))))
  4033.  
  4034. (defun ex-pwd ()
  4035.   "ex print working directory"
  4036.   (message default-directory))
  4037.  
  4038. (defun ex-quit ()
  4039.   "ex quit"
  4040.   (let (char)
  4041.     (save-window-excursion
  4042.       (set-buffer " *ex-working-space*")
  4043.       (skip-chars-forward " \t")
  4044.       (setq char (following-char)))
  4045.     (if (= char ?!) (set-buffer-modified-p nil))
  4046.     (if vip-is-vi (save-buffers-kill-emacs)
  4047.       (vip-ex-kill-buf (current-buffer)))))
  4048.  
  4049.  
  4050. (defun ex-read ()
  4051.   "ex read"
  4052.   (vip-get-ex-file)
  4053.   (let ((point (if (null ex-addresses) (point) (car ex-addresses))))
  4054.     (goto-char point)
  4055.     (if (not (= point 0)) (next-line 1))
  4056.     (beginning-of-line)
  4057.     (if (and (not ex-variant) (string= ex-file ""))
  4058.     (progn
  4059.       (if (null buffer-file-name)
  4060.           (error "No file specified"))
  4061.       (setq ex-file buffer-file-name)))
  4062.     (if ex-cmdfile
  4063.     (shell-command ex-file t)
  4064.       (insert-file ex-file))))
  4065.  
  4066. (defun ex-recover ()
  4067.   "ex recover from emacs \#file\#"
  4068.   (vip-get-ex-file)
  4069.   (if (or ex-append ex-offset)
  4070.       (error "Illegal extra characters"))
  4071.   (if (string= ex-file "")
  4072.       (progn
  4073.     (if (null buffer-file-name)
  4074.         (error "No file associated with this buffer"))
  4075.     (setq ex-file buffer-file-name))
  4076.     (setq ex-file (expand-file-name ex-file)))
  4077.   (if (and (not (string= ex-file (buffer-file-name)))
  4078.        (buffer-modified-p)
  4079.        (not ex-variant))
  4080.       (error "No write since last change \(:rec! overrides\)"))
  4081.   (recover-file ex-file))
  4082.  
  4083. (defun ex-rewind ()
  4084.   "No rewind really. Instead tell about :next count"
  4085.   (message ":n can count the :args list now. :rewind is obsolete"))
  4086.  
  4087. (defun ex-set ()
  4088.   (let (var (val 0) (b (buffer-name (current-buffer))) (s "setq"))
  4089.     (save-window-excursion
  4090.       (set-buffer " *ex-working-space*")
  4091.       (skip-chars-forward " \t")
  4092.       (if (looking-at "[\n|]") (error "Usage: set variable[= \t]value"))
  4093.       (set-mark (point))
  4094.       (skip-chars-forward "^ \t=\n|")
  4095.       (setq var (buffer-substring (mark) (point)))
  4096.       (cond ((or (string= var "ai") (string= var "autoindent"))
  4097.          (setq var "vip-auto-indent") (setq val "t"))
  4098.         ((or (string= var "noai") (string= var "noautoindent"))
  4099.          (setq var "vip-auto-indent") (setq val "nil"))
  4100.         ((or (string= var "ic") (string= var "ignorecase"))
  4101.          (setq var "vip-case-fold-search") (setq val "t"))
  4102.         ((or (string= var "noic") (string= var "noignorecase"))
  4103.          (setq var "vip-case-fold-search") (setq val "nil"))
  4104.         ((or (string= var "ma") (string= var "magic"))
  4105.          (setq var "vip-re-search") (setq val "t"))
  4106.         ((or (string= var "noma") (string= var "nomagic"))
  4107.          (setq var "vip-re-search") (setq val "nil"))
  4108.         ((or (string= var "ro") (string= var "readonly"))
  4109.          (setq var "buffer-read-only") (setq val "t"))
  4110.         ((or (string= var "noro") (string= var "noreadonly"))
  4111.          (setq var "buffer-read-only") (setq val "nil"))
  4112.         ((or (string= var "sm") (string= var "showmatch"))
  4113.          (setq var "blink-matching-paren") (setq val "t"))
  4114.         ((or (string= var "nosm") (string= var "noshowmatch"))
  4115.          (setq var "blink-matching-paren") (setq val "nil"))
  4116.         ((or (string= var "ws") (string= var "wrapscan"))
  4117.          (setq var "vip-search-wrap-around-t") (setq val "t"))
  4118.         ((or (string= var "nows") (string= var "nowrapscan"))
  4119.          (setq var "vip-search-wrap-around-t") (setq val "nil")))
  4120.       (if (eq val 0)
  4121.       (progn
  4122.         (if (looking-at "[\n|]") (error "Usage: set variable[= \t]value"))
  4123.         (forward-char 1)
  4124.         (skip-chars-forward " \t")
  4125.         (if (looking-at "[\n|]") (error "Missing rhs"))
  4126.         (set-mark (point))
  4127.         (end-of-buffer)
  4128.         (backward-char 1)
  4129.         (setq val (buffer-substring (mark) (point)))
  4130.         (cond
  4131.          ((or (string= var "sw") (string= var "shiftwidth"))
  4132.           (setq var "vip-shift-width"))
  4133.          ((or (string= var "ts") (string= var "tabstop"))
  4134.           (setq var "tab-width") (setq s "setq-default"))
  4135.          ((or (string= var "wm") (string= var "wrapmargin"))
  4136.           (setq var "fill-column") 
  4137.           (setq val (format "(- (window-width) %s)" val)) 
  4138.           (setq s "setq-default"))
  4139.          ((or (string= var "sh") (string= var "shell"))
  4140.           (setq var "explicit-shell-file-name") 
  4141.           (setq val (format "\"%s\"" val))))))
  4142.       (message (format "%s %s %s" s var val))
  4143.       (eval (car (read-from-string (format "(%s %s %s)" s var val)))))))
  4144.  
  4145.  
  4146. ;;   (eval (list 'setq
  4147. ;;           (read-variable "Variable: ")
  4148. ;;           (eval (read-minibuffer "Value: ")))))
  4149.  
  4150. (defun ex-shell ()
  4151.   "ex shell"
  4152.   (shell))
  4153.  
  4154. (defun ex-source ()
  4155.   "ex-source - just load the file or ~/.vip"
  4156.   (vip-get-ex-file)
  4157.   (if (string= ex-file "")
  4158.       (load vip-custom-file-name)
  4159.     (load ex-file)))
  4160.  
  4161. (defun ex-substitute (&optional repeat r-flag) 
  4162.   "ex substitute. if REPEAT use previous reg-exp which is ex-reg-exp or
  4163. vip-s-string"
  4164.   (let (delim pat repl (opt-g nil) (opt-c nil) (matched-pos nil))
  4165.     (if repeat (setq ex-token nil) (setq delim (vip-get-ex-pat)))
  4166.     (if (null ex-token)
  4167.     (setq pat (if r-flag vip-s-string ex-reg-exp)
  4168.           repl ex-repl)
  4169.       (setq pat (if (string= ex-token "") vip-s-string ex-token))
  4170.       (setq vip-s-string pat
  4171.         ex-reg-exp pat)
  4172.       (setq delim (vip-get-ex-pat))
  4173.       (if (null ex-token)
  4174.       (setq ex-token ""
  4175.         ex-repl "")
  4176.     (setq repl ex-token
  4177.           ex-repl ex-token)))
  4178.     (while (vip-get-ex-opt-gc delim)
  4179.       (if (string= ex-token "g") (setq opt-g t) (setq opt-c t)))
  4180.     (vip-get-ex-count)
  4181.     (if ex-count
  4182.     (save-excursion
  4183.       (if ex-addresses (goto-char (car ex-addresses)))
  4184.       (set-mark (point))
  4185.       (forward-line (1- ex-count))
  4186.       (setq ex-addresses (cons (point) (cons (mark) nil))))
  4187.       (if (null ex-addresses)
  4188.       (setq ex-addresses (cons (point) (cons (point) nil)))
  4189.     (if (null (cdr ex-addresses))
  4190.         (setq ex-addresses (cons (car ex-addresses) ex-addresses)))))
  4191.                     ;(setq G opt-g)
  4192.     (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses)))
  4193.       (cont t) eol-mark)
  4194.       (save-excursion
  4195.     (vip-enlarge-region beg end)
  4196.     (let ((limit (save-excursion
  4197.                (goto-char (max (point) (mark)))
  4198.                (point-marker))))
  4199.       (goto-char (min (point) (mark)))
  4200.       (while (< (point) limit)
  4201.         (end-of-line)
  4202.         (setq eol-mark (point-marker))
  4203.         (beginning-of-line)
  4204.         (if opt-g
  4205.         (progn
  4206.           (while (and (not (eolp))
  4207.                   (re-search-forward pat eol-mark t))
  4208.             (if (or (not opt-c) (y-or-n-p "Replace? "))
  4209.             (progn
  4210.               (setq matched-pos (point))
  4211.               (replace-match repl))))
  4212.           (end-of-line)
  4213.           (forward-char))
  4214.           (if (and (re-search-forward pat eol-mark t)
  4215.                (or (not opt-c) (y-or-n-p "Replace? ")))
  4216.           (progn
  4217.             (setq matched-pos (point))
  4218.             (replace-match repl)))
  4219.           (end-of-line)
  4220.           (forward-char))))))
  4221.     (if matched-pos (goto-char matched-pos))
  4222.     (beginning-of-line)
  4223.     (if opt-c (message "done"))))
  4224.  
  4225. (defun ex-tag ()
  4226.   "ex tag"
  4227.   (let (tag)
  4228.     (save-window-excursion
  4229.       (set-buffer " *ex-working-space*")
  4230.       (skip-chars-forward " \t")
  4231.       (set-mark (point))
  4232.       (skip-chars-forward "^ |\t\n")
  4233.       (setq tag (buffer-substring (mark) (point))))
  4234.     (if (not (string= tag "")) (setq ex-tag tag))
  4235.     (vip-change-mode-to-emacs)
  4236.     (condition-case conditions
  4237.     (progn
  4238.       (if (string= tag "")
  4239.           (find-tag ex-tag t)
  4240.         (find-tag-other-window ex-tag))
  4241.       (vip-change-mode-to-vi))
  4242.       (error
  4243.        (vip-change-mode-to-vi)
  4244.        (vip-message-conditions conditions)))))
  4245.  
  4246. (defun ex-write (q-flag)
  4247.   "ex write"
  4248.   (vip-default-ex-addresses t)
  4249.   (vip-get-ex-file)
  4250.   (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) 
  4251.     size old-point ret ex-write-cmd)
  4252.     (if (> beg end) (error "First address exceeds second"))
  4253.     (if ex-cmdfile
  4254.     (progn
  4255.       (vip-enlarge-region beg end)
  4256.       (shell-command-on-region (point) (mark) ex-file))
  4257.       (if (string= ex-file "")
  4258.       (progn
  4259.         (if (null buffer-file-name)
  4260.         (error "No file associated with this buffer"))
  4261.         (setq ex-file buffer-file-name))
  4262.     (setq ex-file (expand-file-name ex-file)))
  4263.       (if (and (not (string= ex-file (buffer-file-name)))
  4264.            (file-exists-p ex-file)
  4265.            (not ex-variant))
  4266.       (error (format "\"%s\" File exists - use w! to override" ex-file)))
  4267.       (save-excursion
  4268.     (vip-enlarge-region beg end)
  4269.     (write-region (point) (mark) ex-file ex-append 1)
  4270.     (setq size (- (point) (mark)))
  4271.     (if (string= buffer-file-name ex-file) 
  4272.         (progn
  4273.           (set-buffer-modified-p nil)
  4274.           (clear-visited-file-modtime)
  4275.           (delete-auto-save-file-if-necessary))))
  4276.       (ex-write-info (file-exists-p ex-file) ex-file size beg end)
  4277.       (if (null buffer-file-name) (setq buffer-file-name ex-file))
  4278.       (if q-flag
  4279.       (if vip-is-vi
  4280.           (save-buffers-kill-emacs)
  4281.         (kill-buffer (current-buffer)))))))
  4282.  
  4283. (defun ex-write-info(exists file-name size beg end)
  4284.   (message "\"%s\"%s %d lines, %d characters"
  4285.        file-name
  4286.        (if exists "" " [New file]")
  4287.        (count-lines beg end) size))
  4288.  
  4289. (defun ex-yank ()
  4290.   "ex yank"
  4291.   (vip-default-ex-addresses)
  4292.   (vip-get-ex-buffer)
  4293.   (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
  4294.     (if (> beg end) (error "First address exceeds second"))
  4295.     (save-excursion
  4296.       (vip-enlarge-region beg end)
  4297.       (exchange-point-and-mark)
  4298.       (if (or ex-g-flag ex-g-variant) (error "Can't yank within global"))
  4299.       (if ex-count
  4300.       (progn
  4301.         (set-mark (point))
  4302.         (forward-line (1- ex-count)))
  4303.     (set-mark end))
  4304.       (vip-enlarge-region (point) (mark))
  4305.       (if ex-flag (error "Extra chacters at end of command"))
  4306.       (if ex-buffer
  4307.       (copy-to-register ex-buffer (point) (mark) nil))
  4308.       (copy-region-as-kill (point) (mark)))))
  4309.  
  4310. (defun ex-command ()
  4311.   "execute shell command"
  4312.   (let (command)
  4313.     (save-window-excursion
  4314.       (set-buffer " *ex-working-space*")
  4315.       (skip-chars-forward " \t")
  4316.       (setq command (buffer-substring (point) (point-max)))
  4317.       (end-of-line))
  4318.     (setq command (ex-expand-filsyms command (current-buffer)))
  4319.     (if (string= "!" (substring command 0 1))
  4320.     (if vip-ex-last-shell-com
  4321.         (setq command (concat vip-ex-last-shell-com (substring command 1)))
  4322.       (error "No previous shell command")))
  4323.     (setq vip-ex-last-shell-com command)
  4324.     (if (null ex-addresses)
  4325.     (shell-command command)
  4326.       (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
  4327.     (if (null beg) (setq beg end))
  4328.     (save-excursion
  4329.       (goto-char beg)
  4330.       (set-mark end)
  4331.       (vip-enlarge-region (point) (mark))
  4332.       (shell-command-on-region (point) (mark) command t))
  4333.     (goto-char beg)))))
  4334.  
  4335. (defun ex-line-no ()
  4336.   "print line number"
  4337.   (message "%d"
  4338.        (1+ (count-lines
  4339.         (point-min)
  4340.         (if (null ex-addresses) (point-max) (car ex-addresses))))))
  4341.  
  4342. (if (file-exists-p vip-custom-file-name) (load vip-custom-file-name))
  4343.  
  4344. ;; Emacs customisations for vip usage - runs after (load .vip)
  4345.  
  4346. ;; (if vip-make-cc-quit
  4347. ;;     (set-input-mode nil nil ?\^c))
  4348.  
  4349. (if vip-want-history (vip-get-history))
  4350.  
  4351. (if vip-always
  4352.     (progn
  4353.       (setq term-setup-hook 'vip-mode)
  4354.       (setq default-major-mode 'vip-mode)
  4355.       
  4356.       (defun vip-tmp-hook() (vip-mode))
  4357.       (defun vip-set-hook(h)
  4358.     (if (or (not (listp h)) (and h (equal (car h) 'lambda)))
  4359.         (setq h (list h)))
  4360.     (or (memq 'vip-tmp-hook h)
  4361.         (setq h (cons 'vip-tmp-hook h))))
  4362.       
  4363.       (defvar emacs-lisp-mode-hook nil)
  4364.       (setq emacs-lisp-mode-hook (vip-set-hook emacs-lisp-mode-hook))
  4365.       
  4366.       (defvar TeX-mode-hook nil)
  4367.       (setq TeX-mode-hook (vip-set-hook TeX-mode-hook))
  4368.       
  4369.       (defvar c-mode-hook nil)
  4370.       (setq c-mode-hook (vip-set-hook c-mode-hook))
  4371.       
  4372.       (defvar c++-mode-hook nil)
  4373.       (setq c++-mode-hook (vip-set-hook c++-mode-hook))
  4374.       
  4375.       (defvar lisp-interaction-mode-hook nil)
  4376.       (setq lisp-interaction-mode-hook
  4377.         (vip-set-hook lisp-interaction-mode-hook))
  4378.       
  4379.       (defvar text-mode-hook nil)
  4380.       (setq text-mode-hook (vip-set-hook text-mode-hook))
  4381.       
  4382.       ))
  4383.  
  4384. ;; End of VIP
  4385.