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 / evi.el < prev    next >
Encoding:
Text File  |  1993-03-18  |  139.3 KB  |  4,212 lines

  1. ;; Copyright (c) 1992, 1993 Jeffrey R. Lewis
  2. ;; All rights reserved.
  3. ;;
  4. ;; Redistribution and use in source and compiled forms, with or without
  5. ;; modification, are permitted provided that the following conditions
  6. ;; are met:
  7. ;; 1. Redistributions of source code must retain the above copyright notice,
  8. ;;    this list of conditions and the following disclaimer.
  9. ;; 2. Redistributions in compiled form must either be accompanied by the
  10. ;;    source, or reproduce the above copyright notice, this list of conditions
  11. ;;    and the following disclaimer in the documentation and/or other materials
  12. ;;    provided with the distribution.
  13. ;;
  14. ;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
  15. ;; INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  16. ;; AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  17.  
  18. ;; Evi 0.99.6m - Emulate Vi
  19. ;; LCD Archive Entry:
  20. ;; evi|Jeffrey R. Lewis|jlewis@cse.ogi.edu
  21. ;; |Emulate Vi - an even better vi emulator
  22. ;; |2-16-93|0.99.6m|~/modes/evi.el.Z
  23. (defvar evi-version "Evi 0.99.6m, 2-16-93")
  24.  
  25. ;; Here follows Evi 0.9, an even better vi emulator aimed at those who either
  26. ;; are well accustomed to vi, or who just simply happen to like its style of
  27. ;; editing better than emacs' default.  Evi's first goal is vi compatibility.
  28. ;; Its second goal is to be an extension of vi, taking advantage of features
  29. ;; supplied by the emacs environment, without simply becoming emacs with vi'ish
  30. ;; key bindings.
  31.  
  32. (defvar evi-mode-hook nil
  33.   "*Function or functions called upon entry to evi-mode.")
  34.  
  35. (defmacro evi-defbuffervar (name default-value documentation)
  36.   (list 'progn (list 'defvar name nil documentation)
  37.            (list 'make-variable-buffer-local (list 'quote name))
  38.            (list 'set-default (list 'quote name) default-value)))
  39.  
  40. (defmacro evi-version-case (&rest cases)
  41.   (let ((return nil))
  42.     (while cases
  43.       (if (string-match (car (car cases)) (emacs-version))
  44.       (setq return
  45.         (if (cdr (cdr (car cases)))
  46.             (cons 'progn (cdr (car cases)))
  47.           (car (cdr (car cases))))
  48.         cases nil)
  49.     (setq cases (cdr cases))))
  50.     return))
  51.  
  52. (evi-version-case
  53.   ("Emacs 18\\|Epoch 4"
  54.     (defun evi-fill-keymap (keymap def)
  55.       (fillarray keymap def))
  56.  
  57.     (defun evi-keymap-bindings (map)
  58.       (evi-keymap-bindings2 map ""))
  59.  
  60.     (defun evi-keymap-bindings2 (map prefix)
  61.       (let ((bindings (cdr map))
  62.         (mappings nil))
  63.     (while bindings
  64.       (let* ((binding (car bindings))
  65.          (keys (concat prefix (char-to-string (car binding)))))
  66.         (if (keymapp (cdr binding))
  67.         (setq mappings
  68.           (nconc (evi-keymap-bindings2 (cdr binding) keys) mappings))
  69.           (setq mappings (cons (cons keys (cdr binding)) mappings))))
  70.       (setq bindings (cdr bindings)))
  71.     mappings))
  72.     )
  73.   ("Emacs 19.*Lucid"
  74.     (defun evi-fill-keymap (keymap def)
  75.       (let ((i 128))
  76.     (while (<= 0 (setq i (1- i)))
  77.       (define-key keymap (make-string 1 i) def))
  78.     keymap))
  79.  
  80.     (defun evi-keymap-bindings (map)
  81.       (let ((mappings nil))
  82.     (evi-keymap-bindings2 map "")
  83.     mappings))
  84.  
  85.     (defun evi-keymap-bindings2 (map prefix)
  86.       (map-keymap
  87.         (function
  88.       (lambda (key def)
  89.         (let* ((keys (concat prefix (single-key-description key))))
  90.           (if (keymapp def)
  91.           (setq mappings
  92.             (nconc (evi-keymap-bindings2 def keys) mappings))
  93.           (setq mappings
  94.         (cons (cons keys def) mappings)))))) map))
  95.     ))
  96.  
  97. (defvar evi-initialized nil)
  98.  
  99. (defvar evi-interactive t)
  100.  
  101. (evi-defbuffervar evi-enabled nil
  102.   "If t, currently emulating vi in this buffer.")
  103.  
  104. (defvar evi-debug nil
  105.   "If t, errors generated by emacs are not handled.")
  106.  
  107. (defvar evi-supress-ex-startup nil
  108.   "If t, don't source .exrc or EXINIT at startup.")
  109.  
  110. (defvar evi-report-unsupported-options nil
  111.   "If t, give an error if a :set option is used that isn't supported.
  112. Otherwise, these are silently ignored.")
  113.  
  114. (evi-defbuffervar evi-mode 'vi
  115.   "Current vi mode, one of vi, insert or replace.")
  116.  
  117. (evi-defbuffervar evi-mode-string nil
  118.   "String describing current evi mode.  This is displayed in the mode line.")
  119.  
  120. (defvar evi-meta-prefix-char nil
  121.   "Meta-prefix-char to use while in Evi buffers.")
  122.  
  123. (defvar ex-input-escapes nil
  124.   "If t, backslash escapes in ex commands will be processed.")
  125.  
  126. (defvar evi-last-point nil
  127.   "Used to calculate line number updates.")
  128.  
  129. (defvar evi-mark nil
  130.   "Used to define regions for operator commands.")
  131.  
  132. (defvar evi-global-directory t
  133.   "If t, a global current directory is used (this is the default).")
  134.  
  135. (defvar evi-directory-stack nil)
  136.  
  137. (defvar evi-process-buffer nil)
  138.  
  139. (defvar evi-abbrev-list nil)
  140.  
  141. (evi-defbuffervar evi-emacs-local-map nil
  142.   "Emacs' local map.  \(buffer specific\)")
  143.  
  144. (defvar evi-emacs-local-suppress-key-list '(?\b ?\t ?\e ?\C-?)
  145.   "Keys from emacs local map that are to be suppressed.")
  146.  
  147. (defvar evi-command-keys nil
  148.   "The keystrokes for the current command.")
  149.  
  150. (defvar evi-prompted nil
  151.   "If t, the current command was prompted for.")
  152.  
  153. (evi-defbuffervar evi-replace-max nil
  154.   "Maximum excursion of a replace, after which it switches to insert.")
  155.  
  156. (evi-defbuffervar evi-overstruck-char nil
  157.   "Value of the character overstruck by the `$' marking a partial line change.")
  158.  
  159. (evi-defbuffervar evi-context nil
  160.   "Current motion context.  One of to-end, to-next, whole-line, or nil.
  161. The value of this variable is passed to evi-motion-command, and is set by
  162. prefix operators like 'd' or '>' to control the type of region defined by
  163. the following motion command.")
  164.  
  165. (defvar evi-prefix-count nil
  166.   "Current prefix count.")
  167.  
  168. (defvar evi-prefix-count-multiplier 1
  169.   "Current prefix count multiplier.")
  170.  
  171. (defvar evi-register-spec nil
  172.   "Current register to use for deletes, yanks, puts, etc.")
  173.  
  174. (defvar evi-digit-register 8
  175.   "Current delete-ring register cursor.  Points to the register that
  176. will be register 1.")
  177.  
  178. (defvar evi-repeat-count 0
  179.   "The number of times the current command has been repeated via `.'.")
  180.  
  181. (defvar evi-hidden-repeat-count 0
  182.   "The hidden copy of evi-repeat-count, which isn't visible unless actually
  183. repeating a command.")
  184.  
  185. (defvar evi-last-macro-register nil
  186.   "Last register used to invoke a macro via \\[evi-register-macro].")
  187.  
  188. (defvar evi-registers (make-vector 72 nil)
  189.   "Vi registers.  0-8 are the delete ring, 9 is the unnamed text register,
  190. 10-35 are the alphabetic text registers, and 36-71 are the mark registers.
  191. Each text register is a cons cell with the car being the text in the register
  192. and the cdr being a flag indicating whether or not the text is whole lines.")
  193.  
  194. (defvar evi-register-unnamed 9
  195.   "Symbolic name for the unnamed register.  Shouldn't change.")
  196.  
  197. (defvar evi-region-shape 'chars
  198.   "Specifies the shape of the region for the current operation - one of
  199. chars, lines, or rectangle.  The value of this variable is stored in the cdr
  200. of any register that gets stored as a result of the current command.")
  201.  
  202. (evi-defbuffervar evi-current-indentation 0
  203.   "The indentation of the most recently auto-indented line.  Used by
  204. evi-newline to determine when to kill auto-indented whitespace.
  205. \(buffer specific\)")
  206.  
  207. (defvar evi-internal-command nil
  208.   "If t, next command will be executed in internal mode (certain interface
  209. features turned off)")
  210.  
  211. (evi-defbuffervar evi-goal-column 0
  212.   "The column that vertical cursor motion will try to preserve, if possible.")
  213.  
  214. (evi-defbuffervar evi-reset-goal-column t
  215.   "If t, a horizontal motion has been performed, thus goal column must be reset.")
  216.  
  217. (defvar evi-search-pattern nil
  218.   "The last pattern specified for searching.")
  219.  
  220. (defvar evi-search-forward t
  221.   "If t, the last search command was a forward search.")
  222.  
  223. (defvar evi-find-character nil
  224.   "The last character specified for finding.")
  225.  
  226. (defvar evi-find-forward t
  227.   "If t, the last find command was a forward search.")
  228.  
  229. (defvar evi-find-up-to nil
  230.   "If t, the last find command was a find up to command.")
  231.  
  232. (evi-defbuffervar evi-context-ring (make-vector 10 nil)
  233.   "The last 10 contexts for this buffer.  A context is a location in the buffer
  234. where only relative motions were performed.  A new context is thus saved each
  235. time a non-relative motion is performed.")
  236.  
  237. (evi-defbuffervar evi-context-ring-cursor 0
  238.   "The cursor pointing to the last context in the context ring.")
  239.  
  240. (defvar evi-last-shell-command nil
  241.   "The last shell command run.")
  242.  
  243. (defvar ex-work-space (get-buffer-create " *ex-work-space*")
  244.   "Evi work space for parsing ex commands.")
  245.  
  246. (defvar ex-tag nil
  247.   "Last tag specified.")
  248.  
  249. (defun evi-make-keymap (name &optional fill)
  250.   (let ((map (make-keymap)))
  251.     (if (fboundp 'set-keymap-name)
  252.     (set-keymap-name map name))
  253.     (if fill
  254.     (evi-fill-keymap map fill))
  255.     map))
  256.  
  257. (defconst evi-top-level-map
  258.   (evi-make-keymap 'evi-top-level-map 'evi-top-level-command))
  259.  
  260. (defconst evi-vi-map (evi-make-keymap 'evi-vi-map)
  261.   "The keymap used in vi mode.")
  262.  
  263. (defconst evi-internal-map (evi-make-keymap 'evi-internal-map)
  264.   "The keymap used for special command macro features.")
  265.  
  266. (defconst evi-motion-map (evi-make-keymap 'evi-motion-map)
  267.   "The keymap used for operand motions.")
  268.  
  269. (defconst evi-map-map (evi-make-keymap 'evi-map-map)
  270.   "The keymap used for map macros.")
  271.  
  272. (defconst evi-input-map (evi-make-keymap 'evi-input-map 'evi-self-insert)
  273.   "The keymap used in input modes.")
  274.  
  275. (defconst evi-replace-map (evi-make-keymap 'evi-replace-map 'evi-self-replace)
  276.   "The keymap used in replace mode.")
  277.  
  278. (defconst evi-insert-map (evi-make-keymap 'evi-insert-map)
  279.   "The insert mode specific input map.")
  280.  
  281. (defconst evi-read-string-map (evi-make-keymap 'evi-read-string-map)
  282.   "The evi-read-string specific input map.")
  283.  
  284. (defconst evi-ex-map (evi-make-keymap 'evi-ex-map)
  285.   "The keymap used when reading ex commands from the minibuffer")
  286.  
  287. (defconst evi-input-map-map (evi-make-keymap 'evi-input-map-map)
  288.   "The keymap used for input map macros.")
  289.  
  290. (defconst evi-shell-map (evi-make-keymap 'evi-shell-map)
  291.   "The local keymap used in command mode in a shell buffer.")
  292.  
  293. (evi-defbuffervar evi-buffer-local-vi-map 
  294.           (evi-make-keymap 'evi-buffer-local-vi-map)
  295.   "The keymap for buffer specific additions to the vi command map")
  296.  
  297. (defconst evi-empty-keymap (evi-make-keymap 'evi-empty-keymap))
  298.  
  299. ; it appears to be correct that this not include buffer-local-vi-map
  300. (defconst evi-default-keymap-list (list evi-map-map evi-vi-map))
  301.  
  302. (defconst evi-all-keymaps '(vi insert replace ex)
  303.   "All Evi keymaps.")
  304.  
  305. (evi-defbuffervar evi-register-parameter nil
  306.   "Register specification to the current parameterized macro.")
  307.  
  308. (evi-defbuffervar evi-prefix-count-parameter nil
  309.   "Prefix count to the current parameterized macro.")
  310.  
  311. (defvar evi-last-command-keys nil
  312.   "Command keys for the last complete vi command.")
  313.  
  314. (evi-defbuffervar evi-insert-point nil
  315.   "The point at which the current insert command began.")
  316.  
  317. ;; Vi option variables
  318. ;; ZZ - could/should make some of these buffer local after reading EXINIT
  319.  
  320. (defconst evi-option-list
  321.   '((("autoindent" "ai") . (bool . evi-auto-indent))
  322.     (("autoprint" "ap") . (bool . nil))
  323.     (("autowrite" "aw") . (bool . nil))
  324.     (("beautify") . (bool . nil))
  325.     (("directory" "dir") . (string . nil))
  326.     (("edcompatible" "ed") . (bool . nil))
  327.     (("errorbells" "eb") . (bool . evi-error-bell))
  328.     (("flash") . (bool . nil))
  329.     (("hardtabs" "ht") . (number . nil))
  330.     (("ignorecase" "ic") . (bool . evi-ignore-case))
  331.     (("ishell" "ish") . (string . explicit-shell-file-name))
  332.     (("lisp") . (bool . nil))
  333.     (("list") . (bool . nil))
  334.     (("magic") . (bool . evi-search-magic))
  335.     (("mesg") . (bool . nil))
  336.     (("modeline") . (bool . nil))
  337.     (("novice") . (bool . nil))
  338.     (("number" "nu") . (bool . evi-number))
  339.     (("optimize" "opt") . (bool . nil))
  340.     (("paragraphs" "para") . (string . nil))
  341.     (("prompt") . (bool . nil))
  342.     (("readonly" "ro") . (bool . evi-buffer-read-only))
  343.     (("redraw") . (bool . nil))
  344.     (("remap") . (bool . nil))
  345.     (("report") . (number . nil))
  346.     (("scroll") . (number . evi-scroll-count))
  347.     (("sections" "sect") . (string . nil))
  348.     (("shell" "sh") . (string . shell-file-name))
  349.     (("shiftwidth" "sw") . (number . evi-shift-width))
  350.     (("showmatch" "sm") . (bool . evi-show-match))
  351.     (("showmode") . (bool . evi-show-mode))
  352.     (("slowopen" "slow") . (bool . nil))
  353.     (("sourceany") . (bool . nil))
  354.     (("tabstop" "ts") . (number . evi-tab-width))
  355.     (("tags") . (string . nil))
  356.     (("taglength" "tl") . (number . nil))
  357.     (("term") . (string . nil))
  358.     (("terse") . (bool . nil))
  359.     (("timeout") . (bool . evi-timeout))
  360.     (("timeoutlen") . (number . evi-timeout-length))
  361.     (("ttytype" "tty") . (string . nil))
  362.     (("warn") . (bool . nil))
  363.     (("word") . (string . evi-word))
  364.     (("Word") . (string . evi-Word))
  365.     (("wrapmargin" "wm") . (number . evi-wrap-margin))
  366.     (("wrapscan" "ws") . (bool . evi-search-wraparound))
  367.     (("writeany" "wa") . (bool . nil))))
  368.  
  369. (defvar evi-set-options nil
  370.   "List of options that have been set.")
  371.  
  372. (defconst evi-auto-indent nil
  373.   "*If t, automatically indents text inserted on a new line.")
  374.  
  375. (defconst evi-error-bell nil
  376.   "*If t, ring bell on error.")
  377.  
  378. (defconst evi-ignore-case nil
  379.   "*If t, ignore case in searches.")
  380.  
  381. (defconst evi-search-magic t
  382.   "*If t, search patterns are normal regular expressions.  This is the default.
  383. Otherwise, the `magic' characters `.' `[' and `*' are treated as literals and
  384. must be escaped to get their regular expression interpretation.")
  385.  
  386. (defconst evi-number nil
  387.   "*If t, tracks line and column number in status line.")
  388.  
  389. (defvar evi-number-string nil)
  390. (defvar evi-number-format " %d/%d")
  391. (defvar evi-line-number)
  392. (defvar evi-column-number)
  393.  
  394. (defun evi-calc-number ()
  395.   (setq evi-line-number (count-lines 1 (min (1+ (point)) (point-max)))
  396.     evi-column-number (1+ (current-column))
  397.     evi-number-string (format evi-number-format evi-line-number
  398.                             evi-column-number)
  399.     evi-last-point (point))
  400.   (evi-refresh-mode-line))
  401.  
  402. (defun evi-update-number (point)
  403.   (let* ((negative (< point evi-last-point))
  404.      (delta (1- (if negative
  405.             (count-lines point (min (1+ evi-last-point)
  406.                         (point-max)))
  407.               (count-lines evi-last-point
  408.                    (min (1+ point) (point-max)))))))
  409.     (setq evi-line-number (if negative
  410.                   (- evi-line-number delta)
  411.                 (+ evi-line-number delta))
  412.       evi-column-number (1+ (current-column))
  413.       evi-number-string (format evi-number-format evi-line-number
  414.                               evi-column-number)
  415.       evi-last-point (point))
  416.     (evi-refresh-mode-line)))
  417.  
  418. (defun evi-number (value)
  419.   (if value
  420.       (progn
  421.     (evi-install-in-mode-line 'evi-number-string)
  422.     (evi-calc-number))
  423.     (evi-deinstall-from-mode-line 'evi-number-string)
  424.     (evi-refresh-mode-line)))
  425.  
  426. (evi-defbuffervar evi-buffer-read-only nil
  427.   "*If t, the current buffer is read-only")
  428.  
  429. (defconst evi-scroll-count nil
  430.   "*The number of lines to scroll.")
  431.  
  432. (defconst evi-shift-width 8
  433.   "*The number of colums shifted by > and < command, and ^T and ^D
  434. in insert mode.")
  435.  
  436. (defconst evi-show-match nil
  437.   "*If t, show matching parentheses.")
  438.  
  439. (defconst evi-show-mode t
  440.   "*If t, show current vi mode.")
  441.  
  442. (defconst evi-tab-width 8
  443.   "*Distance between tab stops")
  444.  
  445. (defun evi-tab-width (width)
  446.   (setq-default tab-width width))
  447.  
  448. (defconst evi-timeout t
  449.   "*If t, timeout is actually *not* implemented.  If nil, <ESC><ESC> becomes
  450. <ESC>, and arrows keys are mapped to h, j, k and l.")
  451.  
  452. (evi-version-case
  453.   ("Emacs 19.*Lucid"
  454.     (defun evi-timeout (value)
  455.       ; I presume in v19 we can handle this properly (but hasn't been done yet)
  456.       ))
  457.   ("."
  458.     (defun evi-timeout (value)
  459.       (if value
  460.     (evi-define-key '(vi) "\e" nil)
  461.     (progn (evi-define-key '(vi) "\e" esc-map)
  462.            (define-key function-keymap "l" 'evi-backward-char)
  463.            (define-key function-keymap "r" 'evi-forward-char)
  464.            (define-key function-keymap "u" 'evi-previous-line)
  465.            (define-key function-keymap "d" 'evi-next-line)
  466.            ;; ZZ should save \e\e binding and use that in :set timeout
  467.            (evi-define-key '(vi) "\e\e" nil))))))
  468.  
  469. (defconst evi-timeout-length 500
  470.   "*Not implemented.")
  471.  
  472. (defconst evi-word "[a-zA-Z0-9_]+\\|[^a-zA-Z0-9_ \t\n]+\\|^[ \t]*\n"
  473.   "*Regular expression to describe words for w, b and e commands.")
  474.  
  475. (defconst evi-Word "[^ \t\n]+\\|^[ \t]*\n"
  476.   "*Regular expression to describe words for W, B and E commands.")
  477.  
  478. (defconst evi-wrap-margin 0
  479.   "*If non-zero, the amount of right margin past which wraparound occurs.")
  480.  
  481. (defun evi-wrap-margin (margin)
  482.   (if (= margin 0)
  483.     (setq-default auto-fill-hook nil)
  484.     (progn (setq-default fill-column (- (window-width) margin))
  485.        (setq-default auto-fill-hook 'do-auto-fill))))
  486.  
  487. (defconst evi-search-wraparound t
  488.   "*If t, search wraps around the end of the file.")
  489.  
  490. (defconst evi-insert-mode-local-bindings nil
  491.   "*If t, emacs buffer-local key bindings will be enabled in insert mode.")
  492.  
  493. ;; Ex commands
  494. ;; these are intended to be ordered roughly in order of frequency of use
  495.  
  496. (defvar ex-commands
  497.   '((("edit" . 1) . ((0 . ((nil . "!") (t . offset) (t . file))) . ex-edit))
  498.     (("buffer" . 1) . ((0 . ((nil . "!") (t . buffer))) . ex-change-buffer))
  499.     (("read" . 1) . ((1 . ((t . "!") (t . file))) . ex-read))
  500.     (("write" . 1) . ((2 . ((nil . "!") (t . ">>") (t . file))) . ex-write))
  501.     (("kill" . 1) . ((0 . ((nil . "!") (t . buffer))) . ex-kill-buffer))
  502.     (("next" . 1) . ((0 . ((nil . "!") (t . files))) . ex-next))
  503.     (("Edit" . 1) .
  504.      ((0 . ((nil . "!") (nil . offset) (t . file))) . ex-edit-other-window))
  505.     (("Buffer" . 1) .
  506.      ((0 . ((nil . "!") (t . buffer))) . ex-change-buffer-other-window))
  507.     (("Write" . 1) . ((0 . ((nil . "!"))) . ex-write-all-buffers))
  508.     (("Next" . 1) . ((0 . ((nil . "!") (t . files))) . ex-next-other-window))
  509.     (("set" . 2) . ((0 . ((nil . settings))) . ex-set))
  510.     (("substitute" . 1) .
  511.      ((2 . ((t . regular-expression) (backup . regular-expression2)
  512.         (nil . "g") (nil . "c"))) . ex-substitute))
  513.     (("global" . 1) .
  514.      ((2 . ((t . regular-expression) (t . command))) . ex-global))
  515.     (("map" . 3) .
  516.      ((0 . ((nil . "!") (t . map) (t . words))) . ex-map))
  517.     (("gdb" . 2) . ((0 . ((t . file))) . ex-gdb))
  518.     (("wk" . 2) . ((0 . nil) . ex-write-kill))
  519.     (("wq" . 2) . ((0 . ((nil . "!"))) . ex-write-quit))
  520.     (("Wq" . 2) . ((0 . ((nil . "!"))) . ex-write-all-and-quit))
  521.     (("abbreviate" . 2) .
  522.      ((0 . ((t . abbrev) (t . words))) . ex-abbrev))
  523.     (("append" . 1) . ((1 . nil) . ex-not-implemented))
  524.     (("args" . 2) . ((0 . nil) . ex-not-implemented))
  525.     (("bug" . 3) . ((0 . ((t . words))) . ex-report-bug))
  526.     (("cd" . 2) . ((0 . ((t . file))) . ex-change-directory))
  527.     (("change" . 1) . ((2 . nil) . ex-not-implemented))
  528.     (("chdir" . 3) . ((0 . ((t . file))) . ex-change-directory))
  529.     (("copy" . 2) . ((2 . ((t . address))) . ex-copy))
  530.     (("delete" . 1) . ((2 . ((t . register))) . ex-delete))
  531.     (("dirs" . 2) . ((0 . nil) . ex-directory-stack))
  532.     (("elisp" . 2) . ((0 . ((t . rest-of-line))) . ex-elisp-execute))
  533.     (("evilist" . 4) . ((0 . ((t . words))) . ex-mail-list))
  534.     (("file" . 1) . ((0 . ((t . file))) . ex-file))
  535.     (("insert" . 1) . ((1 . nil) . ex-not-implemented))
  536.     (("join" . 1) . ((2 . nil) . ex-not-implemented))
  537.     (("list" . 1) . ((2 . nil) . ex-not-implemented))
  538.     (("mail" . 3) . ((0 . ((t . words))) . ex-mail))
  539.     (("mark" . 2) . ((1 . ((t . mark))) . ex-mark))
  540.     (("move" . 1) . ((2 . ((t . address))) . ex-move))
  541.     (("number" . 2) . ((2 . nil) . ex-not-implemented))
  542.     (("popd" . 2) . ((0 . nil) . ex-pop-directory))
  543.     (("preserve" . 3) . ((0 . nil) . ex-preserve))
  544.     (("previous" . 4) . ((0 . nil) . ex-not-implemented))
  545.     (("print" . 1) . ((2 . nil) . ex-print))
  546.     (("pushd" . 4) . ((0 . ((t . file))) . ex-push-directory))
  547.     (("put" . 2) . ((1 . ((t . register))) . ex-put))
  548.     (("quit" . 1) . ((0 . ((nil . "!"))) . ex-quit))
  549.     (("recover" . 3) . ((0 . ((nil . "!") (t . file))) . ex-recover))
  550.     (("initialize" . 3) . ((0 . nil) . ex-initialize))
  551.     (("rewind" . 3) . ((0 . nil) . ex-not-implemented))
  552.     (("send" . 3) . ((0 . ((nil . "!"))) . ex-send-mail))
  553.     (("shell" . 2) . ((0 . nil) . ex-shell))
  554.     (("source" . 2) . ((0 . ((t . file))) . ex-source-file))
  555.     (("tag" . 1) . ((0 . ((t . word))) . ex-tag))
  556.     (("unabbreviate" . 3) . ((0 . ((t . abbrev))) . ex-unabbrev))
  557.     (("undo" . 1) . ((0 . nil) . ex-not-implemented))
  558.     (("unmap" . 3) . ((0 . ((nil . "!") (t . word))) . ex-unmap))
  559.     (("version" . 2) . ((0 . nil) . ex-evi-version))
  560.     (("xit" . 1) . ((0 . nil) . ex-not-implemented))
  561.     (("yank" . 1) . ((2 . ((t . register))) . ex-yank))
  562.     (("!" . 1) . ((2 . ((nil . "&") (t . shell-command))) . ex-shell-command))
  563.     (("<" . 1) . ((2 . nil) . ex-shift-left))
  564.     (("=" . 1) . ((2 . nil) . ex-not-implemented))
  565.     ((">" . 1) . ((2 . nil) . ex-shift-right))
  566.     (("&" . 1) . ((2 . nil) . ex-substitute-again))
  567.     (("@" . 1) . ((2 . nil) . ex-not-implemented))
  568.     (("" . 0) . ((2 . nil) . ex-null))))
  569.  
  570. ;; Macros
  571.  
  572. (defmacro evi-defmotion (&rest args)
  573.   (let* ((direction (car args))
  574.      (function (car (cdr args)))
  575.      (params (nth 2 args))
  576.      (documentation (nth 3 args))
  577.      (body (nthcdr 4 args))
  578.      (do-function (intern (concat "do-" (symbol-name function)))))
  579.     ; ZZ some rather narly hard-coding here, but does the trick for now
  580.     (cond ((eq (car params) '&char)
  581.         (` (progn (defun (, function) () (, documentation)
  582.             (interactive)
  583.             (evi-motion-command (quote (, do-function))
  584.                         (quote (, direction))
  585.                         evi-prefix-count evi-context
  586.                         (evi-read-command-char)))
  587.               (defun (, do-function) (, (cdr params)) (,@ body)))))
  588.       ((eq (car params) '&string)
  589.         (` (progn (defun (, function) () (, documentation)
  590.             (interactive)
  591.             (evi-motion-command
  592.               (quote (, do-function)) (quote (, direction))
  593.               evi-prefix-count evi-context
  594.               (evi-read-string (, (car (cdr params))))))
  595.               (defun (, do-function) (, (cdr (cdr params)))
  596.             (,@ body)))))
  597.       (t
  598.         (` (progn (defun (, function) () (, documentation)
  599.             (interactive)
  600.             (evi-motion-command
  601.               (quote (, do-function)) (quote (, direction))
  602.               evi-prefix-count evi-context))
  603.               (defun (, do-function) (, params) (,@ body))))))))
  604.  
  605. (defmacro evi-iterate (count &rest body)
  606.   (list 'let (list (list 'count count))
  607.       (append (list 'while (list '> 'count 0)) body
  608.           (list (list 'setq 'count (list '1- 'count))))
  609.       (list '= 'count 0)))
  610.  
  611. (defmacro evi-break ()
  612.   (list 'setq 'count -1))
  613.  
  614. (defmacro evi-enumerate-condition (item list condition &rest body)
  615.   (list 'let (list (list 'list list) (list item))
  616.     (append
  617.       (list 'while
  618.     (list 'and 'list
  619.           (list 'progn (list 'setq item '(car list)) condition)))
  620.       (if body
  621.     (append body '((setq list (cdr list))))
  622.     '((setq list (cdr list)))))
  623.     'list))
  624.  
  625. (defmacro evi-iterate-list (item list &rest body)
  626.   (list 'let (list (list 'list list) (list item) '(found))
  627.     (append
  628.       (list 'while 'list)
  629.       (append (list (list 'setq item '(car list)))
  630.           body '((setq list (cdr list)))))))
  631.  
  632. (defmacro evi-find (item list pred)
  633.   (list 'let (list (list 'list list) (list item) '(found))
  634.     (list 'while
  635.       (list 'and 'list
  636.         (list 'progn (list 'setq item '(car list) 'found pred)
  637.              '(not found)))
  638.       '(setq list (cdr list)))
  639.     'found))
  640.  
  641. (defmacro evi-set-goal-column ()
  642.   (` (if evi-reset-goal-column
  643.        (setq evi-goal-column (current-column)
  644.          evi-reset-goal-column nil))))
  645.  
  646. (defmacro evi-reset-goal-column ()
  647.   (` (setq evi-reset-goal-column t)))
  648.  
  649. (defmacro evi-register-text (register)
  650.   (list 'car register))
  651.  
  652. (defmacro evi-register-shape (register)
  653.   (list 'cdr register))
  654.  
  655. ;; Keymaps
  656.  
  657. (defun evi-define-key (maps key def)
  658.   (let ((meta-prefix-char -1))
  659.     (evi-enumerate-condition map maps t
  660.       (funcall 'define-key
  661.            (symbol-value
  662.         (intern (concat "evi-" (symbol-name map) "-map")))
  663.            key def))))
  664.  
  665. (defun evi-define-macro (maps key macro)
  666.   (evi-enumerate-condition map maps t
  667.     (eval (list 'define-key
  668.         (intern (concat "evi-" (symbol-name map) "-map")) 'key
  669.         (list 'quote (list 'lambda ()
  670.           '(interactive) (list 'evi-internal-macro macro)))))))
  671.  
  672. (defun evi-make-local-keymap (keydefs)
  673.   (let ((keymap (make-sparse-keymap)))
  674.     (if (fboundp 'set-keymap-name)
  675.     (set-keymap-name keymap 'evi-local))
  676.     (mapcar '(lambda (keydef)
  677.            (define-key keymap (eval (car keydef)) (nth 1 keydef)))
  678.         keydefs)
  679.     keymap))
  680.  
  681. ;                    "\C-a"
  682. (evi-define-key '(vi)            "\C-b" 'evi-scroll-page-backward)
  683. (evi-define-key '(vi)            "\C-c" 'keyboard-quit)
  684. (evi-define-key '(vi)            "\C-d" 'evi-scroll-text-forward)
  685. (evi-define-key '(vi)            "\C-e" 'evi-scroll-cursor-forward)
  686. (evi-define-key '(vi)            "\C-f" 'evi-scroll-page-forward)
  687. (evi-define-key '(vi)            "\C-g" 'evi-file-info)
  688. (evi-define-key '(vi motion)        "\C-h" 'evi-backward-char)
  689. ;                    "\C-i"
  690. (evi-define-key '(vi motion)        "\C-j" 'evi-next-line)
  691. ;                    "\C-k"
  692. (evi-define-key '(vi)            "\C-l" 'redraw-display)
  693. (evi-define-key '(vi motion)        "\C-m" 'evi-beginning-of-next-line)
  694. (evi-define-key '(vi motion)        "\C-n" 'evi-next-line)
  695. ;                    "\C-o"
  696. (evi-define-key '(vi motion)        "\C-p" 'evi-previous-line)
  697. ;                    "\C-q" (not implemented)
  698. (evi-define-key '(vi)            "\C-r" 'redraw-display)
  699. ;                    "\C-s"
  700. ;                    "\C-t" (not implemented)
  701. (evi-define-key '(vi)            "\C-u" 'evi-scroll-text-backward)
  702. ;                    "\C-v"
  703. ;                    "\C-w"
  704. ;                    "\C-x"
  705. (evi-define-key '(vi)            "\C-y" 'evi-scroll-cursor-backward)
  706. (evi-define-key '(vi)            "\C-z" 'suspend-emacs)
  707. ;                    "\C-[" (ESC)
  708. ;                    "\C-\"
  709. (evi-define-key '(vi)            "\C-]" 'evi-tag)
  710. (evi-define-macro '(vi)            "\C-^" ":e#\n")
  711.  
  712. (evi-define-key '(vi motion)        " " 'evi-forward-char)
  713. (evi-define-key '(vi)            "!" 'evi-shell-filter)
  714. (evi-define-key '(vi)            "\"" 'evi-prefix-register)
  715. ;                    "#"
  716. (evi-define-key '(vi motion)        "$" 'evi-end-of-line)
  717. (evi-define-key '(vi motion)        "%" 'evi-paren-match)
  718. (evi-define-key '(vi)            "&" 'evi-substitute-again)
  719. (evi-define-key '(vi motion)        "'" 'evi-goto-mark-vertical)
  720. (evi-define-key '(vi motion)        "(" 'evi-backward-sentence)
  721. (evi-define-key '(vi motion)        ")" 'evi-forward-sentence)
  722. (evi-define-key '(vi)            "*" 'evi-send-to-process)
  723. (evi-define-key '(vi motion)        "+" 'evi-beginning-of-next-line)
  724. (evi-define-key '(vi motion)        "," 'evi-find-next-character-reverse)
  725. (evi-define-key '(vi motion)        "-" 'evi-beginning-of-previous-line)
  726. (evi-define-key '(vi)            "." 'evi-repeat)
  727. (evi-define-key '(vi motion)        "/" 'evi-search-forward)
  728. (evi-define-key '(vi motion)        "0" 'evi-beginning-of-line)
  729. (evi-define-key '(vi motion)        "1" 'evi-prefix-digit)
  730. (evi-define-key '(vi motion)        "2" 'evi-prefix-digit)
  731. (evi-define-key '(vi motion)        "3" 'evi-prefix-digit)
  732. (evi-define-key '(vi motion)        "4" 'evi-prefix-digit)
  733. (evi-define-key '(vi motion)        "5" 'evi-prefix-digit)
  734. (evi-define-key '(vi motion)        "6" 'evi-prefix-digit)
  735. (evi-define-key '(vi motion)        "7" 'evi-prefix-digit)
  736. (evi-define-key '(vi motion)        "8" 'evi-prefix-digit)
  737. (evi-define-key '(vi motion)        "9" 'evi-prefix-digit)
  738. (evi-define-key '(vi)            ":" 'evi-ex-command)
  739. (evi-define-key '(vi motion)        ";" 'evi-find-next-character)
  740. (evi-define-key '(vi)            "<" 'evi-shift-left)
  741. (evi-define-key '(vi)            "=" 'evi-indent)
  742. (evi-define-key '(vi)            ">" 'evi-shift-right)
  743. (evi-define-key '(vi motion)        "?" 'evi-search-backward)
  744. (evi-define-key '(vi)            "@" 'evi-register-macro)
  745.  
  746. (evi-define-macro '(vi)            "A" "$#i")
  747. (evi-define-key '(vi motion)        "B" 'evi-backward-Word)
  748. (evi-define-macro '(vi)            "C" "&c#$")
  749. (evi-define-macro '(vi)            "D" "&d#$")
  750. (evi-define-key '(vi motion)        "E" 'evi-end-of-Word)
  751. (evi-define-key '(vi motion)        "F" 'evi-find-char-backwards)
  752. (evi-define-key '(vi motion)        "G" 'evi-goto-line)
  753. (evi-define-key '(vi motion)        "H" 'evi-goto-top-of-window)
  754. (evi-define-macro '(vi)            "I" "^#i")
  755. (evi-define-key '(vi)            "J" 'evi-join-lines)
  756. ;                    "K"
  757. (evi-define-key '(vi motion)        "L" 'evi-goto-bottom-of-window)
  758. (evi-define-key '(vi motion)        "M" 'evi-goto-middle-of-window)
  759. (evi-define-key '(vi motion)        "N" 'evi-search-next-reverse)
  760. (evi-define-key '(vi)            "O" 'evi-open-before)
  761. (evi-define-key '(vi)            "P" 'evi-put)
  762. (evi-define-key '(vi)            "Q" 'evi-quit-evi)
  763. (evi-define-key '(vi)            "R" 'evi-replace)
  764. (evi-define-macro '(vi)            "S" "&c#c")
  765. (evi-define-key '(vi motion)        "T" 'evi-find-char-backwards-after)
  766. (evi-version-case
  767.   ("Emacs 18\.5[789]\\|Epoch 4\\|Emacs 19.*Lucid"
  768.     (evi-define-key '(vi)        "U" 'evi-undo-line)))
  769. ;                    "V"
  770. (evi-define-key '(vi motion)        "W" 'evi-forward-Word)
  771. (evi-define-macro '(vi)            "X" "&d#h")
  772. (evi-define-macro '(vi)            "Y" "&y#y")
  773. (evi-define-macro '(vi)            "ZZ" ":Wq!\n")
  774.  
  775. (evi-define-key '(vi motion)        "[[" 'evi-backward-section)
  776. (evi-define-key '(vi motion)        "[(" 'evi-parameterized-macro)
  777. (evi-define-key '(vi)            "[u" 'evi-undo-more)
  778. (evi-define-key '(vi)            "[{" 'evi-loop-over-lines-in-region)
  779. (evi-define-key '(vi motion)        "]]" 'evi-forward-section)
  780. (evi-define-key '(vi motion)        "^" 'evi-goto-indentation)
  781. (evi-define-key '(vi)            "_" 'evi-prompt-repeat)
  782. (evi-define-key '(vi motion)        "`" 'evi-goto-mark-horizontal)
  783.  
  784. (evi-define-macro '(vi)            "a" "l#i")
  785. (evi-define-key '(vi motion)        "b" 'evi-backward-word)
  786. (evi-define-key '(vi)            "c" 'evi-change)
  787. (evi-define-key '(vi)            "d" 'evi-delete)
  788. (evi-define-key '(vi motion)        "e" 'evi-end-of-word)
  789. (evi-define-key '(vi motion)        "f" 'evi-find-character)
  790. ;                    "g"
  791. (evi-define-key '(vi motion)        "h" 'evi-backward-char)
  792. (evi-define-key '(vi)            "i" 'evi-insert)
  793. (evi-define-key '(vi motion)        "j" 'evi-next-line)
  794. (evi-define-key '(vi motion)        "k" 'evi-previous-line)
  795. (evi-define-key '(vi motion)        "l" 'evi-forward-char)
  796. (evi-define-key '(vi)            "m" 'evi-set-mark)
  797. (evi-define-key '(vi motion)        "n" 'evi-search-next)
  798. (evi-define-key '(vi)            "o" 'evi-open-after)
  799. (evi-define-key '(vi)            "p" 'evi-put-after)
  800. ;                    "q"
  801. (evi-define-key '(vi)            "r" 'evi-replace-char)
  802. (evi-define-macro '(vi)            "s" "&c#l")
  803. (evi-define-key '(vi motion)        "t" 'evi-find-character-before)
  804. (evi-define-key '(vi)            "u" 'evi-undo)
  805. ;                    "v"
  806. (evi-define-key '(vi motion)        "w" 'evi-forward-word)
  807. (evi-define-macro '(vi)            "x" "&d#l")
  808. (evi-define-key '(vi)            "y" 'evi-yank)
  809. (evi-define-key '(vi)            "z" 'evi-window-control)
  810.  
  811. (evi-define-key '(vi motion)        "{" 'evi-backward-paragraph)
  812. (evi-define-key '(vi motion)        "|" 'evi-goto-column)
  813. (evi-define-key '(vi motion)        "}" 'evi-forward-paragraph)
  814. (evi-define-key '(vi)            "~" 'evi-toggle-case)
  815.  
  816. (evi-define-key '(internal)        "&" 'evi-register-parameter)
  817. (evi-define-key '(internal motion)    "#" 'evi-prefix-count-parameter)
  818. (evi-define-key '(internal)        "\n" 'evi-self-insert)
  819. (evi-define-key '(internal)        "\t" 'evi-maybe-indent)
  820.  
  821. (evi-define-key '(motion)        "a" 'evi-region-arbitrary)
  822. (evi-define-key '(motion)        "r" 'evi-region-rectangle)
  823. (evi-define-key '(motion)        "R" 'evi-region-rows)
  824. (evi-define-key '(motion)        "C" 'evi-region-columns)
  825.  
  826. ; ZZ should define for replace mode also?
  827. (evi-define-key '(input) "\C-v" 'evi-quoted-insert)
  828.  
  829. (evi-define-key '(input replace) "\C-c" 'evi-input-mode-quit)
  830. (evi-define-key '(input replace) "\e" 'evi-exit-command-loop)
  831.  
  832. (evi-define-key '(insert) "\C-d" 'evi-backward-indent)
  833. (evi-define-key '(insert) "\C-h" 'evi-insert-mode-delete-backward-char)
  834. (evi-define-key '(insert) "\C-j" 'evi-newline)
  835. (evi-define-key '(insert) "\C-m" 'evi-newline)
  836. (evi-define-key '(insert) "\C-t" 'evi-forward-indent)
  837. (evi-define-macro '(insert) "\C-w" "db")
  838. (evi-define-macro '(insert) "\C-x" "d0")
  839. (evi-define-key '(insert) "\177" 'evi-insert-mode-delete-backward-char)
  840.  
  841. ;(evi-define-key (replace) "\C-d" 'evi-backward-indent)
  842. (evi-define-key '(replace) "\C-h" 'evi-replace-mode-delete-backward-char)
  843. ;(evi-define-key (replace) "\C-t" 'evi-forward-indent)
  844. ;(evi-define-key (replace) "\C-w" 'evi-delete-backward-word)
  845. (evi-define-key '(replace) "\177" 'evi-replace-mode-delete-backward-char)
  846.  
  847. (evi-define-key '(read-string ex) "\C-j" 'evi-exit-command-loop)
  848. (evi-define-key '(read-string ex) "\C-m" 'evi-exit-command-loop)
  849.  
  850. (evi-define-key '(read-string ex) "\C-h" 'evi-delete-backward-char-maybe-abort)
  851. (evi-define-key '(read-string ex) "\177" 'evi-delete-backward-char-maybe-abort)
  852.  
  853. (evi-define-key '(ex) "\C-i" 'ex-complete)
  854.  
  855. (evi-define-key '(shell) "\C-m" 'shell-send-input)
  856.  
  857. (evi-version-case
  858.  ("Emacs 19.*Lucid"
  859.   ; must find out how/if this interacts with the definition of ESC
  860.   ; ZZ - both vi and top-level in a map list is redundant - something's afoot
  861.   (let ((maps '(vi motion top-level)))
  862.     (evi-define-key maps 'down      'evi-next-line)
  863.     (evi-define-key maps 'up      'evi-previous-line)
  864.     (evi-define-key maps 'left      'evi-backward-char)
  865.     (evi-define-key maps 'right      'evi-forward-char)
  866.  
  867.     (evi-define-key maps 'button1 'evi-mouse-track)
  868.     (evi-define-key maps 'button2 'evi-x-set-point-and-insert-selection)
  869.     (evi-define-key maps '(control button1) 'evi-mouse-track-insert)
  870.     (evi-define-key maps '(control button2) 'evi-x-mouse-kill))
  871.  
  872.   (defun evi-mouse-track (event)
  873.     (interactive "e")
  874.     (mouse-track event)
  875.     (evi-fixup-cursor 'vertical))
  876.  
  877.   (defun evi-mouse-track-insert (event)
  878.     (interactive "e")
  879.     (mouse-track-insert event)
  880.     (evi-fixup-cursor 'vertical))
  881.  
  882.   (defun evi-x-mouse-kill (event)
  883.     (interactive "e")
  884.     (x-mouse-kill event)
  885.     (evi-fixup-cursor 'vertical))
  886.  
  887.   (defun evi-x-set-point-and-insert-selection (event)
  888.     (interactive "e")
  889.     (x-set-point-and-insert-selection event)
  890.     (evi-fixup-cursor 'vertical))
  891.   ))
  892.  
  893. ;; Command macros
  894.  
  895. (defun evi-parameterized-macro ()
  896.   (interactive)
  897.   (let* ((macro (evi-read-string "(")) ;)
  898.      (evi-register-parameter evi-register-spec)
  899.      (evi-register-spec nil)
  900.      (evi-prefix-count-parameter evi-prefix-count)
  901.      (evi-prefix-count nil))
  902.     (evi-execute-macro macro)
  903.     (evi-fixup-cursor 'vertical)))
  904.  
  905. (defun evi-internal-macro (macro)
  906.   (let ((evi-register-parameter evi-register-spec)
  907.     (evi-register-spec nil)
  908.     (evi-prefix-count-parameter evi-prefix-count)
  909.     (evi-prefix-count nil)
  910.     (evi-default-keymap-list (list evi-internal-map evi-vi-map))
  911.     (evi-internal-command t))
  912.     (evi-execute-macro macro))
  913.   (evi-fixup-cursor 'vertical))
  914.  
  915. (defun evi-register-macro (char &optional count)
  916.   (interactive (evi-character-arg))
  917.   (let* ((evi-last-command-keys nil)
  918.      (register-number (evi-register-number char))
  919.      (macro (evi-register-text (aref evi-registers register-number))))
  920.     (setq evi-last-macro-register register-number)
  921.     (evi-execute-macro macro)))
  922.  
  923. ;; And now we have to do our own keyboard macros...  emacs `keyboard' macros
  924. ;; don't cut it as they don't believe in hierarchical commands - the macro
  925. ;; has to terminate at the same lisp execution depth as it started.  This
  926. ;; is OK for emacs 'cause emacs commands don't build on each other like vi
  927. ;; commands do.  If anyone has any idea of how to make emacs `keyboard' macros
  928. ;; behave in a manner independent of their execution context, please let me
  929. ;; know.
  930. (defvar evi-unread-command-char nil)
  931. (defvar evi-macro-stack nil)
  932. (defvar evi-current-macro nil)
  933. (defvar evi-current-macro-index nil)
  934.  
  935. (defun evi-execute-macro (macro)
  936.   (evi-push-macro)
  937.   (setq evi-current-macro macro
  938.     evi-current-macro-index 0)
  939.   (while evi-current-macro
  940.     (evi-get-command)))
  941.  
  942. (defun evi-read-string (prompt &optional initial keymap-list)
  943.   (let ((result
  944.     (save-window-excursion
  945.       ; this seems unduly complicated...
  946.       (set-buffer (window-buffer (minibuffer-window)))
  947.       (select-window (minibuffer-window))
  948.       (erase-buffer)
  949.       (insert prompt)
  950.       (setq evi-insert-point (point))
  951.       (if initial
  952.     (insert initial))
  953.       (prog1
  954.     (catch 'quit
  955.       (if (evi-command-loop
  956.         (or keymap-list
  957.           (list evi-input-map-map evi-read-string-map evi-input-map)))
  958.         (buffer-substring (1+ (length prompt)) (point-max))))
  959.     (erase-buffer)))))
  960.     (cond ((eq result t)
  961.         (keyboard-quit))
  962.       (result result)
  963.       (t (throw 'abort t)))))
  964.  
  965. (defun evi-read-char ()
  966.   (if evi-unread-command-char
  967.     (prog1 evi-unread-command-char
  968.        (setq evi-unread-command-char nil))
  969.     (if evi-current-macro
  970.       (prog1 (aref evi-current-macro evi-current-macro-index)
  971.          (setq evi-current-macro-index (1+ evi-current-macro-index))
  972.          (if (= evi-current-macro-index (length evi-current-macro))
  973.            (evi-pop-macro)))
  974.       (read-char))))
  975.  
  976. (defun evi-push-macro ()
  977.   (setq evi-macro-stack (cons (cons evi-current-macro evi-current-macro-index)
  978.                   evi-macro-stack)))
  979.  
  980. (defun evi-pop-macro ()
  981.   (setq evi-current-macro (car (car evi-macro-stack))
  982.     evi-current-macro-index (cdr (car evi-macro-stack))
  983.     evi-macro-stack (cdr evi-macro-stack)))
  984.  
  985. (defun evi-internal-command ()
  986.   (interactive)
  987.   (let ((evi-internal-command t))
  988.     (evi-get-command (list evi-internal-map evi-vi-map))))
  989.  
  990. (defun evi-register-parameter ()
  991.   (interactive)
  992.   (let ((evi-register-spec evi-register-parameter))
  993.     (evi-get-command)))
  994.  
  995. (defun evi-prefix-count-parameter ()
  996.   (interactive)
  997.   (let ((evi-prefix-count evi-prefix-count-parameter))
  998.     (evi-get-command)))
  999.  
  1000. ;; Errors
  1001.  
  1002. (defun evi-error (&rest args)
  1003.   (throw 'abort (apply 'format args)))
  1004.  
  1005. ;; Get command
  1006.  
  1007. (defun evi-command-loop (keymap-list)
  1008.   (let ((evi-default-keymap-list keymap-list)
  1009.     (loop-command-keys evi-command-keys))
  1010.     (prog1
  1011.       (catch 'exit
  1012.     (while t
  1013.       (setq evi-command-keys "")
  1014.       (let ((message
  1015.           (catch 'abort
  1016.             (evi-get-command keymap-list))))
  1017.         (if message
  1018.           (if (not (eq message t))
  1019.         (message message))
  1020.           (setq loop-command-keys
  1021.             (concat loop-command-keys evi-command-keys))))))
  1022.       (setq evi-command-keys (concat loop-command-keys evi-command-keys)))))
  1023.  
  1024. (defun evi-top-level-command ()
  1025.   (interactive)
  1026.   (setq evi-unread-command-char last-command-char)
  1027.   (let* ((echo-keystrokes 0)
  1028.      (blink-matching-paren evi-show-match)
  1029.      (evi-command-keys "")
  1030.      (evi-prompted nil)
  1031.      (message (if evi-debug
  1032.               (catch 'abort
  1033.             (evi-get-command
  1034.               (list evi-map-map evi-buffer-local-vi-map
  1035.                 evi-vi-map)))
  1036.             (condition-case code
  1037.             (catch 'abort
  1038.               (evi-get-command
  1039.                 (list evi-map-map evi-buffer-local-vi-map
  1040.                   evi-vi-map)))
  1041.               (error
  1042.             (if (not (eq evi-mode 'vi))
  1043.               (progn
  1044.                 (if (or (eq evi-mode 'replace)
  1045.                     (eq evi-mode 'change))
  1046.                   (evi-exit-replace-mode))
  1047.                 (evi-exit-input-mode)))
  1048.             (while evi-current-macro
  1049.               (evi-pop-macro))
  1050.             (evi-fixup-cursor 'horizontal)
  1051.             (signal (car code) (cdr code)))))))
  1052.     (if message
  1053.       (progn (if (not (eq message t))
  1054.            (progn (if evi-error-bell (beep))
  1055.               (message message)))
  1056.          (evi-fixup-cursor 'horizontal)))
  1057.     (if evi-number
  1058.     (evi-update-number (point)))))
  1059.  
  1060. (defun evi-emacs-command ()
  1061.   (interactive)
  1062.   (evi-unread-command-char last-command-char)
  1063.   (condition-case code
  1064.       (if evi-global-directory
  1065.       (let ((default-directory (evi-current-directory)))
  1066.         (evi-get-command (if evi-emacs-local-map
  1067.                  (list evi-emacs-local-map
  1068.                        (current-global-map))
  1069.                    (list (current-global-map)))))
  1070.     (evi-get-command (if evi-emacs-local-map
  1071.                  (list evi-emacs-local-map (current-global-map))
  1072.                    (list (current-global-map)))))
  1073.     (error
  1074.      (signal (car code) (cdr code)))))
  1075.  
  1076. (defun evi-exit-command-loop ()
  1077.   (interactive)
  1078.   (throw 'exit t))
  1079.  
  1080. (defun evi-get-command (&optional keymap-list)
  1081.   (let* ((current-keymap-list (or keymap-list evi-default-keymap-list))
  1082.      (inhibit-quit t)
  1083.      (char (evi-read-command-char))
  1084.      (keys (char-to-string char))
  1085.      (keydef))
  1086.     (evi-enumerate-condition keymap current-keymap-list
  1087.       (progn
  1088.     (if (keymapp keymap)
  1089.         (setq keydef (lookup-key keymap keys))
  1090.       ; otherwise... we have a pair where the cdr is the keymap and
  1091.       ; the car is a list of chars that we want to pass-thru this keymap
  1092.       (if (memq (aref keys 0) (car keymap))
  1093.           (setq keydef nil)
  1094.         ; a bit of a hack to get the local binding for meta commands
  1095.         ; if the first char of this key sequence is our meta prefix,
  1096.         ; pretend it was an ESC
  1097.         (if (eq (aref keys 0) evi-meta-prefix-char)
  1098.         ; is the \e too hardcoded?
  1099.         (setq keydef (lookup-key (cdr keymap)
  1100.                      (concat "\e" (substring keys 1))))
  1101.           (setq keydef (lookup-key (cdr keymap) keys)))))
  1102.     (while
  1103.       (cond ((keymapp keydef)
  1104.           (setq char (evi-read-command-char)
  1105.             keys (concat keys (char-to-string char))
  1106.             keydef (lookup-key keydef (char-to-string char)))
  1107.           t)
  1108.         ((stringp keydef)
  1109.           (if evi-prompted (message ""))
  1110.           (setq last-command-char char
  1111.             evi-prompted nil)
  1112.           (let ((evi-last-command-keys nil))
  1113.             (setq quit-flag nil
  1114.               inhibit-quit nil)
  1115.             (evi-execute-macro keydef))
  1116.           nil)
  1117.         ((commandp keydef)
  1118.           (if evi-prompted (message ""))
  1119.           (setq last-command-char char
  1120.             evi-prompted nil
  1121.             quit-flag nil
  1122.             inhibit-quit nil)
  1123.           (call-interactively keydef)
  1124.           nil)
  1125.         (t
  1126.           (setq keydef nil))))
  1127.     (not keydef)))
  1128.     (or keydef (progn (beep)
  1129.               (evi-error "Unknown command `%s'" keys))))
  1130.   nil)
  1131.  
  1132. (defun evi-read-command-char ()
  1133.   (if evi-current-macro
  1134.     ; don't add the contents of a macro to evi-command-keys (test this now
  1135.     ; because the current command char may be the last char in the macro)
  1136.     (evi-read-char)
  1137.     (progn
  1138.       (and evi-command-keys (> (length evi-command-keys) 0) (evi-sit-for 1)
  1139.        (progn (message "%s -"
  1140.             (mapconcat 'single-key-description evi-command-keys ""))
  1141.           (setq evi-prompted t)))
  1142.       (let ((char (evi-read-char)))
  1143.     ; probably lousy on garbage collection... 
  1144.     (if evi-command-keys
  1145.       (setq evi-command-keys
  1146.         (concat evi-command-keys (char-to-string char))))
  1147.     char))))
  1148.  
  1149. (defun evi-unread-command-char (char)
  1150.   (setq evi-unread-command-char char)
  1151.   (let ((length (length evi-command-keys)))
  1152.     (if (> length 0)
  1153.     (setq evi-command-keys (substring evi-command-keys 0 (1- length))))))
  1154.  
  1155. (defun evi-sit-for (count)
  1156.   (if evi-unread-command-char nil (sit-for count)))
  1157.  
  1158. ;; Interactive args
  1159.  
  1160. (defun evi-count-arg ()
  1161.   (list evi-prefix-count))
  1162.  
  1163. (defun evi-register-args ()
  1164.   (list (car evi-register-spec) (cdr evi-register-spec) evi-prefix-count))
  1165.  
  1166. (defun evi-character-arg ()
  1167.   (list (evi-read-command-char) evi-prefix-count))
  1168.  
  1169. (defun evi-context-arg ()
  1170.   (list evi-context))
  1171.  
  1172. ;; Mode line
  1173.  
  1174. (defvar evi-mode-line-format " Evi:%-6s")
  1175.  
  1176. (defun evi-in-mode-line-p (var)
  1177.   (if (listp mode-line-buffer-identification)
  1178.       (memq var mode-line-buffer-identification)
  1179.     nil))
  1180.  
  1181. (defun evi-install-in-mode-line (var)
  1182.   (or (evi-in-mode-line-p var)
  1183.       (setq mode-line-buffer-identification
  1184.         (if (listp mode-line-buffer-identification)
  1185.         (append mode-line-buffer-identification (list var))
  1186.           (cons mode-line-buffer-identification (list var))))))
  1187.  
  1188. (defun evi-deinstall-from-mode-line (var)
  1189.   (if (evi-in-mode-line-p var)
  1190.       (setq mode-line-buffer-identification
  1191.         (evi-filter (function (lambda (mode-var) (not (eq var mode-var))))
  1192.             mode-line-buffer-identification))))
  1193.  
  1194. (defun evi-change-mode-id (string)
  1195.   "Change Evi's mode identification string to STRING."
  1196.   (setq evi-mode-string (format evi-mode-line-format string)))
  1197.  
  1198. (defun evi-refresh-mode-line ()
  1199.   "Redraw mode line."
  1200.   (set-buffer-modified-p (buffer-modified-p)))
  1201.  
  1202. ;; Initializing
  1203.  
  1204. (defun evi-my-file (filename)
  1205.   (let ((attr (file-attributes filename)))
  1206.     (and attr
  1207.      (eq (car (cdr (cdr attr))) (user-uid)))))
  1208.  
  1209. (defun evi-initialize ()
  1210.   (setq evi-initialized t)
  1211.   (setq evi-directory-stack (list default-directory))
  1212.   (evi-customize))
  1213.  
  1214. (defun evi-customize ()
  1215.   ; mimic emacs startup behaviour:
  1216.   ;   if su'd, use effective login name to find startup files (??)
  1217.   (let* ((user-name (user-login-name))
  1218.      (home (if (string= user-name (user-real-login-name))
  1219.          "~"
  1220.          (concat "~" user-name))))
  1221.     (if (file-readable-p "~/.evirc") (load-file (concat home "/.evirc")))
  1222.     (and (file-readable-p ".evirc") (evi-my-file ".evirc")
  1223.      (load-file ".evirc"))
  1224.     (let* ((evi-interactive nil)
  1225.        (source)
  1226.        (message (catch 'abort
  1227.               (or evi-supress-ex-startup
  1228.               (progn
  1229.                 (setq source "~/.exrc")
  1230.                 (evi-do-ex-command-file (concat home "/.exrc"))
  1231.                 (setq source "EXINIT")
  1232.                 (let ((exinit (getenv "EXINIT")))
  1233.                   (if exinit
  1234.                 (evi-do-ex-command-string exinit)))
  1235.                 (setq source ".exrc")
  1236.                 (if (evi-my-file ".exrc")
  1237.                 (evi-do-ex-command-file ".exrc"))))
  1238.               (setq source "~/.exrc.evi")
  1239.               (evi-do-ex-command-file (concat home "/.exrc.evi"))
  1240.               (setq source "EVIINIT")
  1241.               (let ((exinit (getenv "EVIINIT")))
  1242.             (if exinit
  1243.               (evi-do-ex-command-string exinit)))
  1244.               (setq source ".exrc.evi")
  1245.               (if (evi-my-file ".exrc.evi")
  1246.               (evi-do-ex-command-file ".exrc.evi"))
  1247.               nil)))
  1248.       (if message
  1249.     (progn
  1250.       (beep)
  1251.       (if (not (y-or-n-p (concat "Error in " source
  1252.                    (if (eq message t) "" (concat ": " message))
  1253.                    ". Continue? ")))
  1254.         (kill-emacs)))))))
  1255.  
  1256. ;; Startup & Shutdown
  1257.  
  1258. (defun evi ()
  1259.   "Start vi emulation in this buffer."
  1260.   (interactive)
  1261.   (if (not evi-enabled)
  1262.     (progn
  1263.       (or evi-initialized
  1264.       (evi-initialize))
  1265.       (setq evi-emacs-local-map (current-local-map))
  1266.       (evi-install-in-mode-line 'evi-mode-string)
  1267.       (evi-version-case
  1268.        ("Lucid"
  1269.     (set (make-local-variable 'interrupt-char) ?\C-c)))
  1270.       (if evi-meta-prefix-char
  1271.     (set (make-local-variable 'meta-prefix-char) evi-meta-prefix-char))))
  1272.   (let ((was-enabled evi-enabled))
  1273.     (setq evi-enabled t)
  1274.     (use-local-map evi-top-level-map)
  1275.     (if buffer-read-only
  1276.     (progn (toggle-read-only)
  1277.            (setq evi-buffer-read-only t)))
  1278.     (evi-change-mode-id "Vi")
  1279.     (evi-number evi-number)
  1280.     (or was-enabled (run-hooks 'evi-mode-hook))
  1281.     (evi-refresh-mode-line)))
  1282.  
  1283. (defun evi-quit-evi ()
  1284.   "Quit vi emulation in this buffer."
  1285.   (interactive)
  1286.   (setq evi-enabled nil)
  1287.   (evi-deinstall-from-mode-line 'evi-mode-string)
  1288.   (evi-deinstall-from-mode-line 'evi-number-string)
  1289.   (use-local-map evi-emacs-local-map)
  1290.   (kill-local-variable 'meta-prefix-char)
  1291.   (evi-version-case
  1292.    ("Lucid"
  1293.     (kill-local-variable 'interrupt-char)))
  1294.   (evi-refresh-mode-line))
  1295.  
  1296. ;; Minibuffer
  1297.  
  1298. (defun evi-delete-backward-char-maybe-abort ()
  1299.   "Backup and delete previous character, aborting command if at
  1300. beginning of input."
  1301.   (interactive)
  1302.   (if (<= (point) evi-insert-point)
  1303.     (throw 'exit nil))
  1304.   (delete-backward-char 1))
  1305.  
  1306. ;; Scrolling
  1307.  
  1308. (defun evi-scroll-page-forward (&optional count)
  1309.   "Scroll COUNT pages forward."
  1310.   (interactive (evi-count-arg))
  1311.   (scroll-up (if (eq (or count 1) 1)
  1312.            (- (window-height) 3)
  1313.            (* (1- (window-height)) (or count 1))))
  1314.   (evi-reset-goal-column))
  1315.  
  1316. (defun evi-scroll-page-backward (&optional count)
  1317.   "Scroll COUNT pages backward."
  1318.   (interactive (evi-count-arg))
  1319.   (scroll-down (if (eq (or count 1) 1)
  1320.          (- (window-height) 3)
  1321.          (* (1- (window-height)) (or count 1))))
  1322.   (evi-reset-goal-column))
  1323.  
  1324. (defun evi-scroll-text-forward (&optional count)
  1325.   "Scroll COUNT lines forward.  Default is one half of a page or the last COUNT
  1326. specified to either \\[evi-scroll-text-forward] or \\[evi-scroll-text-backward] if one was previously
  1327. given.  The position of the cursor on the screen is maintained."
  1328.   (interactive (evi-count-arg))
  1329.   (evi-set-goal-column)
  1330.   (let ((line-count (if count
  1331.               (setq evi-scroll-count count)
  1332.               (or evi-scroll-count (/ (1- (window-height)) 2))))
  1333.     (window-line (count-lines (window-start) (1+ (point)))))
  1334.     (scroll-up line-count)
  1335.     (forward-line (min (1- window-line) line-count))
  1336.     (evi-move-to-column evi-goal-column)))
  1337.  
  1338. (defun evi-scroll-text-backward (&optional count)
  1339.   "Scroll COUNT lines backward.  Default is one half of a page or the last COUNT
  1340. specified to either \\[evi-scroll-up] or \\[evi-scroll-down] if one was previously
  1341. given.  The position of the cursor on the screen is maintained."
  1342.   (interactive (evi-count-arg))
  1343.   (evi-set-goal-column)
  1344.   (let ((line-count (if count
  1345.               (setq evi-scroll-count count)
  1346.               (or evi-scroll-count (/ (1- (window-height)) 2))))
  1347.     (window-line (count-lines (window-start) (1+ (point)))))
  1348.     (scroll-down line-count)
  1349.     (forward-line (- (min (- (1- (window-height)) window-line) line-count)))
  1350.     (evi-move-to-column evi-goal-column)))
  1351.  
  1352. (defun evi-scroll-cursor-forward (&optional count)
  1353.   "Scroll COUNT lines forward.  Maintain cursor position in the file
  1354. if possible."
  1355.   (interactive (evi-count-arg))
  1356.   (evi-set-goal-column)
  1357.   (scroll-up (or count 1))
  1358.   (evi-move-to-column evi-goal-column))
  1359.  
  1360. (defun evi-scroll-cursor-backward (&optional count)
  1361.   "Scroll COUNT lines backward.  Maintain cursor position in the file
  1362. if possible."
  1363.   (interactive (evi-count-arg))
  1364.   (evi-set-goal-column)
  1365.   (scroll-down (or count 1))
  1366.   (evi-move-to-column evi-goal-column))
  1367.  
  1368. (defun evi-window-control (char &optional linenumber)
  1369.   "Position current line on the screen according to the following character.
  1370. With a prefix count, position that line."
  1371.   (interactive (evi-character-arg))
  1372.   (if linenumber
  1373.     (do-evi-goto-line linenumber))
  1374.   (cond ((and (>= char ?0) (<= char ?9))
  1375.       (let* ((count (evi-read-number (- char ?0)))
  1376.          (char (evi-read-command-char)))
  1377.         (cond ((= char ?.) (enlarge-window (- count (1- (window-height)))))
  1378.           ((= char ?+) (enlarge-window count))
  1379.           ((= char ?-) (shrink-window count))
  1380.           ((= char ?=) (cond ((= count 0) (delete-window))
  1381.                      ((= count 1) (delete-other-windows))
  1382.                      ((= count 2) (split-window-vertically))
  1383.                      (t (evi-error "Invalid window op"))))
  1384.           ((= char ?|) (cond ((= count 0) (delete-window))
  1385.                      ((= count 1) (delete-other-windows))
  1386.                      ((= count 2)
  1387.                     (split-window-horizontally)))))))
  1388.     ((or (= char ?f) (= char ?n)) (select-window (next-window)))
  1389.     ((or (= char ?b) (= char ?p)) (select-window (previous-window)))
  1390.     (t
  1391.       (let ((position
  1392.           (cond ((or (eq char ?\r) (eq char ?H)) 0)
  1393.             ((or (eq char ?.) (eq char ?M)) (/ (window-height) 2))
  1394.             ((or (eq char ?-) (eq char ?L)) (- (window-height) 2))
  1395.             (t (evi-error "Invalid window op")))))
  1396.         (recenter position))))
  1397.   (if evi-prompted (message "")))
  1398.  
  1399. ;; unlike the motion commands, the scroll commands have no wrapper function
  1400. ;; to fixup the cursor, soo...
  1401. (defun evi-move-to-column (column)
  1402.   (move-to-column column)
  1403.   (if (and (eolp) (not (bolp)))
  1404.     (backward-char)))
  1405.  
  1406. ;; Insert mode
  1407.  
  1408. (defun evi-insert (&optional count)
  1409.   "Enter insert mode."
  1410.   (interactive (evi-count-arg))
  1411.   (setq evi-insert-point (point))
  1412.   (evi-enter-insert count))
  1413.  
  1414. (defun evi-open-after (&optional count)
  1415.   "Open a new line below the current one and enter insert mode."
  1416.   (interactive (evi-count-arg))
  1417.   (end-of-line)
  1418.   (insert ?\n)
  1419.   (setq evi-insert-point (point))
  1420.   (evi-maybe-indent)
  1421.   (evi-enter-insert count))
  1422.  
  1423. (defun evi-open-before (&optional count)
  1424.   "Open a new line above the current one and enter insert mode."
  1425.   (interactive (evi-count-arg))
  1426.   (beginning-of-line)
  1427.   (insert ?\n)
  1428.   (backward-char)
  1429.   (setq evi-insert-point (point))
  1430.   (evi-maybe-indent t)
  1431.   (evi-enter-insert count))
  1432.  
  1433. (defun evi-enter-insert (&optional count)
  1434.   (evi-insert-mode count)
  1435.   (if (not (bolp)) (backward-char))
  1436.   (evi-reset-goal-column)
  1437.   (evi-save-command-keys))
  1438.  
  1439. (defun evi-local-insert-map ()
  1440.   (if (and evi-insert-mode-local-bindings evi-emacs-local-map)
  1441.       (cons evi-emacs-local-suppress-key-list evi-emacs-local-map)
  1442.     evi-empty-keymap))
  1443.  
  1444. (defun evi-insert-mode (&optional count)
  1445.   (setq evi-mode 'insert)
  1446.   (and (eobp) (not buffer-read-only)
  1447.        (progn (newline 1) (backward-char 1)))
  1448.   (evi-change-mode-id "Insert")
  1449.   (evi-refresh-mode-line)
  1450.   (if (catch 'quit
  1451.     (evi-command-loop (list evi-input-map-map (evi-local-insert-map)
  1452.                 evi-insert-map evi-input-map))
  1453.     nil)
  1454.     (progn (evi-exit-input-mode)
  1455.        (beep)
  1456.        (evi-error "Quit"))
  1457.     (progn (evi-maybe-kill-indentation)
  1458.        (evi-exit-input-mode count))))
  1459.  
  1460. (defun evi-exit-input-mode (&optional count)
  1461.   "Exit from an input mode."
  1462.   (interactive)
  1463.   (ex-expand-abbrev)
  1464.   (if count
  1465.     (let ((input-string (buffer-substring evi-insert-point (point))))
  1466.       (evi-iterate (1- count)
  1467.     (insert input-string))))
  1468.   (setq evi-mode 'vi)
  1469.   (evi-change-mode-id "Vi")
  1470.   (evi-refresh-mode-line))
  1471.  
  1472. (defun evi-input-mode-quit ()
  1473.   "Abort and exit from an input mode."
  1474.   (interactive)
  1475.   (throw 'quit t))
  1476.  
  1477. (defun evi-insert-mode-delete-backward-char ()
  1478.   "Backup and delete previous character, but no further than insert point."
  1479.   (interactive)
  1480.   (if (> (point) evi-insert-point)
  1481.     (delete-backward-char 1)
  1482.     (message "Beginning of inserted text")))
  1483.  
  1484. (defun evi-maybe-indent (&optional forward)
  1485.   (interactive)
  1486.   (if evi-auto-indent
  1487.     (progn
  1488.       (let ((start (point)))
  1489.     (skip-chars-forward " \t")
  1490.     (delete-region start (point)))
  1491.       (if (or (not evi-insert-mode-local-bindings)
  1492.           (eq indent-line-function 'indent-to-left-margin))
  1493.     (indent-to (save-excursion
  1494.              (if forward (forward-char) (backward-char))
  1495.              (current-indentation)))
  1496.     (indent-according-to-mode))
  1497.       (setq evi-current-indentation (current-column)))))
  1498.  
  1499. (defun evi-maybe-kill-indentation ()
  1500.   (and evi-auto-indent (= evi-current-indentation (current-column))
  1501.     (let ((region
  1502.        (save-excursion
  1503.          (let ((start (if (progn (skip-chars-backward " \t") (bolp))
  1504.                 (point))))
  1505.            (if (and start (progn (skip-chars-forward " \t") (eolp)))
  1506.          (cons start (point)))))))
  1507.       (if region
  1508.     (delete-region (car region) (cdr region))))))
  1509.  
  1510. (defun evi-newline ()
  1511.   "Insert a newline, and indent to the current indentation level.
  1512. Kills indentation on current line if the line is otherwise empty."
  1513.   (interactive)
  1514.   (ex-expand-abbrev)
  1515.   (let ((start (point)))
  1516.     (insert ?\n)
  1517.     (evi-maybe-indent)
  1518.     (save-excursion
  1519.       (goto-char start)
  1520.       (evi-maybe-kill-indentation))))
  1521.  
  1522. (defun evi-forward-indent ()
  1523.   "Move forward to the next indentation level, defined by shiftwidth."
  1524.   (interactive)
  1525.   ; eat all preceeding blanks, then fill with tabs, and pad with spaces
  1526.   ; to reach the target column
  1527.   (let* ((start-column (current-column))
  1528.      (target-column (+ start-column (- evi-shift-width
  1529.                        (% start-column evi-shift-width))))
  1530.      (backup-point (save-excursion
  1531.              (skip-chars-backward " ")
  1532.              (point))))
  1533.     (delete-backward-char (- (point) backup-point))
  1534.     (if indent-tabs-mode
  1535.     (while (< (setq start-column (current-column)) target-column)
  1536.       (insert ?\t)))
  1537.     (if (> start-column target-column) (delete-backward-char 1))
  1538.     (insert-char ?\ (- target-column (current-column)))))
  1539.  
  1540. (defun evi-backward-indent ()
  1541.   "Move backward to the previous indentation level, defined by shiftwidth."
  1542.   (interactive)
  1543.   (let* ((start-column (current-column))
  1544.      (offset (let ((toffset (% start-column evi-shift-width)))
  1545.            (if (= toffset 0) evi-shift-width toffset)))
  1546.      (furthest (save-excursion
  1547.              (skip-chars-backward " \t" (max 0 (- (point) offset)))
  1548.              (- start-column (current-column)))))
  1549.     (backward-delete-char-untabify (min offset furthest) nil)))
  1550.  
  1551. (defun evi-quoted-insert ()
  1552.   (interactive)
  1553.   (insert (evi-read-char)))
  1554.  
  1555. ;; Replace mode
  1556.  
  1557. (defun evi-replace ()
  1558.   "Enter replace mode."
  1559.   (interactive)
  1560.   (setq evi-mode 'replace)
  1561.   (evi-replace-mode (1- (point-max)))
  1562.   (if (not (bolp)) (backward-char))
  1563.   (if evi-replace-max
  1564.     (set-marker evi-replace-max nil))
  1565.   (evi-reset-goal-column)
  1566.   (evi-save-command-keys))
  1567.  
  1568. ;(define-key evi-replace-map "\C-d" 'evi-backward-indent)
  1569. ;(define-key evi-replace-map "\C-t" 'evi-forward-indent)
  1570. ;(define-key evi-replace-map "\C-w" 'evi-delete-backward-word)
  1571.  
  1572. (defvar evi-replaced-string nil)
  1573. (defvar evi-replaced-string-index nil)
  1574.  
  1575. (defun evi-replace-mode (max-replace-position)
  1576.   (or evi-replace-max
  1577.       (setq evi-replace-max (make-marker)))
  1578.   (set-marker evi-replace-max max-replace-position)
  1579.   (setq evi-insert-point (point)
  1580.     evi-replaced-string ""
  1581.     evi-replaced-string-index 0)
  1582.   (evi-change-mode-id "Replce")
  1583.   (evi-refresh-mode-line)
  1584.   (if (catch 'quit
  1585.     (if (catch 'switch-to-insert
  1586.           (evi-command-loop (list evi-input-map-map evi-replace-map))
  1587.           nil)
  1588.       (progn
  1589.         (set-marker evi-replace-max nil)
  1590.         (evi-insert-mode))
  1591.       (progn
  1592.         (evi-exit-replace-mode)
  1593.         (evi-exit-input-mode)))
  1594.     nil)
  1595.       (progn (evi-exit-replace-mode)
  1596.          (evi-exit-input-mode)
  1597.          (beep)
  1598.          (evi-error "Quit"))))
  1599.  
  1600. (defun evi-exit-replace-mode ()
  1601.   (if (< evi-replaced-string-index (length evi-replaced-string))
  1602.     (save-excursion
  1603.       (delete-region (point)
  1604.              (+ (point)
  1605.             (- (length evi-replaced-string)
  1606.                evi-replaced-string-index)))
  1607.       (insert (substring evi-replaced-string evi-replaced-string-index))))
  1608.   (if (eq evi-mode 'change)
  1609.     (evi-exit-change-mode))
  1610.   (setq evi-overstruck-char nil))
  1611.  
  1612. (defun evi-self-replace ()
  1613.   "Replace character under cursor with the command character."
  1614.   (interactive)
  1615.   (if (or (>= (point) evi-replace-max)
  1616.       (= (following-char) ?\n))
  1617.     (progn (setq evi-unread-command-char last-command-char)
  1618.        ; ZZ this is gross... should be rewritten properly, if possible
  1619.        (setq evi-command-keys loop-command-keys)
  1620.        (throw 'switch-to-insert t))
  1621.     (progn (if (= evi-replaced-string-index (length evi-replaced-string))
  1622.          (setq evi-replaced-string
  1623.            (concat evi-replaced-string
  1624.                (char-to-string (following-char)))))
  1625.        (setq evi-replaced-string-index (1+ evi-replaced-string-index))
  1626.        (let ((start (point)))
  1627.          (evi-replace-one-char last-command-char)
  1628.          ; if auto-indenting happened...
  1629.          (if (> (- (point) start) 1)
  1630.            (setq evi-insert-point (1+ start)
  1631.              evi-replaced-string
  1632.                (buffer-substring (1+ start) (point))
  1633.              evi-replaced-string-index
  1634.                (length evi-replaced-string)))))))
  1635.  
  1636. (defun evi-replace-one-char (char)
  1637.   (delete-region (point) (1+ (point)))
  1638.   (evi-version-case
  1639.     ("Emacs 18\.5[789]\\|Epoch 4\\|Emacs 19.*Lucid"
  1640.       (if (and evi-overstruck-char (= (point) evi-replace-max))
  1641.     (progn (aset (car (car buffer-undo-list))
  1642.              0 evi-overstruck-char)
  1643.            (setq evi-overstruck-char nil)))))
  1644.   ; ZZ unpleasantly hardcoded?
  1645.   (if (or (= char ?\n) (= char ?\r))
  1646.     (evi-newline)
  1647.     (insert char)))
  1648.  
  1649. (defun evi-replace-mode-delete-backward-char ()
  1650.   "Backup to previous character, undoing last replacement, but no further
  1651. than insert point."
  1652.   (interactive)
  1653.   (if (> (point) evi-insert-point)
  1654.     (progn (backward-char)
  1655.        (setq evi-replaced-string-index (1- evi-replaced-string-index)))
  1656.     (message "Beginning of replaced text")))
  1657.  
  1658. (defun evi-replace-char (char &optional count)
  1659.   "Replace the following COUNT characters with CHAR."
  1660.   (interactive (evi-character-arg))
  1661.   (if (catch 'abort
  1662.     (evi-motion-command 'do-evi-forward-char 'horizontal count 'to-end))
  1663.     (evi-error "Can't replace that many characters")
  1664.     (progn (evi-exchange-point-and-mark)
  1665.        (evi-iterate (or count 1)
  1666.          (evi-replace-one-char char))
  1667.        ; ZZ unpleasantly hard-coded?
  1668.        ; should be handled by a general purpose post-auto-indent func
  1669.        (if (or (= char ?\n) (= char ?\r))
  1670.          (evi-maybe-kill-indentation))
  1671.        (if (not (bolp)) (backward-char))))
  1672.   (evi-reset-goal-column)
  1673.   (evi-save-command-keys))
  1674.  
  1675. (defun evi-toggle-case (&optional count)
  1676.   "Toggle the case of the following COUNT characters."
  1677.   (interactive (evi-count-arg))
  1678.   (evi-motion-command 'do-evi-forward-char 'horizontal count 'to-end)
  1679.   (save-excursion
  1680.     (evi-iterate (- (point) evi-mark)
  1681.       (backward-char)
  1682.       (let ((char (following-char)))
  1683.     (cond ((and (>= char ?a) (<= char ?z))
  1684.         (upcase-region (point) (1+ (point))))
  1685.           ((and (>= char ?A) (<= char ?Z))
  1686.         (downcase-region (point) (1+ (point))))))))
  1687.   (evi-fixup-cursor 'horizontal)
  1688.   (evi-reset-goal-column)
  1689.   (evi-save-command-keys))
  1690.  
  1691. ;; Modification operators
  1692.  
  1693. (defun evi-change (&optional count)
  1694.   "Change operator."
  1695.   (interactive (evi-count-arg))
  1696.   (evi-operator-command (or count 1) 'to-end '(evi-change-internal) 1))
  1697.  
  1698. (defun evi-change-internal ()
  1699.   ; If the region is contained on one line, throw a `$' out to mark the
  1700.   ; end of the region, then enter replace mode and delete any un-replaced
  1701.   ; text when that is exited, with the replace-max set at the end of the
  1702.   ; region so that it will switch to insert mode if necessary.  Otherwise,
  1703.   ; delete the region first, and enter insert mode.
  1704.   (evi-copy-region-to-registers t)
  1705.   ; this makes the undo leave the point at the start of the undone text
  1706.   (evi-exchange-point-and-mark)
  1707.   (if (or (save-excursion (end-of-line) (> evi-mark (point)))
  1708.       (= (point) evi-mark))
  1709.       (progn (delete-region (point) evi-mark)
  1710.          (setq evi-insert-point (point))
  1711.          (evi-insert-mode))
  1712.     (progn (setq evi-overstruck-char (char-after (1- evi-mark)))
  1713.        (let ((here (point)))
  1714.          (goto-char evi-mark)
  1715.          (delete-region (1- evi-mark) evi-mark)
  1716.          (insert ?$)
  1717.          (evi-version-case
  1718.            ("Emacs 18\.5[789]\\|Epoch 4\\|Emacs 19.*Lucid"
  1719.          ;; this is a bit of song and dance to get the cursor to
  1720.          ;; end up in the right place after an undo.  the problem
  1721.          ;; is these two previous statements, which are the first
  1722.          ;; things changed, and thus where the cursor will be left
  1723.          ;; after an undo.  first step: erase the fact that we put
  1724.          ;; the dollar sign there in the first place.
  1725.          (setq buffer-undo-list (cdr (cdr buffer-undo-list)))))
  1726.          (goto-char here))
  1727.        (setq evi-mode 'change)
  1728.        (evi-replace-mode evi-mark)))
  1729.   (if (not (bolp)) (backward-char)))
  1730.  
  1731. (defun evi-exit-change-mode ()
  1732.   (if (and (marker-position evi-replace-max)
  1733.        (< (point) evi-replace-max))
  1734.     (let ((overstrike-offset (1- (- evi-replace-max (point)))))
  1735.       (delete-region (point) (marker-position evi-replace-max))
  1736.       (set-marker evi-replace-max nil)
  1737.       (evi-version-case
  1738.     ("Emacs 18\.5[789]\\|Epoch 4\\|Emacs 19.*Lucid"
  1739.       ;; second step: rewrite the undo record with the
  1740.       ;; original overstruck character
  1741.       (aset (car (car buffer-undo-list))
  1742.         overstrike-offset evi-overstruck-char))))))
  1743.  
  1744. (defun evi-delete (&optional count)
  1745.   "Delete operator."
  1746.   (interactive (evi-count-arg))
  1747.   (evi-operator-command (or count 1) 'to-next '(evi-delete-internal)))
  1748.  
  1749. (defun evi-delete-internal ()
  1750.   (evi-copy-region-to-registers t)
  1751.   (if evi-number
  1752.       (evi-update-number evi-mark))
  1753.   ; this makes the undo leave the point at the start of the undone text
  1754.   (evi-exchange-point-and-mark)
  1755.   (if (= (point) evi-mark)
  1756.     (message "Nothing deleted")
  1757.     (if (eq evi-region-shape 'rectangle)
  1758.     (delete-rectangle (point) (1+ evi-mark))
  1759.       (delete-region (point) evi-mark)))
  1760.   (evi-fixup-cursor (if (eq evi-region-shape 'chars) 'horizontal 'vertical)))
  1761.  
  1762. (defun evi-yank (&optional count)
  1763.   "Yank operator."
  1764.   (interactive (evi-count-arg))
  1765.   (save-excursion
  1766.     (evi-operator-command (or count 1) 'to-next '(evi-yank-internal))))
  1767.  
  1768. (defun evi-yank-internal ()
  1769.   (evi-copy-region-to-registers nil)
  1770.   (if (= evi-mark (point))
  1771.     (message "Nothing to yank")))
  1772.  
  1773. (defun evi-put-after (&optional register-number register-append count)
  1774.   "Put back yanked or deleted text after cursor."
  1775.   (interactive (evi-register-args))
  1776.   (let ((register
  1777.       (aref evi-registers (or register-number evi-register-unnamed))))
  1778.     (if register
  1779.     (if (eq (evi-register-shape register) 'lines)
  1780.         (progn (end-of-line)
  1781.            (if (not (eobp)) (forward-char))
  1782.            (save-excursion
  1783.              (evi-iterate (or count 1)
  1784.                (insert (evi-register-text register)))))
  1785.       (if (not (and (bolp) (eolp)))
  1786.           (forward-char))
  1787.       (evi-iterate (or count 1)
  1788.         (if (eq (evi-register-shape register) 'chars)
  1789.         (insert (evi-register-text register))
  1790.           (insert-rectangle (evi-register-text register))))
  1791.       (backward-char))
  1792.       (if register-number
  1793.       (message "Nothing in register %c"
  1794.            (evi-register-name register-number))
  1795.     (message "No text to put"))))
  1796.   (evi-reset-goal-column)
  1797.   (evi-save-command-keys))
  1798.  
  1799. (defun evi-put (&optional register-number register-append count)
  1800.   "Put back yanked or deleted text."
  1801.   (interactive (evi-register-args))
  1802.   (let ((register
  1803.       (aref evi-registers (or register-number evi-register-unnamed))))
  1804.     (if register
  1805.     (if (eq (evi-register-shape register) 'lines)
  1806.         (progn (beginning-of-line)
  1807.            (save-excursion
  1808.              (evi-iterate (or count 1)
  1809.                (insert (evi-register-text register)))))
  1810.       (evi-iterate (or count 1)
  1811.         (if (eq (evi-register-shape register) 'chars)
  1812.         (insert (evi-register-text register))
  1813.           (insert-rectangle (evi-register-text register))))
  1814.       (backward-char))
  1815.       (if register-number
  1816.       (message "Nothing in register %c"
  1817.            (evi-register-name register-number))
  1818.     (message "No text to put"))))
  1819.   (evi-reset-goal-column)
  1820.   (evi-save-command-keys))
  1821.  
  1822. (defun evi-shift-right (&optional count)
  1823.   "Shift right operator."
  1824.   (interactive (evi-count-arg))
  1825.   (evi-operator-command (or count 1) 'whole-lines '(evi-shift-internal 1)))
  1826.  
  1827. (defun evi-shift-left (&optional count)
  1828.   "Shift left operator."
  1829.   (interactive (evi-count-arg))
  1830.   (evi-operator-command (or count 1) 'whole-lines '(evi-shift-internal -1)))
  1831.  
  1832. (defun evi-shift-internal (direction)
  1833.   (if (= evi-mark (point))
  1834.     (message "Nothing shifted")
  1835.     (indent-rigidly evi-mark (point) (* evi-shift-width direction)))
  1836.   (goto-char evi-mark)
  1837.   (skip-chars-forward " \t"))
  1838.  
  1839. (defun evi-indent (&optional count)
  1840.   "Indent region."
  1841.   (interactive (evi-count-arg))
  1842.   (evi-operator-command (or count 1) 'whole-lines '(evi-indent-internal)))
  1843.  
  1844. (defun evi-indent-internal ()
  1845.   (if (= evi-mark (point))
  1846.     (message "Nothing indented")
  1847.     (indent-region evi-mark (point) nil))
  1848.   (goto-char evi-mark)
  1849.   (skip-chars-forward " \t"))
  1850.  
  1851. (defun evi-shell-filter (&optional count)
  1852.   "Filter region thru shell command."
  1853.   (interactive (evi-count-arg))
  1854.   (save-excursion
  1855.     (evi-operator-command (or count 1) 'whole-lines
  1856.               '(evi-filter-internal input-string) t)))
  1857.  
  1858. (defun evi-filter-internal (shell-command)
  1859.   (if (string= shell-command "!")
  1860.       (setq shell-command
  1861.     (or evi-last-shell-command
  1862.         (evi-error "No previous shell command to substitute for !")))
  1863.     (setq evi-last-shell-command shell-command))
  1864.   (shell-command-on-region evi-mark (point) shell-command t))
  1865.  
  1866. (defun evi-send-to-process (&optional count)
  1867.   "Send region to emacs process buffer."
  1868.   (interactive (evi-count-arg))
  1869.   (save-excursion
  1870.     (evi-operator-command (or count 1) 'to-next
  1871.               '(evi-to-process-internal)))
  1872.   (switch-to-buffer-other-window evi-process-buffer)
  1873.   (goto-char (process-mark (get-buffer-process evi-process-buffer)))
  1874.   (evi-insert))
  1875.  
  1876. (defun evi-to-process-internal ()
  1877.   (send-region
  1878.     (setq evi-process-buffer (read-buffer "* : " evi-process-buffer t))
  1879.     evi-mark (point)))
  1880.  
  1881. (defun evi-loop-over-lines-in-region (&optional count)
  1882.   "Execute a sequence of operations on every line in a region."
  1883.   (interactive (evi-count-arg))
  1884.   (evi-operator-command (or count 1) 'whole-lines
  1885.             '(evi-loop-lines-internal input-string) t))
  1886.  
  1887. (defun evi-loop-lines-internal (macro)
  1888.   (let ((evi-last-command-keys nil)
  1889.     (ending-mark (set-marker (make-marker) (point-marker)))
  1890.     (evi-prefix-count nil))
  1891.     (goto-char evi-mark)
  1892.     (beginning-of-line)
  1893.     (while (< (point) (marker-position ending-mark))
  1894.       (evi-execute-macro macro)
  1895.       (end-of-line)
  1896.       (forward-char))
  1897.     (set-marker ending-mark nil))
  1898.   (evi-fixup-cursor 'vertical))
  1899.  
  1900. (defun evi-operator-command (count context operation &optional more-input)
  1901.   (let ((evi-context context)
  1902.     (evi-prefix-count-multiplier count)
  1903.     (evi-default-keymap-list
  1904.       (list (evi-make-local-keymap
  1905.           '(((char-to-string last-command-char) evi-whole-lines)))
  1906.         evi-map-map evi-motion-map)))
  1907.     (evi-get-command))
  1908.   (let ((input-string (if (eq more-input t)
  1909.             (evi-read-string (concat evi-command-keys " : ")))))
  1910.     (eval operation))
  1911.   (evi-reset-goal-column)
  1912.   (evi-save-command-keys))
  1913.  
  1914. (defun evi-join-lines (&optional count)
  1915.   "Join together COUNT + 1 lines, supplying appropriate whitespace."
  1916.   (interactive (evi-count-arg))
  1917.   (let ((starting-point (point))
  1918.     (ending-point nil))
  1919.     (evi-iterate (max (1- (or count 2)) 1)
  1920.       (end-of-line)
  1921.       (if (evi-eobp)
  1922.       (progn (or ending-point
  1923.              (setq ending-point starting-point))
  1924.          (evi-break))
  1925.     (forward-char)
  1926.     (delete-region (1- (point))
  1927.                (progn (skip-chars-forward " \t") (point)))
  1928.     (or ending-point
  1929.         (setq ending-point (point)))
  1930.     (if (and (/= (preceding-char) ? )
  1931.          (/= (preceding-char) ?\t)
  1932.          (/= (following-char) ?\)))
  1933.         (insert-char ?  (if (= (preceding-char) ?.) 2 1)))))
  1934.     (goto-char ending-point))
  1935.   (evi-reset-goal-column)
  1936.   (evi-save-command-keys))
  1937.  
  1938. ;; Motion command
  1939.  
  1940. (defun evi-exchange-point-and-mark ()
  1941.   (let ((temp evi-mark))
  1942.     (setq evi-mark (point))
  1943.     (goto-char temp)))
  1944.  
  1945. (defun evi-expand-region-to-lines (context)
  1946.   (evi-exchange-point-and-mark)
  1947.   (beginning-of-line)
  1948.   (evi-exchange-point-and-mark)
  1949.   (end-of-line)
  1950.   (if (not (or (eobp) (eq context 'to-end))) (forward-char))
  1951.   (setq evi-region-shape 'lines))
  1952.  
  1953. ; 'normalizing' a horizontal region means expanding the region to whole lines
  1954. ; when 1) the beginning of the region is on the first non-white character
  1955. ; of a line, and 2) the ending of the region is on the end of the line
  1956.  
  1957. (defun evi-normalize-region ()
  1958.   (and (eolp)
  1959.        (save-excursion
  1960.      (beginning-of-line)
  1961.      (and (> (point) evi-mark)
  1962.           (progn (goto-char evi-mark)
  1963.              (skip-chars-backward " \t")
  1964.              (bolp))))
  1965.        (progn (evi-exchange-point-and-mark)
  1966.           (beginning-of-line)
  1967.           (evi-exchange-point-and-mark)
  1968.           (if (not (eobp))
  1969.         (forward-char))
  1970.           (setq evi-region-shape 'lines))))
  1971.  
  1972. (defun evi-fixup-cursor (direction)
  1973.   (or evi-internal-command
  1974.     (if (eq direction 'horizontal)
  1975.       (progn (if (and (eobp) (not (bobp)))
  1976.            (backward-char))
  1977.          (if (and (eolp) (not (bolp)))
  1978.            (backward-char)))
  1979.       (if (and (eobp) (not (bobp)))
  1980.     (progn (backward-char) (beginning-of-line))
  1981.     (if (and (eolp) (not (bolp))) (backward-char))))))
  1982.  
  1983. (defun evi-motion-command (move-function direction count context &optional arg)
  1984.   (if context
  1985.       (setq evi-mark (point))
  1986.     ; else, maintain the goal column.  kinda gross this being here, but...
  1987.     (if (or (eq move-function 'do-evi-next-line)
  1988.         (eq move-function 'do-evi-previous-line))
  1989.     (evi-set-goal-column)
  1990.       (evi-reset-goal-column)))
  1991.   (if arg
  1992.       (funcall move-function arg count context)
  1993.     (funcall move-function count context))
  1994.   (if context
  1995.       (progn
  1996.     (if (< (point) evi-mark) (evi-exchange-point-and-mark))
  1997.     (if (or (eq direction 'vertical) (eq context 'whole-lines))
  1998.         (evi-expand-region-to-lines context)
  1999.       (progn (setq evi-region-shape 'chars)
  2000.          (if (eq context 'to-next)
  2001.              (evi-normalize-region)))))
  2002.     ; fixup the location of the cursor, if necessary
  2003.     (evi-fixup-cursor direction)))
  2004.  
  2005. ;; Simple motion commands
  2006.  
  2007. (evi-defmotion horizontal evi-forward-char (&optional count context)
  2008.   "Move right COUNT characters on the current line."
  2009.   (forward-char (let ((here (point)))
  2010.           (end-of-line)
  2011.           (prog1 (min (or count 1) (- (point) here))
  2012.               (goto-char here))))
  2013.   (and (eolp) (not context) (not evi-internal-command)
  2014.        (evi-error "End of line")))
  2015.  
  2016. (evi-defmotion horizontal evi-backward-char (&optional count context)
  2017.   "Move left COUNT characters on the current line."
  2018.   (backward-char (let ((here (point)))
  2019.            (beginning-of-line)
  2020.            (prog1 (min (1- (or count 1)) (- here (point)))
  2021.                (goto-char here))))
  2022.   (if (bolp) (evi-error "Beginning of line") (backward-char)))
  2023.  
  2024. (evi-defmotion vertical evi-next-line (&optional count context)
  2025.   "Go to ARGth next line."
  2026.   (evi-next-line-internal (or count 1))
  2027.   (if (null context)
  2028.     (progn (evi-adjust-scroll-up)
  2029.        (move-to-column evi-goal-column))))
  2030.  
  2031. (evi-defmotion vertical evi-beginning-of-next-line (&optional count context)
  2032.   "Go to beginning of ARGth next line."
  2033.   (evi-next-line-internal (or count 1))
  2034.   (if (null context) (evi-adjust-scroll-up))
  2035.   (skip-chars-forward " \t"))
  2036.  
  2037. ;; ZZ maybe can use goal column in fixup-cursor to remove some of this here??
  2038. (defun evi-next-line-internal (count)
  2039.   (let* ((starting-point (point))
  2040.      (offset (forward-line count)))
  2041.     (if (or (/= offset 0) (eobp))
  2042.       (progn (goto-char starting-point)
  2043.          (evi-error
  2044.             (if (= count 1) "Last line in buffer"
  2045.                     "Not that many lines left in buffer"))))))
  2046.  
  2047. (defun evi-adjust-scroll-up ()
  2048.   (let ((window-line (count-lines (window-start) (1+ (point))))
  2049.     (window-height (1- (window-height))))
  2050.     (and (> window-line window-height)
  2051.      (< window-line (+ window-height (/ window-height 3)))
  2052.      (recenter (1- window-height)))))
  2053.  
  2054. (evi-defmotion vertical evi-previous-line (&optional count context)
  2055.   "Go to ARGth previous line."
  2056.   (evi-previous-line-internal (or count 1))
  2057.   (if (null context)
  2058.     (progn (evi-adjust-scroll-down)
  2059.        (move-to-column evi-goal-column))))
  2060.  
  2061. (evi-defmotion vertical evi-beginning-of-previous-line (&optional count context)
  2062.   "Go to beginning of ARGth previous line."
  2063.   (evi-previous-line-internal (or count 1))
  2064.   (if (null context) (evi-adjust-scroll-down))
  2065.   (back-to-indentation))
  2066.  
  2067. (defun evi-previous-line-internal (count)
  2068.   (let* ((starting-point (point))
  2069.      (offset (forward-line (- count))))
  2070.     (if (/= offset 0)
  2071.       (progn (goto-char starting-point)
  2072.          (evi-error
  2073.             (if (= count 1) "First line in buffer"
  2074.                     "Not that many lines left in buffer"))))))
  2075.  
  2076. (defun evi-adjust-scroll-down ()
  2077.   (if (< (point) (window-start))
  2078.     (let ((window-line (count-lines (1+ (point)) (window-start)))
  2079.       (window-height (1- (window-height))))
  2080.       (and (< window-line (/ window-height 3))
  2081.        (recenter 0)))))
  2082.  
  2083. (evi-defmotion vertical evi-goto-line (&optional count context)
  2084.   "Go to line number LINE, or to end of file if no count specified."
  2085.   ; ZZ once again... if we know the move won't be far (like on same screen)
  2086.   ; perhaps shouldn't push context...
  2087.   (evi-push-context)
  2088.   (ex-goto-line count))
  2089.  
  2090. (evi-defmotion vertical evi-goto-top-of-window (&optional offset context)
  2091.   "Go to the top line of the window.  With an arg, OFFSET, goes to the
  2092. OFFSET'th line of the window."
  2093.   (move-to-window-line (1- (or offset 1)))
  2094.   (or context
  2095.       (skip-chars-forward " \t")))
  2096.  
  2097. (evi-defmotion vertical evi-goto-middle-of-window (&optional offset context)
  2098.   "Go to the middle line of the window."
  2099.   (move-to-window-line (/ (window-height) 2))
  2100.   (or context
  2101.       (skip-chars-forward " \t")))
  2102.  
  2103. (evi-defmotion vertical evi-goto-bottom-of-window (&optional offset context)
  2104.   "Go to the bottom line of the window.  With an arg, OFFSET, goes to the
  2105. OFFSET'th line from the bottom of the window."
  2106.   (move-to-window-line (- (1- (window-height)) (or offset 1)))
  2107.   (or context
  2108.       (skip-chars-forward " \t")))
  2109.  
  2110. (evi-defmotion horizontal evi-goto-column (&optional column context)
  2111.   "Go to column COLUMN, or as close to that column as possible."
  2112.   (move-to-column (1- (or column 1))))
  2113.  
  2114. (evi-defmotion vertical evi-whole-lines (&optional count context)
  2115.   "Go ARG - 1 lines forward."
  2116.   (evi-next-line-internal (1- (or count 1))))
  2117.  
  2118. (evi-defmotion horizontal evi-beginning-of-line (&optional count context)
  2119.   "Go to beginning of line."
  2120.   (beginning-of-line))
  2121.  
  2122. ; it's not at all clear why this doesn't take a count...
  2123. ; maybe it should...
  2124. (evi-defmotion horizontal evi-goto-indentation (&optional count context)
  2125.   "Go to beginning of indented text on current line."
  2126.   (beginning-of-line)
  2127.   (back-to-indentation))
  2128.  
  2129. (evi-defmotion horizontal evi-end-of-line (&optional count context)
  2130.   "Go to end of line."
  2131.   (evi-next-line-internal (1- (or count 1)))
  2132.   (end-of-line))
  2133.  
  2134. ;; Word, sentence, paragraph and section motion commands
  2135.  
  2136. (defun evi-eobp ()
  2137.   (< (- (point-max) (point)) 3))
  2138.  
  2139. (evi-defmotion horizontal evi-forward-word (&optional count context)
  2140.   "Move to the beginning of the COUNTth next word."
  2141.   (evi-forward-word-internal evi-word (or count 1) context))
  2142.  
  2143. (evi-defmotion horizontal evi-forward-Word (&optional count context)
  2144.   "Move to the beginning of the COUNTth next white-space delimited word."
  2145.   (evi-forward-word-internal evi-Word (or count 1) context))
  2146.  
  2147. (defun evi-forward-word-internal (pattern count context)
  2148.   (and (not context) (evi-eobp)
  2149.        (evi-error "End of buffer"))
  2150.   (if context
  2151.     (setq count (1- count)))
  2152.   (if (looking-at pattern)
  2153.     (setq count (1+ count)))
  2154.   (if (and (re-search-forward pattern nil 'limit count)
  2155.        (or (not (eq context 'to-next))
  2156.            (re-search-forward pattern
  2157.          (save-excursion (end-of-line) (point)) 'limit)))
  2158.     (if (eq context 'to-end)
  2159.       (if (or (> count 0) (looking-at pattern))
  2160.     (goto-char (match-end 0))
  2161.     (forward-char))
  2162.       (goto-char (match-beginning 0)))
  2163.     (if (eobp)
  2164.       (backward-char))))
  2165.  
  2166. (evi-defmotion horizontal evi-end-of-word (&optional count context)
  2167.   "Move to the end of the COUNTth next word."
  2168.   (evi-end-of-word-internal evi-word (or count 1) context))
  2169.  
  2170. (evi-defmotion horizontal evi-end-of-Word (&optional count context)
  2171.   "Move to the end of the COUNTth next whitespace delimited word."
  2172.   (evi-end-of-word-internal evi-Word (or count 1) context))
  2173.  
  2174. (defun evi-end-of-word-internal (pattern count context)
  2175.   (and (not context) (evi-eobp)
  2176.        (evi-error "End of buffer"))
  2177.   (or context
  2178.       (forward-char))
  2179.   (if (re-search-forward pattern nil 'limit count)
  2180.     (goto-char (- (match-end 0) (if context 0 1)))
  2181.     (if (eobp)
  2182.       (backward-char))))
  2183.  
  2184. (evi-defmotion horizontal evi-backward-word (&optional count context)
  2185.   "Move to the beginning of the COUNTth previous word."
  2186.   (evi-backward-word-internal evi-word (or count 1) context))
  2187.  
  2188. (evi-defmotion horizontal evi-backward-Word (&optional count context)
  2189.   "Move to the beginning of the COUNTth previous whitespace delimited word."
  2190.   (evi-backward-word-internal evi-Word (or count 1) context))
  2191.  
  2192. (defun evi-backward-word-internal (pattern count context)
  2193.   (if (bobp)
  2194.     (evi-error "Beginning of buffer"))
  2195.   (evi-iterate count
  2196.     (if (re-search-backward pattern nil 'limit)
  2197.       (progn
  2198.     (looking-at pattern)
  2199.     (let ((end (match-end 0))
  2200.           (at-beginning nil))
  2201.       (while (and (looking-at pattern) (= (match-end 0) end)
  2202.               (not (setq at-beginning (bobp))))
  2203.         (backward-char))
  2204.       (if (not at-beginning)
  2205.         (forward-char))))
  2206.       (evi-break))))
  2207.  
  2208. (defconst evi-sentence-beginning "\\([.?!][]\"')]*\\([\t\n]\\| [ \t\n]\\)\\|^[ \t]*\n\\|\\`\\)[ \t\n]*[^ \t\n]")
  2209.  
  2210. (defconst evi-sentence-ending "\\([.?!][]\"')]*\\([\t\n]\\| [ \t\n]\\)\\|^[ \t]*$\\)")
  2211.  
  2212. (defconst evi-paragraph-beginning "\\(^[ \t]*\n\\|\\`\\)[ \t\n]*[^ \t\n]")
  2213.  
  2214. (defconst evi-paragraph-ending "^[ \t]*$")
  2215.  
  2216. (defconst evi-section-beginning "^\\({\\|\\.\\(NH\\|SH\\|H\\|HU\\|nh\\|sh\\)[ \t\n]\\)")
  2217.  
  2218. (defconst evi-section-ending "[ \t\n]*\n\\(}\\|\\.\\(NH\\|SH\\|H\\|HU\\|nh\\|sh\\)[ \t\n]\\)")
  2219.  
  2220. (defun evi-not-at (pattern &optional limit)
  2221.   (let ((start (point)))
  2222.     (if (re-search-backward pattern limit 'limit)
  2223.       (prog1
  2224.     (/= (match-end 0) start)
  2225.     (goto-char start))
  2226.       t)))
  2227.  
  2228. (evi-defmotion horizontal evi-forward-sentence (&optional count context)
  2229.   "Move to the beginning of the COUNT'th next sentence."
  2230.   (and (not context) (evi-eobp)
  2231.        (evi-error "End of buffer"))
  2232.   (forward-char)
  2233.   (and (eq context 'to-next) (evi-not-at evi-sentence-beginning)
  2234.        (setq context 'to-end))
  2235.   (if (re-search-forward evi-sentence-beginning nil 'limit
  2236.              (- (or count 1) (if context 1 0)))
  2237.     (if context
  2238.       (if (eq context 'to-end)
  2239.     (if (re-search-forward evi-sentence-ending nil 'limit)
  2240.       (skip-chars-backward " \t\n"))
  2241.     (if (re-search-forward evi-sentence-beginning
  2242.           (save-excursion
  2243.         (re-search-forward evi-paragraph-ending nil 'limit)
  2244.         (1- (match-beginning 0)))
  2245.           'limit)
  2246.       (backward-char)))
  2247.       (backward-char))))
  2248.  
  2249. (evi-defmotion horizontal evi-backward-sentence (&optional count context)
  2250.   "Move to the beginning of the COUNT'th previous sentence."
  2251.   (if (bobp)
  2252.     (evi-error "Beginning of buffer"))
  2253.   (skip-chars-backward " \t\n")
  2254.   (if (re-search-backward evi-sentence-beginning nil 'limit (or count 1))
  2255.     (goto-char (1- (match-end 0)))))
  2256.  
  2257. (evi-defmotion horizontal evi-forward-paragraph (&optional count context)
  2258.   "Move to the beginning of the COUNT'th next paragraph."
  2259.   (and (not context) (evi-eobp)
  2260.        (evi-error "End of buffer"))
  2261.   (forward-char)
  2262.   (and (eq context 'to-next) (evi-not-at evi-paragraph-beginning)
  2263.        (setq context 'to-end))
  2264.   (if (re-search-forward evi-paragraph-beginning nil 'limit
  2265.              (- (or count 1) (if (eq context 'to-end) 1 0)))
  2266.     (if (eq context 'to-end)
  2267.     (if (re-search-forward evi-paragraph-ending nil 'limit)
  2268.       (goto-char (1- (match-beginning 0))))
  2269.       (if context
  2270.     (beginning-of-line))
  2271.       (backward-char))))
  2272.  
  2273. (evi-defmotion horizontal evi-backward-paragraph (&optional count context)
  2274.   "Move to the beginning of the COUNT'th previous paragraph."
  2275.   (if (bobp)
  2276.     (evi-error "Beginning of buffer"))
  2277.   (if (re-search-backward evi-paragraph-beginning nil 'limit (or count 1))
  2278.     (goto-char (1- (match-end 0)))))
  2279.  
  2280. (evi-defmotion horizontal evi-forward-section (&optional count context)
  2281.   "Move to the beginning of the COUNT'th next section."
  2282.   (and (not context) (evi-eobp)
  2283.        (evi-error "End of buffer"))
  2284.   (or context
  2285.       (evi-push-context (point)))
  2286.   (let ((start (point)))
  2287.     (skip-chars-forward "^ \t\n")
  2288.     (or (eobp)
  2289.     (forward-char))
  2290.     (and (eq context 'to-next) (evi-not-at evi-section-beginning start)
  2291.      (setq context 'to-end)))
  2292.   (if (re-search-forward evi-section-beginning nil 'limit
  2293.              (- (or count 1) (if (eq context 'to-end) 1 0)))
  2294.     (if (eq context 'to-end)
  2295.     (if (re-search-forward evi-section-ending nil 'limit)
  2296.       (or (eq (preceding-char) ?})
  2297.           (goto-char (match-beginning 0))))
  2298.       (goto-char (match-beginning 0))
  2299.       (if context
  2300.     (backward-char)))))
  2301.  
  2302. (evi-defmotion horizontal evi-backward-section (&optional count context)
  2303.   "Move to the beginning of the COUNT'th previous section."
  2304.   (if (bobp)
  2305.     (evi-error "Beginning of buffer"))
  2306.   (or context
  2307.       (evi-push-context (point)))
  2308.   (re-search-backward evi-section-beginning nil 'limit (or count 1)))
  2309.  
  2310. (defun evi-region-arbitrary ()
  2311.   "Define region bounded by mark and point (containing point)."
  2312.   (interactive)
  2313.   (if (< (point) evi-mark) (evi-exchange-point-and-mark))
  2314.   (forward-char)
  2315.   (setq evi-region-shape 'chars))
  2316.  
  2317. (defun evi-region-rectangle ()
  2318.   "Define region as rectangle bounded by mark and point (containing point)."
  2319.   (interactive)
  2320.   (if (< (point) evi-mark) (evi-exchange-point-and-mark))
  2321.   (setq evi-region-shape 'rectangle))
  2322.  
  2323. (defun evi-region-rows (context)
  2324.   "Define region as rows bounded by mark and point (containing point)."
  2325.   (interactive (evi-context-arg))
  2326.   (if (< (point) evi-mark) (evi-exchange-point-and-mark))
  2327.   (evi-expand-region-to-lines evi-context))
  2328.  
  2329. ;ZZ - very naive
  2330. (defun evi-region-columns ()
  2331.   "Define region as columns bounded by mark and point (containing point)."
  2332.   (interactive)
  2333.   (if (< (point) evi-mark) (evi-exchange-point-and-mark))
  2334.   (let ((start-col (save-excursion (goto-char evi-mark) (current-column)))
  2335.     (end-col (current-column)))
  2336.     (setq evi-mark start-col)
  2337.     (goto-char (point-max))
  2338.     (if (eolp)
  2339.     (backward-char))
  2340.     (beginning-of-line)
  2341.     (goto-char (+ (point) end-col)))
  2342.   (setq evi-region-shape 'rectangle))
  2343.  
  2344. ;; Searching
  2345.  
  2346. (evi-defmotion horizontal evi-search-forward
  2347.   (&string "/" string &optional count context)
  2348.   "Search forward for the ARGth occurence of a pattern.  A null string will
  2349. repeat the previous search."
  2350.   (evi-do-vi-search t string (or count 1)))
  2351.  
  2352. (evi-defmotion horizontal evi-search-backward
  2353.   (&string "?" string &optional count context)
  2354.   "Search backward for the ARGth occurence of a pattern.  A null string will
  2355. repeat the previous search."
  2356.   (evi-do-vi-search nil string (or count 1)))
  2357.  
  2358. (defun evi-do-vi-search (search-forward search-spec count)
  2359.   (let ((ex-user-buffer (current-buffer)))
  2360.     (set-buffer ex-work-space)
  2361.     (erase-buffer)
  2362.     (insert (if search-forward ?/ ??) search-spec "\n")
  2363.     (goto-char (point-min))
  2364.     (let ((string (ex-scan-regular-expression))
  2365.       (offset (ex-scan-line-offset)))
  2366.       (set-buffer ex-user-buffer)
  2367.       (or (string= string "")
  2368.       (setq evi-search-pattern string))
  2369.       (if evi-search-pattern
  2370.       (evi-do-search (setq evi-search-forward search-forward)
  2371.              evi-search-pattern count)
  2372.     (evi-error "No previous search pattern"))
  2373.       (if (> offset 0)
  2374.       (evi-next-line-internal offset)
  2375.     (if (< offset 0)
  2376.         (evi-previous-line-internal (- offset)))))))
  2377.  
  2378. (evi-defmotion horizontal evi-search-next (&optional count context)
  2379.   "Search for the next ARGth occurence of the previous search pattern."
  2380.   (if evi-search-pattern
  2381.     (evi-do-search evi-search-forward evi-search-pattern (or count 1))
  2382.     (evi-error "No previous search pattern")))
  2383.  
  2384. (evi-defmotion horizontal evi-search-next-reverse (&optional count context)
  2385.   "Search for the next ARGth occurence of the previous search pattern
  2386. but look in the opposite direction."
  2387.   (let ((evi-search-forward (not evi-search-forward)))
  2388.     (do-evi-search-next count context)))
  2389.  
  2390. (defun evi-do-search (search-forward search-string count)
  2391.   (let ((case-fold-search evi-ignore-case)
  2392.     (starting-point (point)))
  2393.     (if (if search-forward
  2394.       (evi-search-forward-count search-string count)
  2395.       (evi-search-backward-count search-string count))
  2396.       (progn
  2397.     ; ZZ if we know the search didn't take us far, perhaps we shouldn't
  2398.     ; push a context...
  2399.     (evi-push-context starting-point)
  2400.         (goto-char (match-beginning 0)))
  2401.       (progn
  2402.     (goto-char starting-point)
  2403.     (evi-error
  2404.       (concat
  2405.         (if (> count 1) "Nth occurrence not found" "Pattern not found")
  2406.         (if evi-search-wraparound ""
  2407.           (if search-forward
  2408.           " before end of file"
  2409.           " before beginning of file"))))))))
  2410.  
  2411. ; ZZ use evi-iterate
  2412. (defun evi-search-forward-count (string count)
  2413.   (if (> count 0)
  2414.     (progn (forward-char)
  2415.        (if (re-search-forward string nil t)
  2416.          (evi-search-forward-count string (1- count))
  2417.          (if evi-search-wraparound
  2418.            (progn (goto-char (point-min))
  2419.               (if (re-search-forward string nil t)
  2420.             (evi-search-forward-count string (1- count)))))))
  2421.     t))
  2422.  
  2423. (defun evi-search-backward-count (string count)
  2424.   (if (> count 0)
  2425.     (if (re-search-backward string nil t)
  2426.       (evi-search-backward-count string (1- count))
  2427.       (if evi-search-wraparound
  2428.     (progn (goto-char (point-max))
  2429.            (if (re-search-backward string nil t)
  2430.          (evi-search-backward-count string (1- count))))))
  2431.     t))
  2432.  
  2433. (evi-defmotion horizontal evi-find-character (&char char &optional count context)
  2434.   "Search for CHAR on the current line.  With COUNT find the COUNT'th occurance."
  2435.   (setq evi-find-character char
  2436.     evi-find-forward t
  2437.     evi-find-up-to nil)
  2438.   (evi-find-character-internal (or count 1) context))
  2439.  
  2440. (evi-defmotion horizontal evi-find-char-backwards
  2441.   (&char char &optional count context)
  2442.   "Search backwards for CHAR on the current line.  With COUNT find the
  2443. COUNT'th occurance."
  2444.   (setq evi-find-character char
  2445.     evi-find-forward nil
  2446.     evi-find-up-to nil)
  2447.   (evi-find-character-backwards-internal (or count 1) context))
  2448.  
  2449. (evi-defmotion horizontal evi-find-character-before
  2450.   (&char char &optional count context)
  2451.   "Search for CHAR on the current line and leave the cursor on the character
  2452. before it.  With COUNT find the COUNT'th occurance."
  2453.   (setq evi-find-character char
  2454.     evi-find-forward t
  2455.     evi-find-up-to t)
  2456.   (evi-find-character-internal (or count 1) context))
  2457.  
  2458. (evi-defmotion horizontal evi-find-char-backwards-after
  2459.   (&char char &optional count context)
  2460.   "Search backwards for CHAR on the current line and leave the cursor on
  2461. the character after it.  With COUNT find the COUNT'th occurance."
  2462.   (setq evi-find-character char
  2463.     evi-find-forward nil
  2464.     evi-find-up-to t)
  2465.   (evi-find-character-backwards-internal (or count 1) context))
  2466.  
  2467. (evi-defmotion horizontal evi-find-next-character (&optional count context)
  2468.   "Search for the next COUNT'th occurence of the previous search character."
  2469.   (if evi-find-character
  2470.     (if evi-find-forward
  2471.       (evi-find-character-internal (or count 1) context)
  2472.       (evi-find-character-backwards-internal (or count 1) context))
  2473.     (evi-error "No previous search character")))
  2474.  
  2475. (evi-defmotion horizontal evi-find-next-character-reverse (&optional count context)
  2476.   "Search for the next COUNT'th occurence of the previous search character
  2477. in the opposite direction."
  2478.   (let ((evi-find-forward (not evi-find-forward)))
  2479.     (do-evi-find-next-character count context)))
  2480.  
  2481. (defun evi-find-character-internal (count context)
  2482.   (forward-char)
  2483.   (let ((case-fold-search nil))
  2484.     (if (search-forward (char-to-string evi-find-character)
  2485.             (save-excursion (end-of-line) (point)) t count)
  2486.       (if evi-find-up-to
  2487.     (backward-char))
  2488.       (progn (backward-char)
  2489.          (evi-error "No more occurences on this line"))))
  2490.   (or context
  2491.       (backward-char)))
  2492.  
  2493. (defun evi-find-character-backwards-internal (count context)
  2494.   (let ((case-fold-search nil))
  2495.     (or (search-backward (char-to-string evi-find-character)
  2496.              (save-excursion (beginning-of-line) (point)) t count)
  2497.     (evi-error "No more occurences on this line")))
  2498.   (if evi-find-up-to
  2499.     (forward-char)))
  2500.  
  2501. (evi-defmotion horizontal evi-paren-match (&optional count context)
  2502.   "Move cursor to matching parenthesis, brace or bracket."
  2503.   (let ((end-point (save-excursion (end-of-line) (point))))
  2504.     (if (re-search-forward "[][(){}]" end-point t)
  2505.       (progn (backward-char)
  2506.          (if (looking-at "[({[]")
  2507.            (progn (forward-sexp 1)
  2508.               (or context (backward-char)))
  2509.            (progn (forward-char)
  2510.               (if context (setq evi-mark (1+ evi-mark)))
  2511.               (backward-sexp 1))))
  2512.       (evi-error "Nothing on rest of line to balance"))))
  2513.  
  2514. ;; Repeating
  2515.  
  2516. (defun evi-save-command-keys ()
  2517.   (setq evi-last-command-keys evi-command-keys
  2518.     evi-hidden-repeat-count 0))
  2519.  
  2520. (defun evi-repeat ()
  2521.   "Repeat last modifying command."
  2522.   (interactive)
  2523.   (let ((command-to-repeat evi-last-command-keys)
  2524.     (evi-repeat-count (1+ evi-hidden-repeat-count)))
  2525.     (evi-execute-macro evi-last-command-keys)
  2526.     (setq evi-last-command-keys command-to-repeat
  2527.       evi-hidden-repeat-count evi-repeat-count)))
  2528.  
  2529. (defun evi-prompt-repeat ()
  2530.   "Print last modifying command."
  2531.   (interactive)
  2532.   (let ((command (evi-read-string "Repeat: " evi-last-command-keys)))
  2533.     (evi-execute-macro command)
  2534.     (setq evi-last-command-keys command)))
  2535.  
  2536. ;; Prefix counts
  2537.  
  2538. (defun evi-read-number (prefix-value)
  2539.   (let ((char (evi-read-command-char)))
  2540.     (if (and (>= char ?0) (<= char ?9))
  2541.       (evi-read-number (+ (* prefix-value 10) (- char ?0)))
  2542.       (progn (evi-unread-command-char char)
  2543.          prefix-value))))
  2544.  
  2545. (defun evi-prefix-digit ()
  2546.   "Prefix count."
  2547.   (interactive)
  2548.   (let ((evi-prefix-count (* evi-prefix-count-multiplier
  2549.                  (evi-read-number (- last-command-char ?0)))))
  2550.     (evi-get-command)))
  2551.  
  2552. ;; Registers
  2553.  
  2554. (defun evi-prefix-register ()
  2555.   "Prefix register."
  2556.   (interactive)
  2557.   (let ((char (evi-read-command-char)))
  2558.     (if (or (eq char ?') (eq char ?")) ;"))
  2559.     (progn
  2560.       (setq evi-region-shape 'chars)
  2561.       (evi-copy-region-to-register
  2562.         (if (eq char ?') (char-to-string (evi-read-command-char))
  2563.           (evi-read-string "\" "))
  2564.         (or evi-register-spec (cons evi-register-unnamed nil))))
  2565.       (let ((evi-register-spec (cons (evi-register-number char)
  2566.                      (not (and (>= char ?a) (<= char ?z))))))
  2567.     (evi-get-command)))))
  2568.  
  2569. (defun evi-register-number (register-name)
  2570.   (cond ((and (>= register-name ?a) (<= register-name ?z))
  2571.       (+ (- register-name ?a) 10))
  2572.     ((and (>= register-name ?A) (<= register-name ?Z))
  2573.       (+ (- register-name ?A) 10))
  2574.     ((and (>= register-name ?1) (<= register-name ?9))
  2575.      (% (+ evi-digit-register (- register-name ?0) evi-repeat-count) 9))
  2576.     ((eq register-name ?^)
  2577.       evi-register-unnamed)
  2578.     ((eq register-name ?@)
  2579.       (or evi-last-macro-register
  2580.           (evi-error "No previous macro register specified")))
  2581.     (t (evi-error "Invalid register name"))))
  2582.  
  2583. (defun evi-register-name (register-number)
  2584.   (if (> register-number 9)
  2585.     (+ register-number (- ?a 10))
  2586.     (+ register-number ?1)))
  2587.  
  2588. (defun evi-copy-region-to-registers (number-register-also)
  2589.   (let ((region (if (eq evi-region-shape 'rectangle)
  2590.             (extract-rectangle evi-mark (1+ (point)))
  2591.           (buffer-substring evi-mark (point)))))
  2592.     (evi-copy-region-to-register region evi-register-spec)
  2593.     (if number-register-also
  2594.       (progn (aset evi-registers
  2595.            evi-digit-register (cons region evi-region-shape))
  2596.          (setq evi-digit-register (if (= evi-digit-register 0)
  2597.                       8
  2598.                     (1- evi-digit-register)))))))
  2599.  
  2600. (defun evi-copy-region-to-register (region register-spec)
  2601.   (let ((register-number (car register-spec)))
  2602.     (if (not (eq register-number evi-register-unnamed))
  2603.     (aset evi-registers
  2604.           evi-register-unnamed (cons region evi-region-shape)))
  2605.     (if register-spec
  2606.     (aset evi-registers register-number
  2607.           (if (and (cdr register-spec)
  2608.                (not (eq evi-region-shape 'rectangle)))
  2609.           (let ((register (aref evi-registers register-number)))
  2610.             (cons (concat (car register) region) (cdr register)))
  2611.         (cons region evi-region-shape))))))
  2612.  
  2613. ;; Undoing
  2614.  
  2615. (defun evi-undo ()
  2616.   "Undo previous change."
  2617.   (interactive)
  2618.   ; ZZ - is this the only place we're concerned with unnecessary output
  2619.   ; during a macro?
  2620.   (or evi-current-macro
  2621.       (message "undo!"))
  2622.   (evi-undo-start)
  2623.   (evi-undo-one-change)
  2624.   (evi-fixup-cursor 'vertical))
  2625.  
  2626. (evi-version-case
  2627.   ("Emacs 18\.5[789]\\|Epoch 4\\|Emacs 19.*Lucid"
  2628.     (defun evi-undo-line ()
  2629.       "Undo all changes to this line."
  2630.       (interactive)
  2631.       (evi-undo-start)
  2632.       (evi-undo-one-line)
  2633.       (evi-fixup-cursor 'vertical))))
  2634.  
  2635. (defun evi-undo-start ()
  2636.   (undo-start)
  2637.   (evi-version-case
  2638.     ("Emacs 18\.5[789]\\|Epoch 4\\|Emacs 19.*Lucid"
  2639.       ; if the first record is a boundary, skip it
  2640.       (while (and pending-undo-list (null (car pending-undo-list)))
  2641.     (setq pending-undo-list (cdr pending-undo-list))))
  2642.     ("Emacs"
  2643.       (undo-more 1))))
  2644.  
  2645. (defun evi-undo-more ()
  2646.   "Continue undoing previous changes."
  2647.   (interactive)
  2648.   (evi-version-case
  2649.     ("Emacs 18\.5[789]\\|Epoch 4\\|Emacs 19.*Lucid"
  2650.       (if (boundp 'pending-undo-list)
  2651.     (progn (message "undo more!")
  2652.            (evi-undo-one-change)
  2653.            (evi-fixup-cursor 'vertical))
  2654.     (evi-error "No previous undo to continue")))
  2655.     ("Emacs"
  2656.     (message "undo more!")
  2657.     (evi-undo-one-change)
  2658.     (evi-fixup-cursor 'vertical))))
  2659.  
  2660. (defun evi-undo-one-change ()
  2661.   (let ((modified (buffer-modified-p)))
  2662.     (undo-more 1)
  2663.     (and modified (not (buffer-modified-p))
  2664.      (delete-auto-save-file-if-necessary)))
  2665.   (evi-reset-goal-column))
  2666.  
  2667. (defvar evi-last-undo-line-mark nil)
  2668.  
  2669. (evi-version-case
  2670.   ("Emacs 18\.5[789]\\|Epoch 4\\|Emacs 19.*Lucid"
  2671.     ; undo records are:
  2672.     ;   (t . ...) which marks a file save
  2673.     ;   ("string" . pos) which undoes a delete
  2674.     ;   (pos . pos) which undoes an insert
  2675.     (defun evi-undo-one-line ()
  2676.       (if (eq evi-last-undo-line-mark (cdr buffer-undo-list))
  2677.     (evi-error "No undo for this line"))
  2678.       (let* ((begin (save-excursion (beginning-of-line) (point)))
  2679.          (end (save-excursion (end-of-line) (point)))
  2680.          (undo-new nil)
  2681.          (something-to-do nil))
  2682.     (evi-enumerate-condition undo-record pending-undo-list
  2683.       (cond ((eq (car undo-record) t)
  2684.           (setq undo-new (nconc undo-new list))
  2685.           nil)
  2686.         ((stringp (car undo-record))
  2687.           (if (and (>= (cdr undo-record) begin)
  2688.                (<= (cdr undo-record) end))
  2689.             (progn (setq end (+ end (length (car undo-record))))
  2690.                (setq undo-new
  2691.                  (nconc undo-new (list undo-record)))
  2692.                (setq something-to-do t)
  2693.                t)
  2694.             (progn (setq undo-new (nconc undo-new (list nil) list))
  2695.                nil)))
  2696.         ((integerp (car undo-record))
  2697.           (let* ((first (car undo-record))
  2698.              (second (cdr undo-record))
  2699.              (begin2 (if (< first begin) begin first))
  2700.              (end2 (if (> second end) end second))
  2701.              (diff (- end2 begin2)))
  2702.             (if (and (<= first end) (>= second begin) (/= begin2 end2))
  2703.               (progn
  2704.             (setq undo-new
  2705.                   (nconc undo-new (list (cons begin2 end2))))
  2706.             (setq something-to-do t)
  2707.             (if (or (< first begin) (> second end))
  2708.               (progn
  2709.                 (nconc undo-new (list nil))
  2710.                 (if (< first begin)
  2711.                   (nconc undo-new (list (cons first begin))))
  2712.                 (if (> second end)
  2713.                   (nconc undo-new
  2714.                 (list (cons (- end diff) (- second diff)))))
  2715.                 (nconc undo-new (cdr list))
  2716.                 nil)
  2717.               (progn (setq end (- end diff))
  2718.                  t)))
  2719.               (progn
  2720.                  (setq undo-new (nconc undo-new (list nil) list))
  2721.                  nil))))
  2722.         ((eq undo-record nil)
  2723.           t)))
  2724.     (if something-to-do
  2725.       (let ((modified (buffer-modified-p)))
  2726.         (setq pending-undo-list undo-new)
  2727.         (undo-more 1)
  2728.         (message "Undo!")
  2729.         (setq evi-last-undo-line-mark buffer-undo-list)
  2730.         (beginning-of-line)
  2731.         (and modified (not (buffer-modified-p))
  2732.          (delete-auto-save-file-if-necessary)))
  2733.       (evi-error "No undo for this line")))
  2734.       (evi-reset-goal-column))))
  2735.  
  2736. ;; Marks
  2737.  
  2738. (defun evi-set-mark (char &optional count)
  2739.   "Mark location."
  2740.   (interactive (evi-character-arg))
  2741.   (cond ((and (>= char ?a) (<= char ?z))
  2742.       (aset evi-registers (+ (- char ?a) 36) (point-marker)))
  2743.     ((eq char ?.)
  2744.       (setq evi-mark (point)))))
  2745.  
  2746. (evi-defmotion horizontal evi-goto-mark-horizontal (&optional count context)
  2747.   "Goto a mark."
  2748.   (evi-goto-mark-internal (evi-read-command-char) context))
  2749.  
  2750. (evi-defmotion vertical evi-goto-mark-vertical (&optional count context)
  2751.   "Goto a mark.  If an operand, define a whole lines region."
  2752.   (evi-goto-mark-internal (evi-read-command-char) context)
  2753.   (or context
  2754.     (back-to-indentation)))
  2755.  
  2756. (defun evi-goto-mark-internal (char &optional context)
  2757.   (cond ((and (>= char ?a) (<= char ?z))
  2758.       (let ((marker (aref evi-registers (+ (- char ?a) 36))))
  2759.         (if (not (eq (current-buffer) (marker-buffer marker)))
  2760.           (progn (switch-to-buffer (marker-buffer marker))
  2761.              ; unpleasant, but best we can do... (?)
  2762.              (if context (setq evi-mark (point)))))
  2763.         (evi-push-context)
  2764.         (goto-char marker)))
  2765.     ((or (eq char ?`) (eq char ?'))
  2766.       (goto-char (evi-exchange-context)))
  2767.     ((eq char ?.)
  2768.       (goto-char (evi-pop-context)))
  2769.     ((eq char ?,)
  2770.       (goto-char (evi-unpop-context)))))
  2771.  
  2772. (defun evi-push-context (&optional offset)
  2773.   (let ((marker (if offset (set-marker (make-marker) offset) (point-marker))))
  2774.     (aset evi-context-ring evi-context-ring-cursor marker)
  2775.     (setq evi-context-ring-cursor
  2776.       (if (= evi-context-ring-cursor 9) 0 (1+ evi-context-ring-cursor)))))
  2777.  
  2778. (defun evi-pop-context ()
  2779.   (setq evi-context-ring-cursor
  2780.     (if (= evi-context-ring-cursor 0) 9 (1- evi-context-ring-cursor)))
  2781.   (aref evi-context-ring evi-context-ring-cursor))
  2782.  
  2783. (defun evi-unpop-context ()
  2784.   (setq evi-context-ring-cursor
  2785.     (if (= evi-context-ring-cursor 9) 0 (1+ evi-context-ring-cursor)))
  2786.   (aref evi-context-ring evi-context-ring-cursor))
  2787.  
  2788. (defun evi-exchange-context ()
  2789.   (let ((cursor
  2790.      (if (= evi-context-ring-cursor 0) 9 (1- evi-context-ring-cursor))))
  2791.     (prog1 (aref evi-context-ring cursor)
  2792.        (aset evi-context-ring cursor (point-marker)))))
  2793.  
  2794. ;; Misc
  2795.  
  2796. (defun evi-file-info ()
  2797.   "Give information on the file associated with the current buffer."
  2798.   (interactive)
  2799.   (let* ((line-number (count-lines 1 (min (1+ (point)) (point-max))))
  2800.      (total-lines (1- (+ line-number (count-lines (point) (point-max)))))
  2801.      (file-name (buffer-file-name)))
  2802.     (message "\"%s\"%s%s line %d of %d, column %d --%d%%--"
  2803.          (if file-name
  2804.            (if evi-global-directory
  2805.          (evi-abbreviate-file-name file-name (evi-current-directory))
  2806.          file-name)
  2807.            "")
  2808.          (if evi-buffer-read-only
  2809.            " [Read only]" "")
  2810.          (if (buffer-modified-p) " [Modified]" "")
  2811.          line-number
  2812.          total-lines
  2813.          (1+ (current-column))
  2814.          (/ (* line-number 100) total-lines))))
  2815.  
  2816. (defun evi-abbreviate-file-name (file-name directory &optional abbrev)
  2817.   (let* ((length (length directory))
  2818.      (ends-in-slash (= (aref directory (1- length)) ?/)))
  2819.     (if (and (> length 0)
  2820.          (>= (length file-name) length)
  2821.          (string= (substring file-name 0 length) directory))
  2822.       (concat (or abbrev "")
  2823.           (substring file-name
  2824.              (+ length (if (or abbrev ends-in-slash) 0 1))))
  2825.       file-name)))
  2826.  
  2827. (defun evi-tag ()
  2828.   "Go to the tag which is the next word in the buffer."
  2829.   (interactive)
  2830.   (evi-motion-command 'do-evi-forward-word 'horizontal 1 'to-end)
  2831.   (ex-tag (buffer-substring evi-mark (point))))
  2832.  
  2833. (defun evi-make-char-table ()
  2834.   (let ((table (make-vector 256 0))
  2835.     (i ?:))
  2836.     (while (<= ?0 (setq i (1- i)))
  2837.       (aset table i 1))
  2838.     (setq i ?\[)
  2839.     (while (<= ?A (setq i (1- i)))
  2840.       (aset table i 2))
  2841.     (setq i ?\{)
  2842.     (while (<= ?a (setq i (1- i)))
  2843.       (aset table i 2))
  2844.     (setq i ? )
  2845.     (while (<= 0 (setq i (1- i)))
  2846.       (aset table i 4))
  2847.     table))
  2848.  
  2849. (defvar evi-char-table (evi-make-char-table))
  2850.  
  2851. (defun evi-is-num (c)
  2852.   (= (logand (aref evi-char-table c) 1) 1))
  2853.  
  2854. (defun evi-is-alpha (c)
  2855.   (= (logand (aref evi-char-table c) 2) 2))
  2856.  
  2857. (defun evi-is-alphanum (c)
  2858.   (/= (logand (aref evi-char-table c) 3) 0))
  2859.  
  2860. (defun evi-is-nonalphanum (c)
  2861.   (= (logand (aref evi-char-table c) 3) 0))
  2862.  
  2863. (defun evi-is-control-char (c)
  2864.   (= (logand (aref evi-char-table c) 4) 4))
  2865.  
  2866. (defun evi-is-printable (c)
  2867.   (and (not (evi-is-control-char c))
  2868.        (< c ?\C-?)))
  2869.  
  2870. ;; Display of lists
  2871.  
  2872. (defun evi-display-and-prompt (command args)
  2873.   (let ((window (selected-window))
  2874.     (wconf (current-window-configuration)))
  2875.     (apply command args)
  2876.     (select-window (minibuffer-window))
  2877.     (message "Hit SPACE or RET to continue, anything else to keep window")
  2878.     (let ((c (evi-read-char)))
  2879.       (if (or (= c ?\n) (= c ?\r) (= c ? ))
  2880.       (set-window-configuration wconf)
  2881.     (select-window window)))))
  2882.  
  2883. (defun evi-display-list-and-prompt (buffer list &optional initial max-len)
  2884.   (evi-display-and-prompt
  2885.    'evi-display-list (list buffer list initial max-len)))
  2886.  
  2887. (defun evi-display-list (buffer list &optional initial max-len)
  2888.   (save-excursion
  2889.     (set-buffer (get-buffer-create buffer))
  2890.     (erase-buffer)
  2891.     (evi)
  2892.     (if initial
  2893.     (insert initial))
  2894.     (if (eq max-len 'half)
  2895.     (setq max-len (- (/ (window-width) 2) 2)))
  2896.     (if list
  2897.     (evi-insert-list-pretty list (or max-len (- (window-width) 2))))
  2898.     (display-buffer buffer t)))
  2899.  
  2900. (defun evi-insert-list-pretty (list max-len)
  2901.   (let* ((len (length list))
  2902.      (max-width (min (evi-max-len list) max-len))
  2903.      (col-width (+ max-width 2))
  2904.      (width (window-width))
  2905.      (cols (/ width col-width))
  2906.      (rows (/ (+ len (1- cols)) cols))
  2907.      (counters nil)
  2908.      (indent))
  2909.     (if (< len cols)
  2910.     (setq col-width (/ width len)
  2911.           max-width (- col-width 2)
  2912.           cols len
  2913.           rows 1))
  2914.     (evi-iterate cols
  2915.       (setq counters (cons (nthcdr (* (1- count) rows) list) counters)))
  2916.     (evi-iterate rows
  2917.       (setq indent 0)
  2918.       (evi-iterate-list item counters
  2919.     (let ((s (car (nthcdr (- rows count) item))))
  2920.       (if s
  2921.           (progn
  2922.         (indent-to indent)
  2923.         (insert (if (> (length s) max-width)
  2924.                 (concat (substring s 0 (- max-width 2)) "...")
  2925.               s))
  2926.         (setq indent (+ indent col-width))))))
  2927.       (insert ?\n))))
  2928.  
  2929. (defun evi-max-len (list)
  2930.   (let ((lengths (mapcar 'length list)))
  2931.     (apply 'max lengths)))
  2932.  
  2933. (defun evi-pretty-char (c)
  2934.   (cond ((evi-is-printable c)
  2935.       (char-to-string c))
  2936.     ((evi-is-control-char c)
  2937.       (if ex-input-escapes
  2938.           (cond ((= c ?\n) "\\n")
  2939.             ((= c ?\r) "\\r")
  2940.             ((= c ?\t) "\\t")
  2941.             ((= c ?\e) "\\e")
  2942.             (t (concat "\\C-"
  2943.                    (char-to-string (+ c (if (< c ?\e) ?` ?@))))))
  2944.         (concat "^" (char-to-string (+ c ?@)))))
  2945.     ((= c ?\C-?)
  2946.       (if ex-input-escapes "\\C-?" "^?"))
  2947.     (t
  2948.       (format "\\%03o" c))))
  2949.  
  2950. (defun evi-pretty-string (s)
  2951.   (mapconcat 'evi-pretty-char s ""))
  2952.  
  2953. ; works for maps as well as abbrev lists
  2954. (defun evi-pretty-binding (b)
  2955.   (concat (evi-pretty-string (car b)) " = "
  2956.       (evi-pretty-string (if (consp (cdr b))
  2957.                  (cdr (cdr b))
  2958.                    (cdr b)))))
  2959.  
  2960. ;; Ex
  2961.  
  2962. (defun evi-ex-command ()
  2963.   "Execute an ex command."
  2964.   (interactive)
  2965.   (evi-do-ex-command-string (ex-read-command))
  2966.   (evi-fixup-cursor 'vertical))
  2967.  
  2968. ; ZZ this should be cleaned up
  2969. (defvar ex-user-buffer nil)
  2970.  
  2971. (defun ex-read-command ()
  2972.   (let ((command nil)
  2973.     (ex-user-buffer (current-buffer)))
  2974.     (while (null command)
  2975.       (setq command (evi-read-string ":" nil
  2976.               (list evi-input-map-map evi-ex-map evi-input-map))))
  2977.     command))
  2978.  
  2979. (defun ex-do-completion (name start c-name c-list-fun)
  2980.   (if c-name
  2981.       (if (stringp c-name)
  2982.       (if (string= name c-name)
  2983.           (evi-display-completions (funcall c-list-fun c-name))
  2984.         (progn (delete-region start (point))
  2985.            (insert c-name))))
  2986.     (progn (beep) (save-excursion (insert " [no match]"))
  2987.        (sit-for 2)
  2988.        (delete-region (point) (+ (point) 11)))))
  2989.  
  2990. (defun evi-display-completions (list)
  2991.   (evi-display-list " *Completions*" list "Possible completions are:\n"))
  2992.  
  2993. (defun ex-scan-command-point ()
  2994.   (ex-scan-addresses)
  2995.   (let* ((start-of-com (point))
  2996.      (command (ex-scan-command-name))
  2997.      (type (if command
  2998.            (ex-scan-parameter-list (cdr (car (cdr command))) t))))
  2999.     (cons type (cons start-of-com (point)))))
  3000.  
  3001. (defun ex-complete ()
  3002.   (interactive)
  3003.   (let* ((cmd-point (save-excursion (goto-char evi-insert-point)
  3004.                     (ex-scan-command-point)))
  3005.      (type (if (and (= (point) (cdr (cdr cmd-point)))
  3006.             (/= (preceding-char) ? ))
  3007.            'command
  3008.          (car cmd-point)))
  3009.      (start-of-word
  3010.        (if (eq type 'command)
  3011.            (nth 1 cmd-point)
  3012.          (max (cdr (cdr cmd-point))
  3013.           (save-excursion (skip-chars-backward "^ \t") (point)))))
  3014.      (word (buffer-substring start-of-word (point))))
  3015.     (cond ((or (eq type 'file) (eq type 'files))
  3016.         ; ZZ perform substitution?
  3017.         (let* ((name (file-name-nondirectory word))
  3018.            (odir (file-name-directory word))
  3019.            (dir (let ((cur-buffer (current-buffer)))
  3020.               (set-buffer ex-user-buffer)
  3021.               (prog1
  3022.                 (if odir
  3023.                 (expand-file-name odir (evi-current-directory))
  3024.                   (evi-current-directory))
  3025.                 (set-buffer cur-buffer)))))
  3026.           (ex-do-completion name (+ start-of-word (length odir))
  3027.         (file-name-completion name dir)
  3028.         (function (lambda (c-name)
  3029.                 (file-name-all-completions c-name dir))))))
  3030.       ((eq type 'buffer)
  3031.         (let ((buf-list
  3032.            (mapcar 'list
  3033.              (evi-filter (function
  3034.                    (lambda (name) (/= (aref name 0) ? )))
  3035.                  (mapcar 'buffer-name (buffer-list))))))
  3036.           (ex-do-completion word start-of-word
  3037.             (try-completion word buf-list)
  3038.         (function (lambda (c-name)
  3039.                 (all-completions c-name buf-list))))))
  3040.       ((eq type 'settings)
  3041.         (if (> (save-excursion (goto-char start-of-word)
  3042.                    (skip-chars-forward "^=")
  3043.                    (point))
  3044.            (point))
  3045.         (beep)
  3046.           (let ((settings-list (mapcar 'car evi-option-list)))
  3047.         (ex-do-completion word start-of-word
  3048.           (try-completion word settings-list)
  3049.           (function (lambda (c-name)
  3050.                   (all-completions c-name settings-list)))))))
  3051.       ((or (eq type 'command) (eq type 'map) (eq type 'abbrev))
  3052.         (let ((cmd-list
  3053.            (if (eq type 'command)
  3054.                (mapcar 'car ex-commands)
  3055.              (if (eq type 'map)
  3056.              (evi-keymap-bindings evi-map-map)
  3057.                evi-abbrev-list))))
  3058.           (ex-do-completion word start-of-word
  3059.         (try-completion word cmd-list)
  3060.         (function (lambda (c-name)
  3061.                 (all-completions c-name cmd-list))))))
  3062.       (t (beep)))))
  3063.  
  3064. (defun evi-filter (pred list)
  3065.   (if list
  3066.     (if (funcall pred (car list))
  3067.       (cons (car list) (evi-filter pred (cdr list)))
  3068.       (evi-filter pred (cdr list)))))
  3069.  
  3070. (defun evi-do-ex-command-file (filename)
  3071.   (if (file-readable-p filename)
  3072.     (let ((ex-user-buffer (current-buffer))
  3073.       (def-dir default-directory)
  3074.       (evi-interactive nil))
  3075.       (set-buffer ex-work-space)
  3076.       (erase-buffer)
  3077.       (let ((default-directory def-dir))
  3078.       (insert-file-contents filename))
  3079.       (goto-char (point-min))
  3080.       (evi-do-ex-command)
  3081.       (set-buffer ex-user-buffer))))
  3082.  
  3083. (defun evi-do-ex-command-string (command-string)
  3084.   (let ((ex-user-buffer (current-buffer)))
  3085.     (set-buffer ex-work-space)
  3086.     (erase-buffer)
  3087.     (insert command-string "\n")
  3088.     (goto-char (point-min))
  3089.     (evi-do-ex-command)
  3090.     (if (and ex-user-buffer (buffer-name ex-user-buffer))
  3091.     (set-buffer ex-user-buffer))))
  3092.  
  3093. ;; Note - it is expected that the function that calls this one has set
  3094. ;; ex-user-buffer, and switched to buffer ex-work-space
  3095. (defun evi-do-ex-command ()
  3096.   (while (not (eobp))
  3097.     (let ((command (ex-scan-command)))
  3098.       (set-buffer ex-user-buffer)
  3099.       (if evi-global-directory
  3100.       (let ((default-directory (evi-current-directory)))
  3101.         (eval command))
  3102.     (eval command))
  3103.       (set-buffer ex-work-space)
  3104.       (forward-char))))
  3105.  
  3106. (defun ex-scan-command ()
  3107.   (if (= (following-char) ?:)
  3108.       (forward-char))
  3109.   (if (= (following-char) ?") ;")
  3110.       (end-of-line))
  3111.   (let* ((addresses (ex-scan-addresses))
  3112.      (command-struct (ex-scan-command-name))
  3113.      (number-of-addresses (car (car (cdr command-struct))))
  3114.      (command-name (car (car command-struct)))
  3115.      (command-prototype (cdr (car (cdr command-struct))))
  3116.      (command-function (cdr (cdr command-struct))))
  3117.     (if (null command-struct)
  3118.       (evi-error "Unknown ex command"))
  3119.     (if (> (ex-count-addresses addresses) number-of-addresses)
  3120.       (evi-error "The %s command only needs %d addresses"
  3121.                 command-name number-of-addresses))
  3122.     (let ((parameter-list (ex-scan-parameter-list command-prototype nil)))
  3123.       (skip-chars-forward " \t")
  3124.       (or (looking-at "[|\n]")
  3125.       (evi-error "garbage after end of command: `%s'"
  3126.              (buffer-substring (point)
  3127.                        (progn (skip-chars-forward "^|\n")
  3128.                           (skip-chars-backward " \t")
  3129.                           (point)))))
  3130.       (cons command-function
  3131.         (cond ((eq number-of-addresses 1)
  3132.             (cons (list 'quote (car addresses)) parameter-list))
  3133.           ((eq number-of-addresses 2)
  3134.             (cons (list 'quote addresses) parameter-list))
  3135.           (t
  3136.             parameter-list))))))
  3137.  
  3138. (defun ex-scan-parameter-list (prototype-list completing)
  3139.   (if prototype-list
  3140.     (let ((prototype (cdr (car prototype-list)))
  3141.       (skip-white (eq (car (car prototype-list)) t)))
  3142.       (if (and completing
  3143.            (symbolp prototype)
  3144.            (not (eq prototype 'offset)))
  3145.       prototype
  3146.     (if skip-white
  3147.         (skip-chars-forward " \t")
  3148.       (if (eq (car (car prototype-list)) 'backup)
  3149.           (backward-char)))
  3150.     (let* ((param (cond ((null prototype)
  3151.                   nil)
  3152.                 ((stringp prototype)
  3153.                   (ex-scan-string prototype))
  3154.                 ((eq prototype 'address)
  3155.                   (list 'quote (ex-scan-address)))
  3156.                 ((eq prototype 'register)
  3157.                   (list 'quote (ex-scan-register)))
  3158.                 ((eq prototype 'file)
  3159.                   (ex-scan-quoted "%#*?$" " \t|\n"))
  3160.                 ((eq prototype 'buffer)
  3161.                   (ex-scan-quoted nil "|\n"))
  3162.                 ((eq prototype 'words)
  3163.                   (ex-scan-quoted nil "|\n"))
  3164.                 ((eq prototype 'rest-of-line)
  3165.                   (ex-scan-quoted nil "\n"))
  3166.                 ((or (eq prototype 'word)
  3167.                  (eq prototype 'map)
  3168.                  (eq prototype 'abbrev))
  3169.                   (ex-scan-quoted nil " \t|\n"))
  3170.                 ((eq prototype 'regular-expression)
  3171.                   (ex-scan-regular-expression))
  3172.                 ((eq prototype 'regular-expression2)
  3173.                   (ex-scan-regular-expression t))
  3174.                 ((eq prototype 'command)
  3175.                   (list 'quote (ex-scan-command)))
  3176.                 ((eq prototype 'settings)
  3177.                   (list 'quote (ex-scan-settings)))
  3178.                 ((eq prototype 'files)
  3179.                   (ex-scan-files))
  3180.                 ((eq prototype 'shell-command)
  3181.                   (ex-scan-quoted "%#" "\n"))
  3182.                 ((eq prototype 'offset)
  3183.                   (ex-scan-edit-offset))
  3184.                 ((eq prototype 'mark)
  3185.                   (ex-scan-mark))))
  3186.            (recurs
  3187.          (ex-scan-parameter-list (cdr prototype-list) completing)))
  3188.       (if completing
  3189.           recurs
  3190.         (cons param recurs)))))))
  3191.  
  3192. (defun ex-scan-addresses ()
  3193.   (skip-chars-forward " \t")
  3194.   (if (= (following-char) ?%)
  3195.       (progn (forward-char)
  3196.          (cons (cons (cons 'number 1) 0) (cons (cons 'dollar nil) 0)))
  3197.     (if (looking-at "[-+0-9.$'/?]")
  3198.       (cons
  3199.     (ex-scan-address)
  3200.     (progn (skip-chars-forward " \t")
  3201.            (if (= (following-char) ?,)
  3202.          (progn (forward-char)
  3203.             (skip-chars-forward " \t")
  3204.             (ex-scan-address))
  3205.          (cons (cons nil nil) 0))))
  3206.       (cons (cons (cons nil nil) 0) (cons (cons nil nil) 0)))))
  3207.  
  3208. (defun ex-scan-address ()
  3209.   (cons (ex-scan-linespec) (ex-scan-line-offset)))
  3210.  
  3211. (defun ex-scan-linespec ()
  3212.   (let ((char (following-char)))
  3213.     (cond
  3214.       ((and (>= char ?0) (<= char ?9))
  3215.     (let ((start (point)))
  3216.       (skip-chars-forward "0-9")
  3217.       (cons 'number (string-to-int (buffer-substring start (point))))))
  3218.       ((eq char ?.)
  3219.     (forward-char)
  3220.     (cons 'dot nil))
  3221.       ((eq char ?$)
  3222.     (forward-char)
  3223.     (cons 'dollar nil))
  3224.       ((eq char ?')
  3225.     (forward-char 2)
  3226.     (cons 'mark (preceding-char)))
  3227.       ((eq char ?/)
  3228.     (cons 're-forward (ex-scan-regular-expression)))
  3229.       ((eq char ??)
  3230.     (cons 're-backward (ex-scan-regular-expression))))))
  3231.  
  3232. ;; if evi-search-magic is nil, also rework the pattern so that . [ and *
  3233. ;; become literal, and \. \[ and \* are `magic' (i.e. behave as . [ and *
  3234. ;; in a regular expression)
  3235.  
  3236. (defun ex-scan-regular-expression (&optional esc-ampersand)
  3237.   (forward-char)
  3238.   (let* ((start (point))
  3239.      (stop-chars (concat (if esc-ampersand "&")
  3240.                  (if (not evi-search-magic) ".[*")))
  3241.      (skip-chars (concat "^\n\\\\\C-v" stop-chars
  3242.                  (char-to-string (preceding-char))))
  3243.      (stop-pat (concat "[\\\\\C-v" stop-chars "]")))
  3244.     (skip-chars-forward skip-chars)
  3245.     (while (looking-at stop-pat)
  3246.       (if (or (= (following-char) ?\\) (= (following-char) ?\C-v))
  3247.       (progn (forward-char)
  3248.          (and (/= (length stop-chars) 0)
  3249.               (looking-at (concat "[" stop-chars "]"))
  3250.               (delete-region (1- (point)) (point)))
  3251.          (forward-char))
  3252.     (insert "\\")
  3253.     (forward-char))
  3254.       (skip-chars-forward skip-chars))
  3255.     (prog1
  3256.       (buffer-substring start (point))
  3257.       (if (not (eolp))
  3258.     (forward-char)))))
  3259.  
  3260. (defun ex-scan-line-offset ()
  3261.   (if (looking-at "[0-9+-]")
  3262.       (let ((start (point)))
  3263.     (forward-char)
  3264.     (skip-chars-forward "0-9")
  3265.     ; if they only put a +/- without an offset, default to +/-1
  3266.     (if (and (= (- (point) start) 1) (< (preceding-char) ?0))
  3267.         (if (= (preceding-char) ?+) 1 -1)
  3268.       (string-to-int (buffer-substring start (point)))))
  3269.     0))
  3270.  
  3271. (defun ex-scan-edit-offset ()
  3272.   (if (/= (following-char) ?+)
  3273.       nil
  3274.     (forward-char)
  3275.     (if (evi-is-num (following-char))
  3276.     (ex-scan-line-offset)
  3277.       -1)))
  3278.  
  3279. ;; ZZ maybe recognize here that 0 is invalid?
  3280. (defun ex-define-region (addresses whole-lines default-whole-file)
  3281.   (let ((start (car addresses))
  3282.     (end (cdr addresses)))
  3283.     (if (and (null (car (car start))) default-whole-file)
  3284.       (progn (setq evi-mark (point-min))
  3285.          (goto-char (point-max)))
  3286.       (progn (let ((starting-point (point)))
  3287.            (ex-goto-address start)
  3288.            (setq evi-mark (point))
  3289.            (ex-goto-address end starting-point))
  3290.          (if whole-lines
  3291.            (evi-expand-region-to-lines 'ex))))))
  3292.  
  3293. (defvar ex-previous-re nil)
  3294.  
  3295. (defun ex-goto-line (line)
  3296.   (if line
  3297.       (let ((starting-point (point)))
  3298.     (goto-char (point-min))
  3299.     (if (or (> (forward-line (1- line)) 0) (eobp))
  3300.         (progn (goto-char starting-point)
  3301.            (evi-error "Past end of buffer"))))
  3302.     (progn (goto-char (point-max))
  3303.        (if (= (preceding-char) ?\n)
  3304.            (forward-line -1)
  3305.          (beginning-of-line)))))
  3306.  
  3307. (defun ex-goto-address (address &optional starting-point)
  3308.   (let ((token (car (car address)))
  3309.     (value (cdr (car address))))
  3310.     (cond ((eq token 'number)
  3311.         (ex-goto-line value))
  3312.       ((eq token 'dot)
  3313.         (if starting-point (goto-char starting-point)))
  3314.       ((eq token 'dollar)
  3315.         (ex-goto-line nil))
  3316.       ((eq token 'mark)
  3317.         (evi-goto-mark-internal value))
  3318.       ((eq token 're-forward)
  3319.         (if (= (length value) 0)
  3320.           (if ex-previous-re
  3321.         (setq value ex-previous-re)
  3322.         (evi-error "No previous regular expression"))
  3323.           (setq ex-previous-re value))
  3324.         (if starting-point (goto-char starting-point))
  3325.         (end-of-line)
  3326.         (let ((message (catch 'abort
  3327.                  (evi-do-search t value 1)
  3328.                  nil)))
  3329.           (if message
  3330.         (progn (forward-line -1)
  3331.                (evi-error message)))))
  3332.       ((eq token 're-backward)
  3333.         (if starting-point (goto-char starting-point))
  3334.         (evi-do-search nil value 1))))
  3335.   (forward-line (cdr address)))
  3336.  
  3337. (defun ex-goto-line-after-address (address)
  3338.   (if (null (car (car address)))
  3339.     (forward-line)
  3340.     (if (and (eq (car (car address)) 'number)
  3341.          (= (cdr (car address)) 0))
  3342.       (goto-char (point-min))
  3343.       (progn (ex-goto-address address)
  3344.          (forward-line)))))
  3345.  
  3346. (defun ex-count-addresses (addresses)
  3347.   (if (eq (car (car (car addresses))) nil)
  3348.     0
  3349.     (if (eq (car (car (cdr addresses))) nil)
  3350.       1
  3351.       2)))
  3352.  
  3353. (defun ex-scan-command-name ()
  3354.   (skip-chars-forward " \t")
  3355.   (let ((start (point)))
  3356.     (if (looking-at "[a-zA-Z!<=>&@]")
  3357.       (progn (forward-char)
  3358.          (let ((char (preceding-char)))
  3359.            (if (or (and (>= char ?a) (<= char ?z))
  3360.                (and (>= char ?A) (<= char ?Z)))
  3361.          (skip-chars-forward "a-zA-Z")))))
  3362.     (ex-lookup-command ex-commands (buffer-substring start (point)))))
  3363.  
  3364. (defun ex-lookup-command (command-list command)
  3365.   (evi-find cmd-struct command-list
  3366.     (if (ex-command-eq command (car cmd-struct))
  3367.       cmd-struct)))
  3368.  
  3369. (defun ex-command-eq (command command-cell)
  3370.   (let ((full-command (car command-cell)))
  3371.     (or (string= command full-command)
  3372.     (let ((command-length (length command)))
  3373.       (and (>= command-length (cdr command-cell))
  3374.            (< command-length (length full-command))
  3375.            (string= command
  3376.             (substring (car command-cell) 0 (length command))))))))
  3377.  
  3378. (defun ex-scan-register ()
  3379.   (if (evi-is-alpha (following-char))
  3380.       (let ((char (following-char)))
  3381.     (forward-char)
  3382.     (cons (evi-register-number char)
  3383.           (not (and (>= char ?a) (<= char ?z)))))
  3384.     (cons evi-register-unnamed nil)))
  3385.  
  3386. (defun ex-scan-mark ()
  3387.   (if (evi-is-alpha (following-char))
  3388.       (let ((char (following-char)))
  3389.     (forward-char)
  3390.     (+ (- char (if (and (>= char ?a) (<= char ?z)) ?a ?A)) 36))
  3391.     (evi-error "marker name required for mark command")))
  3392.  
  3393. (defun ex-scan-files ()
  3394.   (let ((file)
  3395.     (flist nil))
  3396.     (while (> (length (setq file (ex-scan-quoted "%#*?$" " \t|\n"))) 0)
  3397.       (setq flist (cons file flist))
  3398.       (skip-chars-forward " \t"))
  3399.     (cons 'quote (cons (nreverse flist) nil))))
  3400.  
  3401. (defun ex-scan-quoted (stop-chars delim-chars)
  3402.   (let ((start (point))
  3403.     (skip-chars (concat "^\\\\\C-v" stop-chars delim-chars))
  3404.     (stop-pat (concat "[\\\\\C-v" stop-chars "]"))
  3405.     (expand-glob nil))
  3406.     (skip-chars-forward skip-chars)
  3407.     (while (looking-at stop-pat)
  3408.       (let ((char (following-char)))
  3409.     (cond ((or (= char ?\\) (= char ?\C-v))
  3410.             (if ex-input-escapes
  3411.             (progn
  3412.               (delete-region (point) (1+ (point)))
  3413.               (let ((char (following-char)))
  3414.             (cond ((= char ?e)
  3415.                 (delete-region (point) (1+ (point)))
  3416.                 (insert ?\e))
  3417.                   ((= char ?n)
  3418.                 (delete-region (point) (1+ (point)))
  3419.                 (insert ?\n))
  3420.                   ((= char ?r)
  3421.                 (delete-region (point) (1+ (point)))
  3422.                 (insert ?\r))
  3423.                   ((= char ?t)
  3424.                 (delete-region (point) (1+ (point)))
  3425.                 (insert ?\t))
  3426.                   ((and (= char ?C)
  3427.                     (= (char-after (1+ (point))) ?-))
  3428.                 (let ((char (char-after (+ (point) 2))))
  3429.                   (insert (- char (if (< char ?a) ?@ ?`)))
  3430.                   (delete-region (point) (+ (point) 3))))
  3431.                   (t (forward-char 1)))))
  3432.           (forward-char)))
  3433.           ((= char ?%)
  3434.         (let ((file-name (buffer-file-name ex-user-buffer)))
  3435.           (if file-name
  3436.             (progn
  3437.               (delete-region (point) (1+ (point)))
  3438.               (insert file-name))
  3439.             (evi-error
  3440.               "Buffer has no filename to substitute for %%%%"))))
  3441.           ((= char ?#)
  3442.         (let* ((buffer (evi-next-file-buffer nil))
  3443.                (file-name (and buffer (buffer-file-name buffer))))
  3444.           (if file-name
  3445.             (progn
  3446.               (delete-region (point) (1+ (point)))
  3447.               (insert file-name))
  3448.             (evi-error
  3449.               "No alternate filename to substitute for #"))))
  3450.           (t
  3451.         (setq expand-glob t)
  3452.         (forward-char))))
  3453.       (skip-chars-forward skip-chars))
  3454.     (if expand-glob
  3455.       (progn (shell-command-on-region start (point)
  3456.            (concat "echo " (buffer-substring start (point))) t)
  3457.          (goto-char start)
  3458.          (skip-chars-forward (concat "^" delim-chars))))
  3459.     (if (/= start (point))
  3460.     (buffer-substring start (point)))))
  3461.  
  3462. (defun ex-scan-string (string)
  3463.   (let ((string-length (length string)))
  3464.     (if (<= string-length
  3465.         (- (save-excursion (skip-chars-forward "^|\n") (point))
  3466.            (point)))
  3467.       (let ((buffer-string
  3468.           (buffer-substring (point) (+ (point) string-length))))
  3469.     (if (string= string buffer-string)
  3470.       (progn (forward-char string-length)
  3471.          t))))))
  3472.  
  3473. (defun ex-not-implemented (&optional arg)
  3474.   (message "Command not implemented"))
  3475.  
  3476. (defun ex-abbrev (abbrev definition)
  3477.   (if abbrev
  3478.       (let ((elem (assoc abbrev evi-abbrev-list)))
  3479.     (if elem
  3480.         (if definition
  3481.         (setcdr elem (cons (length abbrev) definition))
  3482.           (message "%s" (evi-pretty-string (cdr (cdr elem)))))
  3483.       (if definition
  3484.           (setq evi-abbrev-list
  3485.             (cons
  3486.              (cons abbrev
  3487.                (cons (length abbrev) definition)) evi-abbrev-list))
  3488.         (evi-error "No abbrev for `%s'" abbrev))))
  3489.     (evi-display-list-and-prompt
  3490.       " *Abbrevs*" (mapcar 'evi-pretty-binding evi-abbrev-list))))
  3491.  
  3492. (defun ex-expand-abbrev ()
  3493.   (let ((abbrev evi-abbrev-list)
  3494.     (case-fold-search nil))
  3495.     (while abbrev
  3496.       (if (search-backward (car (car abbrev))
  3497.                (- (point) (nth 1 (car abbrev))) t)
  3498.       (if (evi-is-nonalphanum (preceding-char))
  3499.           (progn
  3500.         (delete-region (point) (+ (point) (nth 1 (car abbrev))))
  3501.         (insert (cdr (cdr (car abbrev)))))
  3502.         (goto-char (+ (point) (nth 1 (car abbrev))))))
  3503.       (setq abbrev (cdr abbrev)))))
  3504.  
  3505. (defun evi-self-insert ()
  3506.   (interactive)
  3507.   (if (evi-is-nonalphanum last-command-char)
  3508.       (ex-expand-abbrev))
  3509.   (self-insert-command 1))
  3510.  
  3511. (defun ex-change-buffer (exclam buffer-name)
  3512.   (ex-change-buffer-internal exclam buffer-name nil))
  3513.  
  3514. (defun ex-change-buffer-other-window (exclam buffer-name)
  3515.   (ex-change-buffer-internal exclam buffer-name t))
  3516.  
  3517. (defun ex-change-buffer-internal (exclam buffer-name other-window)
  3518.   (or buffer-name
  3519.       (setq buffer-name (buffer-name (other-buffer (current-buffer)))))
  3520.   (let ((found (ex-verify-buffer buffer-name)))
  3521.     (if (or exclam found)
  3522.       (if other-window
  3523.     (switch-to-buffer-other-window buffer-name)
  3524.     (switch-to-buffer buffer-name))
  3525.       (message "Buffer \"%s\" does not exist" buffer-name))
  3526.     (evi)))
  3527.     ; (and exclam (not found)
  3528.  
  3529. (defun ex-verify-buffer (buffer-name)
  3530.   (evi-find buf (buffer-list) (string= (buffer-name buf) buffer-name)))
  3531.  
  3532. (defun evi-expand-file-name (file-name)
  3533.   (let* ((expanded-name (expand-file-name file-name))
  3534.      (len (length expanded-name)))
  3535.     (if (= (aref expanded-name (1- len)) ?/)
  3536.     expanded-name
  3537.       (concat expanded-name "/"))))
  3538.  
  3539. (defun evi-current-directory ()
  3540.   (if evi-global-directory
  3541.       (car evi-directory-stack)
  3542.     default-directory))
  3543.  
  3544. (defun ex-change-directory (directory-name)
  3545.   (let ((expnd-dir-name (evi-expand-file-name (or directory-name "~"))))
  3546.     (if evi-global-directory
  3547.     (setcar evi-directory-stack expnd-dir-name)
  3548.       (setq default-directory expnd-dir-name))))
  3549.  
  3550. (defun ex-push-directory (directory-name)
  3551.   (if directory-name
  3552.       (setq evi-directory-stack
  3553.         (cons (evi-expand-file-name directory-name) evi-directory-stack))
  3554.     (if (null (cdr evi-directory-stack))
  3555.     (evi-error "Only one directory")
  3556.       (setq evi-directory-stack
  3557.         (cons (nth 1 evi-directory-stack)
  3558.           (cons (car evi-directory-stack)
  3559.             (cdr (cdr evi-directory-stack))))))))
  3560.  
  3561. (defun ex-pop-directory ()
  3562.   (if (null (cdr evi-directory-stack))
  3563.     (evi-error "Only one directory left")
  3564.     (setq evi-directory-stack (cdr evi-directory-stack))))
  3565.  
  3566. (defun ex-directory-stack ()
  3567.   (let ((home (getenv "HOME")))
  3568.     (message
  3569.       (mapconcat (function
  3570.            (lambda (f)
  3571.              (let* ((dir (evi-abbreviate-file-name f home "~"))
  3572.                 (end (1- (length dir))))
  3573.                (if (= (aref dir end) ?/)
  3574.              (substring dir 0 end)
  3575.              dir))))
  3576.          evi-directory-stack " "))))
  3577.  
  3578. (defun ex-copy (from-addresses to-address)
  3579.   (ex-define-region from-addresses t nil)
  3580.   (let ((text (buffer-substring evi-mark (point))))
  3581.     (ex-goto-line-after-address to-address)
  3582.     (insert text)))
  3583.  
  3584. (defun ex-delete (addresses register-struct)
  3585.   (let ((evi-register-spec register-struct))
  3586.     (ex-define-region addresses t nil)
  3587.     (evi-copy-region-to-registers t)
  3588.     ; to make undo's come out right
  3589.     (if (< evi-mark (point))
  3590.       (evi-exchange-point-and-mark))
  3591.     (delete-region (point) evi-mark)))
  3592.  
  3593. (defun ex-edit (exclam offset file-name)
  3594.   (ex-edit-internal exclam offset file-name nil))
  3595.  
  3596. (defun ex-edit-other-window (exclam offset file-name)
  3597.   (ex-edit-internal exclam offset file-name t))
  3598.  
  3599. (defun ex-edit-internal (exclam offset file-name other-window)
  3600.   (if (null file-name)
  3601.       (if (and (not exclam) (not other-window) (buffer-modified-p))
  3602.       (message "Buffer modified since last save (use :edit! to override)")
  3603.     (if other-window
  3604.         (split-window-vertically)
  3605.       (if (null (buffer-file-name))
  3606.           (message "Buffer has no file associated with it")
  3607.         (revert-buffer nil t)
  3608.         (evi))))
  3609.     (if other-window
  3610.     (find-file-other-window file-name)
  3611.       (find-file file-name))
  3612.     (evi))
  3613.   (if offset
  3614.       (ex-goto-line (if (= offset -1) nil offset))))
  3615.  
  3616. (defun ex-elisp-execute (lisp-expression)
  3617.   (eval (car (read-from-string lisp-expression))))
  3618.  
  3619. (defun ex-file (file-name)
  3620.   (if file-name
  3621.       (set-visited-file-name file-name)
  3622.     (evi-file-info)))
  3623.  
  3624. (defun ex-global (addresses pattern command)
  3625.   (let ((case-fold-search evi-ignore-case)
  3626.     (next-line-mark (make-marker))
  3627.     (end-line-mark (make-marker))
  3628.     (none-found t)
  3629.     (end-pos (point))
  3630.     (large-region))
  3631.     (if (= (length pattern) 0)
  3632.     (if ex-previous-re
  3633.         (setq pattern ex-previous-re)
  3634.       (evi-error "No previous regular expression"))
  3635.       (setq ex-previous-re pattern))
  3636.     (ex-define-region addresses t t)
  3637.     (evi-exchange-point-and-mark)
  3638.     (setq large-region (> (- evi-mark (point)) 5000))
  3639.     (if large-region
  3640.       (message "running global command... "))
  3641.     (set-marker end-line-mark evi-mark)
  3642.     (while (and (< (point) end-line-mark)
  3643.         (re-search-forward pattern end-line-mark t))
  3644.       ;; check to make sure ex also does this in case of line wrap
  3645.       (goto-char (match-beginning 0))
  3646.       (setq none-found nil
  3647.         end-pos (point))
  3648.       (save-excursion
  3649.     (forward-line)
  3650.     (set-marker next-line-mark (point)))
  3651.     ; (beginning-of-line)
  3652.       (eval command)
  3653.       (goto-char next-line-mark))
  3654.     (if large-region
  3655.       (message "running global command... complete."))
  3656.     (set-marker next-line-mark nil)
  3657.     (set-marker end-line-mark nil)
  3658.     (goto-char end-pos)
  3659.     (if none-found
  3660.     (evi-error "No occurance of pattern found"))))
  3661.  
  3662. (defun ex-recurse (fun)
  3663.   (let ((ex-user-buffer (current-buffer)))
  3664.     (set-buffer ex-work-space)
  3665.     (let ((work-string (buffer-string))
  3666.       (work-point (point)))
  3667.       (set-buffer ex-user-buffer)
  3668.       (eval fun)
  3669.       (setq ex-user-buffer (current-buffer))
  3670.       (set-buffer ex-work-space)
  3671.       (erase-buffer)
  3672.       (insert work-string)
  3673.       (goto-char work-point)
  3674.       (set-buffer ex-user-buffer))))
  3675.  
  3676. (defun ex-initialize ()
  3677.   (ex-recurse '(evi-customize)))
  3678.  
  3679. (defun ex-kill-buffer (exclam buffer-name)
  3680.   (and (not exclam) (buffer-file-name) (buffer-modified-p)
  3681.        (evi-error
  3682.      "No write since last change (use :kill! to override)"))
  3683.   (set-buffer-modified-p nil)
  3684.   (delete-auto-save-file-if-necessary)
  3685.   (kill-buffer (or buffer-name (current-buffer)))
  3686.   (setq ex-user-buffer (current-buffer)))
  3687.  
  3688. (defun ex-map (exclam key definition)
  3689.   (let ((map (if exclam evi-input-map-map evi-map-map)))
  3690.     (if key
  3691.     (if definition
  3692.         (if exclam
  3693.         (evi-define-key '(input-map) key definition)
  3694.           (evi-define-key '(map) key definition))
  3695.       (let ((mapping (lookup-key map key)))
  3696.         (if (stringp mapping)
  3697.         (message "%s" (evi-pretty-string mapping))
  3698.           (evi-error "No map for `%s'" key))))
  3699.       (evi-display-list-and-prompt
  3700.     " *Mappings*" (mapcar 'evi-pretty-binding
  3701.                   (evi-keymap-bindings map))))))
  3702.  
  3703. (defun ex-mark (address marker)
  3704.   (save-excursion
  3705.     (ex-goto-address address (point))
  3706.     (aset evi-registers marker (point-marker))))
  3707.  
  3708. (defun ex-move (from-addresses to-address)
  3709.   (ex-define-region from-addresses t nil)
  3710.   (let ((text (buffer-substring evi-mark (point)))
  3711.     (to-mark (copy-marker (save-excursion
  3712.                 (ex-goto-line-after-address to-address)
  3713.                 (point)))))
  3714.     ; to make undo's come out right
  3715.     (if (< evi-mark (point))
  3716.       (evi-exchange-point-and-mark))
  3717.     (delete-region (point) evi-mark)
  3718.     (goto-char to-mark)
  3719.     (insert text)
  3720.     (set-marker to-mark nil)))
  3721.  
  3722. (defun ex-preserve ()
  3723.   (do-auto-save))
  3724.  
  3725. (defun ex-print (addresses)
  3726.   (let ((position (save-excursion
  3727.             (ex-define-region addresses t nil) (point))))
  3728.     (switch-to-buffer-other-window (current-buffer))
  3729.     (goto-char position)
  3730.     (select-window (previous-window))))
  3731.  
  3732. (defun ex-next (exclam files)
  3733.   (ex-next-internal exclam files nil))
  3734.  
  3735. (defun ex-next-other-window (exclam files)
  3736.   (ex-next-internal exclam files t))
  3737.  
  3738. (defun ex-next-internal (exclam files other-window)
  3739.   (if files
  3740.       (let ((next-buffers
  3741.           (mapcar 'find-file-noselect files)))
  3742.     (if next-buffers
  3743.         (progn
  3744.           (if other-window
  3745.           (switch-to-buffer-other-window (car next-buffers))
  3746.         (switch-to-buffer (car next-buffers)))
  3747.           (evi))))
  3748.     (let ((next-buffer (evi-next-file-buffer t)))
  3749.       (if next-buffer
  3750.       (progn (bury-buffer (current-buffer))
  3751.          (if other-window
  3752.              (switch-to-buffer-other-window next-buffer)
  3753.            (switch-to-buffer next-buffer))
  3754.          (evi))
  3755.     (message "All files are displayed")))))
  3756.  
  3757. (defun evi-next-file-buffer (not-in-window)
  3758.   (let ((rest-of-list
  3759.       (evi-enumerate-condition buffer (cdr (buffer-list))
  3760.         (or (and not-in-window (get-buffer-window buffer))
  3761.         (null (buffer-file-name buffer))))))
  3762.     (if rest-of-list
  3763.       (car rest-of-list))))
  3764.  
  3765. (defun ex-put (address register-struct)
  3766.   (ex-goto-line-after-address address)
  3767.   (let ((register (aref evi-registers (car register-struct))))
  3768.     (if register
  3769.       (save-excursion
  3770.     (if (eq (evi-register-shape register) 'rectangle)
  3771.         (progn (newline (length (evi-register-text register)))
  3772.            (backward-char (length (evi-register-text register)))))
  3773.     (if (eq (evi-register-shape register) 'rectangle)
  3774.         (insert-rectangle (evi-register-text register))
  3775.       (insert (evi-register-text register)))
  3776.     (if (eq (evi-register-shape register) 'chars)
  3777.         (insert ?\n)))
  3778.       (if evi-register-spec
  3779.     (message "Nothing in register %c"
  3780.          (evi-register-name (car evi-register-spec)))
  3781.     (message "No text to put")))))
  3782.  
  3783. ;; ZZ should move to a misc section - actually this shouldn't be here: surely
  3784. ;; this is defined somewhere else?
  3785.  
  3786. (defun evi-list-apply (func l)
  3787.   (if l
  3788.     (progn (apply func (car l) nil)
  3789.        (evi-list-apply func (cdr l)))))
  3790.  
  3791. (defun ex-quit (discard)
  3792.   (if discard
  3793.     (progn
  3794.       (evi-list-apply
  3795.     (function (lambda (buf)
  3796.       (if (buffer-file-name buf)
  3797.         (progn (set-buffer buf)
  3798.            (delete-auto-save-file-if-necessary)))))
  3799.     (buffer-list))
  3800.       (kill-emacs))
  3801.     (save-buffers-kill-emacs)))
  3802.  
  3803. (defun ex-read (address shell-command arg)
  3804.   (ex-goto-line-after-address address)
  3805.   (if shell-command
  3806.     (shell-command arg t)
  3807.     (evi-insert-file arg)))
  3808.  
  3809. ; there's a bug in insert-file-contents that doesn't record an undo save
  3810. ; boundary when it's appropriate (ZZ)
  3811. (defun evi-insert-file (filename)
  3812.   (evi-version-case
  3813.     ("Emacs 18\.5[789]\\|Epoch 4\\|Emacs 19.*Lucid"
  3814.       ; the insert will record a save record if appropriate
  3815.       (insert ?@)
  3816.       (delete-region (1- (point)) (point))
  3817.       ; now just erase the existence of the insert and delete
  3818.       (setq buffer-undo-list (cdr (cdr buffer-undo-list)))))
  3819.   (insert-file-contents filename))
  3820.  
  3821. (defun ex-recover (exclam file-name)
  3822.   (or file-name
  3823.       (if (setq file-name (buffer-file-name))
  3824.       (and (not exclam) (buffer-modified-p)
  3825.            (evi-error
  3826.         "No write since last change (use :recover! to override)"))
  3827.     (evi-error "Buffer has no file associated with it")))
  3828.   (recover-file file-name)
  3829.   (auto-save-mode 1)
  3830.   (message "Auto save mode on")
  3831.   (evi))
  3832.  
  3833. (defun ex-set (settings)
  3834.   (if settings
  3835.       (ex-set-internal settings)
  3836.     (message (mapconcat 'evi-get-option evi-set-options " "))))
  3837.  
  3838. (defun ex-set-internal (settings)
  3839.   (if settings
  3840.     (let* ((setting (car settings))
  3841.        (name (car setting))
  3842.        (value (cdr setting)))
  3843.       (if (string= name "all")
  3844.       (evi-display-list-and-prompt
  3845.         " *Settings*"
  3846.         (mapcar (function (lambda (x) (evi-get-option (car (car x)))))
  3847.             (evi-filter (function (lambda (x) (cdr (cdr x))))
  3848.                 evi-option-list))
  3849.         nil 'half)
  3850.     (if (integerp value)
  3851.         (progn (princ (evi-get-option name))
  3852.            (princ " "))
  3853.       (evi-set-option name value)))
  3854.       (ex-set-internal (cdr settings)))))
  3855.  
  3856. (defun ex-scan-settings ()
  3857.   (skip-chars-forward " \t")
  3858.   (let ((settings nil))
  3859.     (while (looking-at "[A-Za-z]")
  3860.       (let* ((default-value
  3861.            (if (looking-at "no") (progn (forward-char 2) nil) t))
  3862.          (option (let ((start (point)))
  3863.                (skip-chars-forward "A-Za-z")
  3864.                (buffer-substring start (point)))))
  3865.     (cond ((looking-at "=")
  3866.         (progn (forward-char 1)
  3867.                (setq settings
  3868.              (cons (cons option (ex-scan-quoted nil " \t|\n"))
  3869.                    settings))))
  3870.           ((looking-at "?")
  3871.         (progn (forward-char 1)
  3872.                (setq settings
  3873.              (cons (cons option ??) settings))))
  3874.           (t
  3875.         (setq settings (cons (cons option default-value) settings)))))
  3876.       (skip-chars-forward " \t"))
  3877.     (if (looking-at "[^|\n]")
  3878.       (evi-error "Invalid setting%s"
  3879.          (if settings (format " after `%s'" (car (car settings))) "")))
  3880.     settings))
  3881.  
  3882. (defun evi-get-option (option)
  3883.   (let* ((option-struct (evi-search-option-list evi-option-list option))
  3884.      (type (nth 1 option-struct)))
  3885.     (if (eq type nil)
  3886.       (evi-error "invalid option `%s'" option)
  3887.       (let* ((long-name (car option-struct))
  3888.          (value (condition-case code
  3889.             (eval (cdr (cdr option-struct)))
  3890.               (error nil))))
  3891.     (cond
  3892.       ((eq (cdr (cdr option-struct)) nil)
  3893.         (if (or evi-interactive evi-report-unsupported-options)
  3894.         (evi-error "option `%s' not implemented" long-name)
  3895.           (concat long-name "=<ignored>")))
  3896.       ((eq type 'bool)
  3897.         (if (eq value t) long-name (concat "no" long-name)))
  3898.       ((eq type 'number)
  3899.         (concat long-name "=" (if value (int-to-string value) "<undef>")))
  3900.       ((eq type 'string)
  3901.         (concat long-name "=" (if value
  3902.                       (evi-pretty-string value)
  3903.                     "<undef>")))
  3904.       (t
  3905.         (evi-error "invalid type `%s'" (prin1-to-string type))))))))
  3906.  
  3907. (defun evi-set-option (option value)
  3908.   (let* ((option-struct (evi-search-option-list evi-option-list option))
  3909.      (type (nth 1 option-struct)))
  3910.     (cond
  3911.       ((eq type nil)
  3912.     (if (or evi-interactive evi-report-unsupported-options)
  3913.         (evi-error "Invalid option `%s'" option)))
  3914.       ((eq (cdr (cdr option-struct)) nil)
  3915.     (if (or evi-interactive evi-report-unsupported-options)
  3916.         (evi-error "Option `%s' not implemented" (car option-struct))))
  3917.       ((eq type 'bool)
  3918.         (if (not (or (eq value t) (eq value nil)))
  3919.         (evi-error "Only %s or no%s allowed" option option)))
  3920.       ((eq type 'number)
  3921.         (if (or (eq value t) (eq value nil))
  3922.         (evi-error "Use %s=<number> to set, or %s? to query" option option)
  3923.       (setq value (string-to-int value))))
  3924.       ((eq type 'string)
  3925.         (if (or (eq value t) (eq value nil))
  3926.         (evi-error
  3927.           "Use %s=<string> to set, or %s? to query" option option)))
  3928.       (t
  3929.     (evi-error "Invalid type `%s'" (prin1-to-string type))))
  3930.     (if (cdr (cdr option-struct))
  3931.     (progn (set (cdr (cdr option-struct)) value)
  3932.            (or (evi-find opt evi-set-options (equal opt option))
  3933.            (if evi-set-options
  3934.                (nconc evi-set-options (list option))
  3935.              (setq evi-set-options (list option))))))
  3936.     (if (fboundp (cdr (cdr option-struct)))
  3937.     (funcall (cdr (cdr option-struct)) value))))
  3938.  
  3939. (defun evi-search-option-list (option-list option)
  3940.   (let ((option (evi-find option-struct option-list
  3941.           (let ((option-strings (car option-struct)))
  3942.             (if (evi-string-list-match option-strings option)
  3943.               (cons (car option-strings) (cdr option-struct)))))))
  3944.     (or option '("" . nil))))
  3945.  
  3946. (defun evi-string-list-match (string-list string)
  3947.   (if string-list
  3948.     (if (string= string (car string-list))
  3949.     t
  3950.     (evi-string-list-match (cdr string-list) string))))
  3951.  
  3952. (defvar evi-shell-mode-hook nil)
  3953.  
  3954. (defun evi-shell-mode-setup ()
  3955.   (run-hooks 'evi-shell-mode-hook)
  3956.   (or evi-insert-mode-local-bindings
  3957.       (set (make-local-variable 'evi-insert-mode-local-bindings) t))
  3958.   (evi)
  3959.   (setq evi-buffer-local-vi-map evi-shell-map))
  3960.  
  3961. (defun ex-shell ()
  3962.   (let ((evi-shell-mode-hook
  3963.      (if (boundp 'shell-mode-hook) shell-mode-hook nil))
  3964.     (shell-mode-hook 'evi-shell-mode-setup))
  3965.     (shell)
  3966.     (evi-insert)))
  3967.  
  3968. (defun ex-gdb (program-name)
  3969.   (let ((evi-shell-mode-hook
  3970.      (if (boundp 'gdb-mode-hook) gdb-mode-hook nil))
  3971.     (gdb-mode-hook 'evi-shell-mode-setup))
  3972.     (gdb program-name)
  3973.     (evi-insert)))
  3974.  
  3975. (defun ex-source-file (file-name)
  3976.   (ex-recurse (list 'evi-do-ex-command-file file-name)))
  3977.  
  3978. (defvar ex-previous-substitute nil)
  3979.  
  3980. (defun ex-substitute (addresses pattern replacement global query)
  3981.   (let ((case-fold-search evi-ignore-case)
  3982.     (end-line-mark (make-marker))
  3983.     (none-found t)
  3984.     (end-pos (point))
  3985.     (large-region))
  3986.     (ex-define-region addresses t nil)
  3987.     (if (= (length pattern) 0)
  3988.     (if ex-previous-re
  3989.         (setq pattern ex-previous-re)
  3990.       (evi-error "No previous regular expression"))
  3991.       (setq ex-previous-re pattern))
  3992.     ; there are problems with global subst'ing just the beginning or end of a
  3993.     ; line, but in those cases you can only match one per line anyway, so
  3994.     ; demote to a non-global search
  3995.     (if (or (= (aref pattern 0) ?^)
  3996.         (= (aref pattern 0) ?$))
  3997.     (setq global nil))
  3998.     (evi-exchange-point-and-mark)
  3999.     (setq large-region (> (- evi-mark (point)) 5000))
  4000.     (if large-region
  4001.       (message "running substitute command... "))
  4002.     (set-marker end-line-mark evi-mark)
  4003.     (while (and (< (point) end-line-mark)
  4004.         (re-search-forward pattern end-line-mark t))
  4005.       (goto-char (match-beginning 0))
  4006.       (setq none-found nil
  4007.         end-pos (point))
  4008.       (ex-replace-match query replacement)
  4009.       (or global
  4010.       (forward-line)))
  4011.     (if large-region
  4012.       (message "running substitute command... complete."))
  4013.     (setq ex-previous-substitute
  4014.       (list addresses pattern replacement global query))
  4015.     (set-marker end-line-mark nil)
  4016.     (goto-char end-pos)
  4017.     (if none-found
  4018.     (evi-error "No occurance of pattern found"))))
  4019.  
  4020. (defun ex-substitute-again (addresses)
  4021.   (if ex-previous-substitute
  4022.     (apply 'ex-substitute addresses (cdr ex-previous-substitute))
  4023.     (evi-error "No previous substitution"))
  4024.   (setq ex-previous-substitute
  4025.     (append (list addresses) (cdr ex-previous-substitute))))
  4026.  
  4027. (defun evi-substitute-again ()
  4028.   (interactive)
  4029.   (if ex-previous-substitute
  4030.     (apply 'ex-substitute ex-previous-substitute)
  4031.     (evi-error "No previous substitution")))
  4032.  
  4033. (defun evi-hilight-region (start end)
  4034.   (let ((here (point))
  4035.     (flag nil)
  4036.     (going t))
  4037.     (goto-char start)
  4038.     (while going
  4039.       (if (not (sit-for 1))
  4040.       (setq going nil)
  4041.     (goto-char (if flag start end))
  4042.     (setq flag (not flag))))
  4043.     (goto-char here)))
  4044.  
  4045. (defun ex-replace-match (query replacement)
  4046.   (if (or (not query)
  4047.       (let ((beginning (match-beginning 0))
  4048.         (end (match-end 0))
  4049.         (answer nil))
  4050.         (while (not answer)
  4051.           (message "replace? (y or n)")
  4052.           (evi-hilight-region beginning (1- end))
  4053.           (setq answer (evi-read-char))
  4054.           (if (and (/= answer ?y) (/= answer ?n)
  4055.                (/= answer ?Y) (/= answer ?N))
  4056.           (progn (beep)
  4057.              (setq answer nil))))
  4058.         (or (= answer ?y) (= answer ?Y))))
  4059.       ; need to worry about `magic' here?
  4060.       (replace-match replacement t nil)
  4061.     (goto-char (match-end 0))))
  4062.  
  4063.  
  4064. (defun ex-tag (tag)
  4065.   (if tag
  4066.       (setq ex-tag tag)
  4067.     (or ex-tag
  4068.     (evi-error "No previous tag specified")))
  4069.   (find-tag ex-tag)
  4070.   (evi))
  4071.  
  4072. (defun ex-unabbrev (abbrev)
  4073.   (let ((alist evi-abbrev-list)
  4074.     (alist2 nil))
  4075.     (while alist
  4076.       (if (string= abbrev (car (car alist)))
  4077.       (progn
  4078.         (if alist2
  4079.         (setcdr alist2 (cdr alist))
  4080.           (setq evi-abbrev-list (cdr alist)))
  4081.         (setq alist nil))
  4082.     (setq alist2 alist alist (cdr alist))))))
  4083.  
  4084. (defun ex-unmap (exclam key)
  4085.   (if exclam
  4086.     (evi-define-key '(input-map) key nil)
  4087.     (evi-define-key '(map) key nil)))
  4088.  
  4089. (defun ex-evi-version ()
  4090.   (message evi-version))
  4091.  
  4092. (defun ex-write (addresses exclam append file-arg)
  4093.   (let ((file-name (or file-arg (buffer-file-name))))
  4094.     (cond
  4095.      ((and (not exclam)
  4096.        file-arg
  4097.        (not (equal (expand-file-name file-arg) buffer-file-name))
  4098.        (file-exists-p (expand-file-name file-arg)))
  4099.       (evi-error (format "File exists - use \":write! %s\" to overwrite"
  4100.              file-arg)))
  4101.      ((or exclam file-arg (not evi-buffer-read-only))
  4102.       (save-excursion
  4103.     (ex-define-region addresses t t)
  4104.     (if (and (null file-arg)
  4105.          (= evi-mark (point-min)) (= (point) (point-max)))
  4106.         (progn
  4107.                     ; force a write, even if not modified
  4108.           (set-buffer-modified-p t)
  4109.           (basic-save-buffer))
  4110.       (write-region evi-mark (point) file-name append))))
  4111.      (t
  4112.       (evi-error "File read-only (use :write! to attempt override)")))))
  4113.  
  4114. (defun ex-write-all-buffers (quietly)
  4115.   (save-some-buffers quietly))
  4116.  
  4117. (defun ex-write-kill ()
  4118.   (set-buffer-modified-p t)
  4119.   (basic-save-buffer)
  4120.   (ex-kill-buffer nil nil))
  4121.  
  4122. (defun ex-write-quit (discard)
  4123.   (set-buffer-modified-p t)
  4124.   (basic-save-buffer)
  4125.   (ex-quit discard))
  4126.  
  4127. (defun ex-write-all-and-quit (quietly)
  4128.   (save-some-buffers quietly t)
  4129.   (kill-emacs))
  4130.  
  4131. (defun ex-yank (addresses register-struct)
  4132.   (let ((evi-register-spec register-struct))
  4133.     (save-excursion
  4134.       (ex-define-region addresses t nil)
  4135.       (evi-copy-region-to-registers nil))))
  4136.  
  4137. (defun ex-shell-command (addresses background shell-command)
  4138.   (if (string= shell-command "!")
  4139.       (setq shell-command
  4140.     (or evi-last-shell-command
  4141.         (evi-error "No previous shell command to substitute for !")))
  4142.     (setq evi-last-shell-command shell-command))
  4143.   (if background
  4144.       (progn
  4145.     (switch-to-buffer-other-window
  4146.       (get-buffer-create "*Shell Command Output*"))
  4147.     (evi)
  4148.     (erase-buffer)
  4149.     (start-process (concat "\"" shell-command "\"")
  4150.                "*Shell Command Output*" "sh" "-c" shell-command)
  4151.     (select-window (previous-window)))
  4152.     (if (null (car (car (car addresses))))
  4153.     (progn
  4154.       (save-excursion
  4155.         (set-buffer (get-buffer-create "*Shell Command Output*"))
  4156.         (evi))
  4157.       (evi-display-and-prompt 'shell-command (list shell-command)))
  4158.       (progn (ex-define-region addresses t nil)
  4159.          (shell-command-on-region evi-mark (point) shell-command t)))))
  4160.  
  4161. (defun ex-shift-right (addresses)
  4162.   (ex-define-region addresses t nil)
  4163.   (indent-rigidly evi-mark (point) evi-shift-width)
  4164.   (forward-line -1)
  4165.   (skip-chars-forward " \t"))
  4166.  
  4167. (defun ex-shift-left (addresses)
  4168.   (ex-define-region addresses t nil)
  4169.   (indent-rigidly evi-mark (point) (- evi-shift-width))
  4170.   (forward-line -1)
  4171.   (skip-chars-forward " \t"))
  4172.  
  4173. (defun ex-null (addresses)
  4174.   (ex-define-region addresses t nil)
  4175.   (forward-line -1))
  4176.  
  4177. (defvar evi-evi-list "evi-list@brandx.rain.com"
  4178.   "Address of site maintaining mailing list for Evi.")
  4179.  
  4180. (defvar evi-bug-address "jlewis@cse.ogi.edu"
  4181.   "Address of who maintains evi.")
  4182.  
  4183. (defun ex-mail (to)
  4184.   (mail nil to)
  4185.   (evi)
  4186.   (message "Type `:send' to send message.  Type `:kill' to abort.")
  4187.   (evi-insert))
  4188.  
  4189. (defun ex-mail-list (subject)
  4190.   (mail nil evi-evi-list subject)
  4191.   (evi)
  4192.   (goto-char (point-max))
  4193.   (insert "Using " evi-version " (" (emacs-version) ").\n\n")
  4194.   (message "Type `:send' to send message.  Type `:kill' to abort.")
  4195.   (evi-insert))
  4196.  
  4197. (defun ex-report-bug (subject)
  4198.   (mail nil evi-bug-address subject)
  4199.   (evi)
  4200.   (goto-char (point-max))
  4201.   (insert "In " evi-version " (" (emacs-version) ")\n\n")
  4202.   (message "Type `:send' to send bug report.  Type `:kill' to abort.")
  4203.   (evi-insert))
  4204.  
  4205. (defun ex-send-mail (exclam)
  4206.   (mail-send)
  4207.   (if exclam
  4208.       (ex-kill-buffer t nil)))
  4209.  
  4210.  
  4211. (provide 'evi)
  4212.