]> code.delx.au - gnu-emacs/blob - lisp/emulation/viper.el
(bookmark-bmenu-2-window): go to correct position as well as
[gnu-emacs] / lisp / emulation / viper.el
1 ;;; viper.el --- A full-featured Vi emulator for GNU Emacs 19 and XEmacs 19,
2 ;; a VI Plan for Emacs Rescue,
3 ;; and a venomous VI PERil.
4 ;; Viper Is also a Package for Emacs Rebels.
5
6 ;; Version: 2.72
7 ;; Keywords: emulations
8 ;; Author: Michael Kifer <kifer@cs.sunysb.edu>
9
10 ;; LCD Archive Entry:
11 ;; viper|Michael Kifer|kifer@cs.sunysb.edu|
12 ;; A full-featured Vi emulator for GNU Emacs 19 and XEmacs 19|
13 ;; 19-February-95|2.72|~/modes/viper.tar.Z|
14
15 (defconst viper-version "2.72 of February 19, 1995"
16 "The current version of Viper")
17
18 ;; This file is part of GNU Emacs.
19
20 ;; GNU Emacs is free software; you can redistribute it and/or modify
21 ;; it under the terms of the GNU General Public License as published by
22 ;; the Free Software Foundation; either version 2, or (at your option)
23 ;; any later version.
24
25 ;; GNU Emacs is distributed in the hope that it will be useful,
26 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
27 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
28 ;; GNU General Public License for more details.
29
30 ;; You should have received a copy of the GNU General Public License
31 ;; along with GNU Emacs; see the file COPYING. If not, write to
32 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
33
34 ;;; Commentary:
35
36 ;; Viper is a full-featured Vi emulator for Emacs 19. It emulates and
37 ;; improves upon the standard features of Vi and, at the same time, allows
38 ;; full access to all Emacs facilities. Viper supports multiple undo,
39 ;; file name completion, command, file, and search history and it extends
40 ;; Vi in many other ways. Viper is highly customizable through the various
41 ;; hooks, user variables, and keymaps. It is implemented as a collection
42 ;; of minor modes and it is designed to provide full access to all Emacs
43 ;; major and minor modes.
44 ;;
45 ;;; History
46 ;;
47 ;; Viper is a new name for a package formerly known as VIP-19,
48 ;; which was a successor of VIP version 3.5 by Masahiko Sato
49 ;; <ms@sail.stanford.edu> and VIP version 4.2 by Aamod Sane
50 ;; <sane@cs.uiuc.edu>. Some ideas from vip 4.4.2 by Aamod Sane
51 ;; were also shamelessly plagiarized.
52 ;;
53 ;; Viper maintains some degree of compatibility with these older
54 ;; packages. See the documentation for customization.
55 ;;
56 ;; The main difference between Viper and these older packages are:
57 ;;
58 ;; 1. Viper emulates Vi at several levels, from almost complete conformity
59 ;; to a rather loose Vi-compliance.
60 ;;
61 ;; 2. Viper provides full access to all major and minor modes of Emacs
62 ;; without the need to type extra keys.
63 ;; The older versions of VIP (and other Vi emulators) do not work with
64 ;; some major and minor modes.
65 ;;
66 ;; 3. Viper supports vi-style undo.
67 ;;
68 ;; 4. Viper fully emulates (and improves upon) vi's replacement mode.
69 ;;
70 ;; 5. Viper has a better interface to ex, including command, variable, and
71 ;; file name completion.
72 ;;
73 ;; 6. Viper uses native Emacs history and completion features; it doesn't
74 ;; rely on other packages (such as gmhist.el and completer.el) to provide
75 ;; these features.
76 ;;
77 ;; 7. Viper supports Vi-style editing in the minibuffer, by allowing the
78 ;; user to switch from Insert state to Vi state to Replace state, etc.
79 ;;
80 ;; 8. Viper keeps history of recently inserted pieces of text and recently
81 ;; executed Vi-style destructive commands, such as `i', `d', etc.
82 ;; These pieces of text can be inserted in later insertion commands;
83 ;; the previous destructive commands can be re-executed.
84 ;;
85 ;; 9. Viper has Vi-style keyboard macros, which enhances the similar
86 ;; facility in the original Vi.
87 ;; First, one can execute any Emacs command while defining a
88 ;; macro, not just the Vi commands. Second, macros are defined in a
89 ;; WYSYWYG mode, using an interface to Emacs' WYSIWYG style of defining
90 ;; macros. Third, in Viper, one can define macros that are specific to
91 ;; a given buffer, a given major mode, or macros defined for all buffers.
92 ;; The same macro name can have several different definitions:
93 ;; one global, several definitions for various major modes, and
94 ;; definitions for specific buffers.
95 ;; Bffer-specific definitions override mode-specific
96 ;; definitions, which, in turn, override global definitions.
97 ;;
98 ;;
99 ;;; Installation:
100 ;; -------------
101 ;;
102 ;; (require 'viper)
103 ;;
104
105 ;;; Acknowledgements:
106 ;; -----------------
107 ;; Bug reports and ideas contributed by the following users
108 ;; have helped improve Viper and the various versions of VIP:
109 ;;
110 ;; jjm@hplb.hpl.hp.com (Jean-Jacques Moreau), jl@cse.ogi.edu (John
111 ;; Launchbury), rxga@ulysses.att.com, jamesm@bga.com (D.J. Miller II),
112 ;; ascott@fws214.intel.com (Andy Scott), toma@convex.convex.com,
113 ;; gvr@cs.brown.edu, dave@hellgate.utah.edu, cook@biostat.wisc.edu
114 ;; (Tom Cook), lindstro@biostat.wisc.edu (Mary Lindstrom),
115 ;; edmonds@edmonds.home.cs.ubc.ca (Brian Edmonds), mveiga@dit.upm.es
116 ;; (Marcelino Veiga Tuimil), dwight@toolucky.llnl.gov (Dwight Shih),
117 ;; phil_brooks@MENTORG.COM (Phil Brooks), kin@isi.com (Kin Cho),
118 ;; ahg@panix.com (Al Gelders), dwallach@cs.princeton.edu (Dan Wallach),
119 ;; hpz@ibmhpz.aug.ipp-garching.mpg.de (Hans-Peter Zehrfeld),
120 ;; simonb@prl.philips.co.uk (Simon Blanchard), Mark.Bordas@East.Sun.COM
121 ;; (Mark Bordas), gviswana@cs.wisc.edu (Guhan Viswanathan)
122 ;;
123 ;; Special thanks to Marcelino Veiga Tuimil <mveiga@dit.upm.es> for
124 ;; suggesting a way of intercepting ESC sequences on dumb terminals. Due to
125 ;; this, Viper can now handle arrow keys, F-keys, etc., in Xterm windows
126 ;; and on dumb terminals. This also made it possible to implement Vi-style
127 ;; timeout macros.
128 ;;
129 ;;
130 ;;; Notes:
131 ;;
132 ;; 1. Major modes.
133 ;; In most cases, Viper handles major modes correctly, i.e., they come up
134 ;; in the right state (either vi-state or emacs-state). For instance, text
135 ;; files come up in vi-state, while, say, Dired appears in emacs-state by
136 ;; default.
137 ;; However, some modes do not appear in the right mode in the beginning,
138 ;; usually because they neglect to follow Emacs conventions (e.g., they don't
139 ;; use (kill-all-local-variables) when they start. Some major modes
140 ;; may fail to come up in emacs-state if they call hooks, such as
141 ;; text-hook, for no good reason.
142 ;;
143 ;; As an immediate solution, you can hit C-z to bring about the right mode.
144 ;; An interim solution is to add an appropriate hook to the mode like this:
145 ;;
146 ;; (add-hook 'your-favorite-mode 'viper-mode)
147 ;; or
148 ;; (add-hook 'your-favorite-mode 'vip-change-state-to-emacs)
149 ;;
150 ;; whichever applies. The right thing to do, however, is to complain to the
151 ;; author of the respective package. (Sometimes they also neglect to equip
152 ;; their modes with hooks, which is one more reason for complaining.)
153 ;;
154 ;; 2. Keymap handling
155 ;; Because Emacs 19 has an elegant mechanism for turning minor mode keymaps
156 ;; on and off, implementation of Viper has been greatly simplified. Viper
157 ;; has several minor modes.
158 ;;
159 ;; Viper's Vi state consists of seven minor modes:
160 ;;
161 ;; vip-vi-intercept-minor-mode
162 ;; vip-vi-local-user-minor-mode
163 ;; vip-vi-global-user-minor-mode
164 ;; vip-vi-kbd-minor-mode
165 ;; vip-vi-state-modifier-minor-mode
166 ;; vip-vi-diehard-minor-mode
167 ;; vip-vi-basic-minor-mode
168 ;;
169 ;; Bindings done to the keymap of the first mode overshadow those done to
170 ;; the second, which, in turn, overshadows those done to the third, etc.
171 ;;
172 ;; The last vip-vi-basic-minor-mode contains most of the usual Vi bindings
173 ;; in its edit mode. This mode provides access to all Emacs facilities.
174 ;; Novice users, however, may want to set their vip-expert-level to 1
175 ;; in their .vip file. This will enable vip-vi-diehard-minor-mode. This
176 ;; minor mode's bindings make Viper simulate the usual Vi very closely.
177 ;; For instance, C-c will not have its standard Emacs binding
178 ;; and so many of the goodies of Emacs are not available.
179 ;;
180 ;; An skilled user, should set vip-expert-level to at least 3. This will
181 ;; enable ;; C-c and many Emacs facilities will become available.
182 ;; In this case, vip-vi-diehard-minor-mode is inactive.
183 ;;
184 ;; Viper gurus should have at least
185 ;; (setq vip-expert-level 4)
186 ;; in their ~/.vip files. This will unsuppress all Emacs keys that are not
187 ;; essential for VI-style editing.
188 ;; Pick-and-choose users may want to put
189 ;; (setq vip-expert-level 5)
190 ;; in ~/.vip. Viper will then leave it up to the user to set the variables
191 ;; vip-want-* See vip-set-expert-level for details.
192 ;;
193 ;; The very first minor mode, vip-vi-intercept-minor-mode, is of no
194 ;; concern for the user. It is needed to bind Viper's vital keys, such as
195 ;; ESC and C-z.
196 ;;
197 ;; The second mode, vip-vi-local-user-minor-mode, usually has an
198 ;; empty keymap. However, the user can set bindings in this keymap, which
199 ;; will overshadow the corresponding bindings in the other two minor
200 ;; modes. This is useful, for example, for setting up ZZ in gnus,
201 ;; rmail, mh-e, etc., to send message instead of saving it in a file.
202 ;; Likewise, in Dired mode, you may want to bind ZN and ZP to commands
203 ;; that would visit the next or the previous file in the Dired buffer.
204 ;; Setting local keys is tricky, so don't do it directly. Instead, use
205 ;; vip-add-local-keys function (see its doc).
206 ;;
207 ;; The third minor mode, vip-vi-global-user-minor-mode, is also intended
208 ;; for the users but, unlike vip-vi-local-user-minor-mode, its key
209 ;; bindings are seen in all Viper buffers. This mode keys can be done
210 ;; with define-key command.
211 ;;
212 ;; The fourth minor mode, vip-vi-kbd-minor-mode, is used by keyboard
213 ;; macros. Users are NOT supposed to modify this keymap directly.
214 ;;
215 ;; The fifth mode, vip-vi-state-modifier-minor-mode, can be used to set
216 ;; key bindings that are visible in some major modes but not in others.
217 ;;
218 ;; Users are allowed to modify keymaps that belong to
219 ;; vip-vi-local-user-minor-mode, vip-vi-global-user-minor-mode,
220 ;; and vip-vi-state-modifier-minor-mode only.
221 ;;
222 ;; Viper's Insert state also has seven minor modes:
223 ;;
224 ;; vip-insert-intercept-minor-mode
225 ;; vip-insert-local-user-minor-mode
226 ;; vip-insert-global-user-minor-mode
227 ;; vip-insert-kbd-minor-mode
228 ;; vip-insert-state-modifier-minor-mode
229 ;; vip-insert-diehard-minor-mode
230 ;; vip-insert-basic-minor-mode
231 ;;
232 ;; As with VI's editing modes, the first mode, vip-insert-intercept-minor-mode
233 ;; is used to bind vital keys that are not to be changed by the user.
234 ;;
235 ;; The next mode, vip-insert-local-user-minor-mode, is used to customize
236 ;; bindings in the insert state of Viper. The third mode,
237 ;; vip-insert-global-user-minor-mode is like
238 ;; vip-insert-local-user-minor-mode, except that its bindings are seen in
239 ;; all Viper buffers. As with vip-vi-local-user-minor-mode, its bindings
240 ;; should be done via the function vip-add-local-keys. Bindings for
241 ;; vip-insert-global-user-minor-mode can be set with the define-key command.
242 ;;
243 ;; The next minor mode, vip-insert-kbd-minor-mode,
244 ;; is used for keyboard VI-style macros defined with :map!.
245 ;;
246 ;; The fifth minor mode, vip-insert-state-modifier-minor-mode, is like
247 ;; vip-vi-state-modifier-minor-mode, except that it is used in the Insert
248 ;; state; it can be used to modify keys in a mode-specific fashion.
249 ;;
250 ;; The minor mode vip-insert-diehard-minor-mode is in effect when
251 ;; the user wants a high degree of Vi compatibility (a bad idea, really!).
252 ;; The last minor mode, vip-insert-basic-minor-mode, is always in effect
253 ;; when Viper is in insert state. It binds a small number of keys needed for
254 ;; Viper's operation.
255 ;;
256 ;; Finally, Viper provides minor modes for overriding bindings set by Emacs
257 ;; modes when Viper is in Emacs state:
258 ;;
259 ;; vip-emacs-local-user-minor-mode
260 ;; vip-emacs-global-user-minor-mode
261 ;; vip-emacs-kbd-minor-mode
262 ;; vip-emacs-state-modifier-minor-mode
263 ;;
264 ;; These minor modes are in effect when Viper is in Emacs state. The keymap
265 ;; associated with vip-emacs-global-user-minor-mode,
266 ;; vip-emacs-global-user-map, overrides the global and local keymaps as
267 ;; well as the minor mode keymaps set by other modes. The keymap of
268 ;; vip-emacs-local-user-minor-mode, vip-emacs-local-user-map, overrides
269 ;; everything, but it is used on a per buffer basis.
270 ;; The keymap associated with vip-emacs-state-modifier-minor-mode
271 ;; overrides keys on a per-major-mode basis. The mode
272 ;; vip-emacs-kbd-minor-mode is used to define Vi-style macros in Emacs
273 ;; state.
274 ;;
275 ;; 3. There is also one minor mode that is used when Viper is in its
276 ;; replace-state (used for commands like cw, C, etc.). This mode is
277 ;; called
278 ;;
279 ;; vip-replace-minor-mode
280 ;;
281 ;; and its keymap is vip-replace-map. Replace minor mode is always
282 ;; used in conjunction with the minor modes for insert-state, and its
283 ;; keymap overshadows the keymaps for insert minor modes.
284 ;;
285 ;; 4. Defining buffer-local bindings in Vi and Insert modes.
286 ;; As mentioned before, sometimes, it is convenient to have
287 ;; buffer-specific of mode-specific key bindings in Vi and insert modes.
288 ;; Viper provides a special function, vip-add-local-keys, to do precisely
289 ;; this. For instance, is you need to add couple of mode-specific bindings
290 ;; to Insert mode, you can put
291 ;;
292 ;; (vip-add-local-keys 'insert-state '((key1 . func1) (key2 .func2)))
293 ;;
294 ;; somewhere in a hook of this major mode. If you put something like this
295 ;; in your own elisp function, this will define bindings specific to the
296 ;; buffer that was current at the time of the call to vip-add-local-keys.
297 ;; The only thing to make sure here is that the major mode of this buffer
298 ;; is written according to Emacs conventions, which includes a call to
299 ;; (kill-all-local-variables). See vip-add-local-keys for more details.
300 ;;
301 ;;
302 ;; TO DO (volunteers?):
303 ;;
304 ;; 1. Some of the code that is inherited from VIP-3.5 is rather
305 ;; convoluted. Instead of vip-command-argument, keymaps should bind the
306 ;; actual commands. E.g., "dw" should be bound to a generic command
307 ;; vip-delete that will delete things based on the value of
308 ;; last-command-char. This would greatly simplify the logic and the code.
309 ;;
310 ;; 2. Somebody should venture to write a customization package a la
311 ;; options.el that would allow the user to change values of variables
312 ;; that meet certain specs (e.g., match a regexp) and whose doc string
313 ;; starts with a '*'. Then, the user should be offered to save
314 ;; variables that were changed. This will make user's customization job
315 ;; much easier.
316 ;;
317
318
319 (require 'advice)
320 (require 'cl)
321 (require 'ring)
322
323 (require 'viper-util)
324
325 \f
326 ;;; Variables
327
328 ;; Is t until viper-mode executes for the very first time.
329 ;; Prevents recursive descend into startup messages.
330 (defvar vip-first-time t)
331
332 (defvar vip-expert-level 0
333 "User's expert level.
334 The minor mode vip-vi-diehard-minor-mode is in effect when
335 vip-expert-level is 1 or 2 or when vip-want-emacs-keys-in-vi is t.
336 The minor mode vip-insert-diehard-minor-mode is in effect when
337 vip-expert-level is 1 or 2 or if vip-want-emacs-keys-in-insert is t.
338 Use `M-x vip-set-expert-level' to change this.")
339
340 ;; Max expert level supported by Viper. This is NOT a user option.
341 ;; It is here to make it hard for the user from resetting it.
342 (defconst vip-max-expert-level 5)
343
344 ;; Contains user settings for vars affected by vip-set-expert-level function.
345 ;; Not a user option.
346 (defvar vip-saved-user-settings nil)
347
348
349 ;;; Viper minor modes
350
351 ;; for some reason, this is not local in Emacs, so I made it so.
352 (make-variable-buffer-local 'minor-mode-map-alist)
353
354 ;; Ideally, minor-mode-map-alist should be permanent-local. But Emacs has a
355 ;; bug that precludes that. So, there is a workaround in
356 ;; vip-harness-minor-mode.
357 ;;(put 'minor-mode-map-alist 'permanent-local t)
358
359 ;; Mode for vital things like \e, C-z.
360 (vip-deflocalvar vip-vi-intercept-minor-mode nil)
361
362 (vip-deflocalvar vip-vi-basic-minor-mode nil
363 "Viper's minor mode for Vi bindings.")
364
365 (vip-deflocalvar vip-vi-local-user-minor-mode nil
366 "Auxiliary minor mode for user-defined local bindings in Vi state.")
367
368 (vip-deflocalvar vip-vi-global-user-minor-mode nil
369 "Auxiliary minor mode for user-defined global bindings in Vi state.")
370
371 (vip-deflocalvar vip-vi-state-modifier-minor-mode nil
372 "Minor mode used to make major-mode-specific modification to Vi state.")
373
374 (vip-deflocalvar vip-vi-diehard-minor-mode nil
375 "This minor mode is in effect when the user wants Viper to be Vi.")
376
377 (vip-deflocalvar vip-vi-kbd-minor-mode nil
378 "Minor mode for Ex command macros Vi state.
379 The corresponding keymap stores key bindings of Vi macros defined with
380 the Ex command :map.")
381
382 ;; Mode for vital things like \e, C-z.
383 (vip-deflocalvar vip-insert-intercept-minor-mode nil)
384
385 (vip-deflocalvar vip-insert-basic-minor-mode nil
386 "Viper's minor mode for bindings in Insert mode.")
387
388 (vip-deflocalvar vip-insert-local-user-minor-mode nil
389 "Auxiliary minor mode for buffer-local user-defined bindings in Insert state.
390 This is a way to overshadow normal Insert mode bindings locally to certain
391 designated buffers.")
392
393 (vip-deflocalvar vip-insert-global-user-minor-mode nil
394 "Auxiliary minor mode for global user-defined bindings in Insert state.")
395
396 (vip-deflocalvar vip-insert-state-modifier-minor-mode nil
397 "Minor mode used to make major-mode-specific modification to Insert state.")
398
399 (vip-deflocalvar vip-insert-diehard-minor-mode nil
400 "Minor mode that simulates Vi very closely.
401 Not recommened, except for the novice user.")
402
403 (vip-deflocalvar vip-insert-kbd-minor-mode nil
404 "Minor mode for Ex command macros Insert state.
405 The corresponding keymap stores key bindings of Vi macros defined with
406 the Ex command :map!.")
407
408 (vip-deflocalvar vip-replace-minor-mode nil
409 "Minor mode in effect in replace state (cw, C, and the like commands).")
410
411 ;; Mode for vital things like \C-z and \C-x)
412 ;; This is t, by default. So, any new buffer will have C-z defined as
413 ;; switch to Vi, unless we switched states in this buffer
414 (vip-deflocalvar vip-emacs-intercept-minor-mode t)
415
416 (vip-deflocalvar vip-emacs-local-user-minor-mode t
417 "Minor mode for local user bindings effective in Emacs state.
418 Users can use it to override Emacs bindings when Viper is in its Emacs
419 state.")
420
421 (vip-deflocalvar vip-emacs-global-user-minor-mode t
422 "Minor mode for global user bindings in effect in Emacs state.
423 Users can use it to override Emacs bindings when Viper is in its Emacs
424 state.")
425
426 (vip-deflocalvar vip-emacs-kbd-minor-mode t
427 "Minor mode for Vi style macros in Emacs state.
428 The corresponding keymap stores key bindings of Vi macros defined with
429 `vip-record-kbd-macro' command. There is no Ex-level command to do this
430 interactively.")
431
432 (vip-deflocalvar vip-emacs-state-modifier-minor-mode t
433 "Minor mode used to make major-mode-specific modification to Emacs state.
434 For instance, a Vi purist may want to bind `dd' in Dired mode to a function
435 that deletes a file.")
436
437
438
439 ;;; ISO characters
440
441 (defvar vip-automatic-iso-accents nil
442 "*If non-nil, ISO accents will be turned on in insert/replace emacs states and turned off in vi-state.
443 For some users, this behavior may be too primitive. In this case, use
444 insert/emacs/vi state hooks.")
445
446
447 ;;; Emacs keys in other states.
448
449 (defvar vip-want-emacs-keys-in-insert t
450 "*Set to nil if you want complete Vi compatibility in insert mode.
451 Complete compatibility with Vi is not recommended for power use of Viper.")
452
453 (defvar vip-want-emacs-keys-in-vi t
454 "*Set to nil if you want complete Vi compatibility in Vi mode.
455 Full Vi compatibility is not recommended for power use of Viper.")
456
457
458
459 ;; VI-style Undo
460
461 ;; Used to 'undo' complex commands, such as replace and insert commands.
462 (vip-deflocalvar vip-undo-needs-adjustment nil)
463 (put 'vip-undo-needs-adjustment 'permanent-local t)
464
465 ;; A mark that Viper puts on buffer-undo-list. Marks the beginning of a
466 ;; complex command that must be undone atomically. If inserted, it is
467 ;; erased by vip-change-state-to-vi and vip-repeat.
468 (defconst vip-buffer-undo-list-mark 'viper)
469
470 (defvar vip-keep-point-on-undo nil
471 "*Non-nil means not to move point while undoing commands.
472 This style is different from Emacs and Vi. Try it to see if
473 it better fits your working style.")
474
475 ;; Replace mode and changing text
476
477 ;; Viper's own after/before change functions, which get add-hook'ed to Emacs'
478 (vip-deflocalvar vip-after-change-functions nil "")
479 (vip-deflocalvar vip-before-change-functions nil "")
480 (vip-deflocalvar vip-post-command-hooks nil "")
481 (vip-deflocalvar vip-pre-command-hooks nil "")
482
483 ;; Can be used to pass global states around for short period of time
484 (vip-deflocalvar vip-intermediate-command nil "")
485
486 ;; Indicates that the current destructive command has started in replace mode.
487 (vip-deflocalvar vip-began-as-replace nil "")
488
489 (defvar vip-replace-overlay-cursor-color "Red"
490 "*Color to use in Replace state")
491
492
493 (vip-deflocalvar vip-replace-overlay nil "")
494 (put 'vip-replace-overlay 'permanent-local t)
495
496 (if window-system
497 (progn
498 (make-face 'vip-replace-overlay-face)
499 (or (face-differs-from-default-p 'vip-replace-overlay-face)
500 (progn
501 (if (vip-can-use-colors "darkseagreen2" "Black")
502 (progn
503 (set-face-background
504 'vip-replace-overlay-face "darkseagreen2")
505 (set-face-foreground 'vip-replace-overlay-face "Black")))
506 (set-face-underline-p 'vip-replace-overlay-face t))
507 )))
508
509 (defvar vip-replace-overlay-face 'vip-replace-overlay-face
510 "*Face for highlighting replace regions on a window display.")
511
512 (defvar vip-replace-region-end-symbol
513 (if (and window-system (vip-display-color-p)) "" "$")
514 "*Symbol to mark the end of a replacement region. A string.
515 At present, only the first character of a non-empty string is used to
516 actually mark the region.")
517 (defvar vip-replace-region-start-symbol ""
518 "*Symbol to mark the beginning of a replacement region. A string.
519 Not yet implemented.")
520
521 ;; These are local marker that must be initialized to nil and moved with
522 ;; `vip-move-marker-locally'
523 ;;
524 ;; Remember the last position inside the replace region.
525 (vip-deflocalvar vip-last-posn-in-replace-region nil)
526 ;; Remember the last position while inserting
527 (vip-deflocalvar vip-last-posn-while-in-insert-state nil)
528 (put 'vip-last-posn-in-replace-region 'permanent-local t)
529 (put 'vip-last-posn-while-in-insert-state 'permanent-local t)
530
531 (vip-deflocalvar vip-sitting-in-replace nil "")
532 (put 'vip-sitting-in-replace 'permanent-local t)
533
534 ;; Remember the number of characters that have to be deleted in replace
535 ;; mode to compensate for the inserted characters.
536 (vip-deflocalvar vip-replace-chars-to-delete 0 "")
537 (vip-deflocalvar vip-replace-chars-deleted 0 "")
538
539 ;; Insertion ring and command ring
540 (defvar vip-insertion-ring-size 14
541 "The size of the insertion ring.")
542 ;; The insertion ring.
543 (defvar vip-insertion-ring nil)
544 ;; This is temp insertion ring. Used to do rotation for display purposes.
545 ;; When rotation just started, it is initialized to vip-insertion-ring.
546 (defvar vip-temp-insertion-ring nil)
547 (defvar vip-last-inserted-string-from-insertion-ring "")
548
549 (defvar vip-command-ring-size 14
550 "The size of the command ring.")
551 ;; The command ring.
552 (defvar vip-command-ring nil)
553 ;; This is temp command ring. Used to do rotation for display purposes.
554 ;; When rotation just started, it is initialized to vip-command-ring.
555 (defvar vip-temp-command-ring nil)
556
557 ;; Modes and related variables
558
559 ;; Current mode. One of: `emacs-state', `vi-state', `insert-state'
560 (vip-deflocalvar vip-current-state 'emacs-state)
561
562
563 (defvar vip-toggle-key "\C-z"
564 "The key used to change states from emacs to Vi and back.
565 In insert mode, this key also functions as Meta.
566 Must be set in .vip file or prior to loading Viper.
567 This setting cannot be changed interactively.")
568
569 (defvar vip-ESC-key "\e"
570 "Key used to ESC.
571 Must be set in .vip file or prior to loading Viper.
572 This setting cannot be changed interactively.")
573
574 (defvar vip-no-multiple-ESC t
575 "*If true, multiple ESC in Vi mode will cause bell to ring.
576 \_ is then mapped to Meta.
577 This is set to t on a windowing terminal and to 'twice on a dumb
578 terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this
579 enables cursor keys and is generally more convenient, as terminals usually
580 don't have a convenient Meta key.
581 Setting vip-no-multiple-ESC to nil will allow as many multiple ESC,
582 as is allowed by the major mode in effect.")
583
584
585 (defvar vip-want-ctl-h-help nil
586 "*If t then C-h is bound to help-command in insert mode, if nil then it is
587 bound to delete-backward-char.")
588
589 ;; Autoindent in insert
590
591 ;; Variable that keeps track of whether C-t has been pressed.
592 (vip-deflocalvar vip-cted nil "")
593
594 ;; Preserve the indent value, used by C-d in insert mode.
595 (vip-deflocalvar vip-current-indent 0)
596
597 ;; Whether to preserve the indent, used by C-d in insert mode.
598 (vip-deflocalvar vip-preserve-indent nil)
599
600 (defconst vip-auto-indent nil
601 "*Autoindent if t.")
602
603 (defconst vip-shift-width 8
604 "*The shiftwidth variable.")
605
606 ;; Variables for repeating destructive commands
607
608 (defconst vip-keep-point-on-repeat t
609 "*If t, don't move point when repeating previous command.
610 This is useful for doing repeated changes with the '.' key.
611 The user can change this to nil, if she likes when the cursor moves
612 to a new place after repeating previous Vi command.")
613
614 ;; Remember insert point as a marker. This is a local marker that must be
615 ;; initialized to nil and moved with `vip-move-marker-locally'.
616 (vip-deflocalvar vip-insert-point nil)
617 (put 'vip-insert-point 'permanent-local t)
618
619 ;; This remembers the point before dabbrev-expand was called.
620 ;; If vip-insert-point turns out to be bigger than that, it is reset
621 ;; back to vip-pre-command-point.
622 ;; The reason this is needed is because dabbrev-expand (and possibly
623 ;; others) may jump to before the insertion point, delete something and
624 ;; then reinsert a bigger piece. For instance: bla^blo
625 ;; If dabbrev-expand is called after `blo' and ^ undicates vip-insert-point,
626 ;; then point jumps to the beginning of `blo'. If expansion is found, `blablo'
627 ;; is deleted, and we have |^, where | denotes point. Next, dabbrev-expand
628 ;; will insert the expansion, and we get: blablo^
629 ;; Whatever we insert next goes before the ^, i.e., before the
630 ;; vip-insert-point marker. So, Viper will think that nothing was
631 ;; inserted. Remembering the orig position of the marker circumvents the
632 ;; problem.
633 ;; We don't know of any command, except dabbrev-expand, that has the same
634 ;; problem. However, the same trick can be used if such a command is
635 ;; discovered later.
636 ;;
637 (vip-deflocalvar vip-pre-command-point nil)
638 (put 'vip-pre-command-point 'permanent-local t) ; this is probably an overkill
639
640 ;; This is used for saving inserted text.
641 (defvar vip-last-insertion nil)
642
643 ;; Remembers the last replaced region.
644 (defvar vip-last-replace-region "")
645
646 ;; Remember com point as a marker.
647 ;; This is a local marker. Should be moved with `vip-move-marker-locally'
648 (vip-deflocalvar vip-com-point nil)
649
650 ;; If non-nil, the value is a list (M-COM VAL COM REG inserted-text cmd-keys)
651 ;; It is used to re-execute last destructive command.
652 ;; M-COM is a Lisp symbol representing the function to be executed.
653 ;; VAL is the prefix argument that was used with that command.
654 ;; COM is an internal descriptor, such as ?r, ?c, ?C, which contains
655 ;; additional information on how the function in M-COM is to be handled.
656 ;; REG is the register used by command
657 ;; INSERTED-TEXT is text inserted by that command (in case of o, c, C, i, r
658 ;; commands).
659 ;; COMMAND-KEYS are the keys that were typed to invoke the command.
660 (defvar vip-d-com nil)
661
662 ;; The character remembered by the Vi `r' command.
663 (defvar vip-d-char nil)
664
665 ;; Name of register to store deleted or yanked strings
666 (defvar vip-use-register nil)
667
668
669
670 ;; Variables for Moves and Searches
671
672 ;; For use by `;' command.
673 (defvar vip-f-char nil)
674
675 ;; For use by `.' command.
676 (defvar vip-F-char nil)
677
678 ;; For use by `;' command.
679 (defvar vip-f-forward nil)
680
681 ;; For use by `;' command.
682 (defvar vip-f-offset nil)
683
684 ;; Last search string
685 (defvar vip-s-string "")
686
687 (defvar vip-quote-string "> "
688 "String inserted at the beginning of quoted region.")
689
690 ;; If t, search is forward.
691 (defvar vip-s-forward nil)
692
693 (defconst vip-case-fold-search nil
694 "*If t, search ignores cases.")
695
696 (defconst vip-re-search t
697 "*If t, search is reg-exp search, otherwise vanilla search.")
698
699 (defconst vip-re-query-replace t
700 "*If t then do regexp replace, if nil then do string replace.")
701
702 (defconst vip-re-replace t
703 "*If t, do regexp replace. nil means do string replace.")
704
705 (vip-deflocalvar vip-ex-style-motion t
706 "*Ex-style: the commands l,h do not cross lines, etc.")
707
708 (vip-deflocalvar vip-ex-style-editing-in-insert t
709 "*The keys ^H, ^? don't jump lines in insert, ESC moves cursor back, etc.
710 Note: this doesn't preclude ^H and ^? from deleting characters by moving
711 past the insertion point. This is a feature, not a bug. ")
712
713 (vip-deflocalvar vip-delete-backwards-in-replace nil
714 "*If t, DEL key will delete characters while moving the cursor backwards.
715 If nil, the cursor will move backwards without deleting anything.")
716
717 (defconst vip-buffer-search-char nil
718 "*Key bound for buffer-searching.")
719
720 (defconst vip-search-wrap-around-t t
721 "*If t, search wraps around.")
722
723 (vip-deflocalvar vip-related-files-and-buffers-ring nil
724 "*Ring of file and buffer names that are considered to be related to the
725 current buffer.
726 These buffers can be cycled through via :R and :P commands.")
727 (put 'vip-related-files-and-buffers-ring 'permanent-local t)
728
729 ;; Used to find out if we are done with searching the current buffer.
730 (vip-deflocalvar vip-local-search-start-marker nil)
731 ;; As above, but global
732 (defvar vip-search-start-marker (make-marker))
733
734 ;; the search overlay
735 (vip-deflocalvar vip-search-overlay nil)
736
737
738 (defvar vip-heading-start
739 (concat "^\\s-*(\\s-*defun\\s-\\|" ; lisp
740 "^{\\s-*$\\|^[_a-zA-Z][^()]*[()].*{\\s-*$\\|" ; C/C++
741 "^\\s-*class.*{\\|^\\s-*struct.*{\\|^\\s-*enum.*{\\|"
742 "^\\\\[sb][a-z]*{.*}\\s-*$\\|" ; latex
743 "^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|" ; texinfo
744 "^.+:-") ; prolog
745 "*Regexps for Headings. Used by \[\[ and \]\].")
746
747 (defvar vip-heading-end
748 (concat "^}\\|" ; C/C++
749 "^\\\\end{\\|" ; latex
750 "^@end \\|" ; texinfo
751 ")\n\n[ \t\n]*\\|" ; lisp
752 "\\.\\s-*$") ; prolog
753 "*Regexps to end Headings/Sections. Used by \[\].")
754
755
756 ;; These two vars control the interaction of jumps performed by ' and `.
757 ;; In this new version, '' doesn't erase the marks set by ``, so one can
758 ;; use both kinds of jumps interchangeably and without loosing positions
759 ;; inside the lines.
760
761 ;; Remembers position of the last jump done using ``'.
762 (vip-deflocalvar vip-last-jump nil)
763 ;; Remembers position of the last jump done using `''.
764 (vip-deflocalvar vip-last-jump-ignore 0)
765
766 ;; Some common error messages
767
768 (defconst vip-SpuriousText "Spurious text after command" "")
769 (defconst vip-BadExCommand "Not an editor command" "")
770 (defconst vip-InvalidCommandArgument "Invalid command argument" "")
771 (defconst vip-NoPrevSearch "No previous search string" "")
772 (defconst vip-EmptyRegister "`%c': Nothing in this register" "")
773 (defconst vip-InvalidRegister "`%c': Invalid register" "")
774 (defconst vip-EmptyTextmarker "`%c': Text marker doesn't point anywhere" "")
775 (defconst vip-InvalidTextmarker "`%c': Invalid text marker" "")
776 (defconst vip-InvalidViCommand "Invalid command" "")
777 (defconst vip-BadAddress "Ill-formed address" "")
778 (defconst vip-FirstAddrExceedsSecond "First address exceeds second" "")
779 (defconst vip-NoFileSpecified "No file specified" "")
780
781
782 ;; History variables
783
784 (defvar vip-history nil)
785 ;; History of search strings.
786 (defvar vip-search-history (list ""))
787 ;; History of query-replace strings used as a source.
788 (defvar vip-replace1-history nil)
789 ;; History of query-replace strings used as replacement.
790 (defvar vip-replace2-history nil)
791 ;; History of region quoting strings.
792 (defvar vip-quote-region-history (list vip-quote-string))
793 ;; History of Ex-style commands.
794 (defvar vip-ex-history nil)
795 ;; History of shell commands.
796 (defvar vip-shell-history nil)
797
798
799 ;; Last shell command. There are two of these, one for Ex (in viper-ex)
800 ;; and one for Vi.
801
802 ;; Last shell command executed with ! command.
803 (defvar vip-last-shell-com nil)
804
805
806 \f
807 ;;; Miscellaneous
808
809 ;; setup emacs-supported vi-style feel
810 (setq mark-even-if-inactive t
811 next-line-add-newlines nil
812 require-final-newline t)
813
814 (defvar vip-inhibit-startup-message nil
815 "Whether Viper startup message should be inhibited.")
816
817 (defvar vip-always t
818 "t means, arrange that vi-state will be a default.")
819
820 (defvar vip-custom-file-name "~/.vip"
821 "Viper customisation file.
822 This variable must be set _before_ loading Viper.")
823
824 (defvar vip-info-file-name "viper"
825 "The name prefix for Viper Info files.")
826
827 (defvar vip-spell-function 'ispell-region
828 "Spell function used by #s<move> command to spell.")
829
830 (defvar vip-tags-file-name "TAGS")
831
832 ;; Minibuffer
833
834 (defvar vip-vi-style-in-minibuffer t
835 "If t, use vi-style editing in minibuffer.
836 Should be set in `~/.vip' file.")
837
838 ;; overlay used in the minibuffer to indicate which state it is in
839 (vip-deflocalvar vip-minibuffer-overlay nil)
840
841 ;; Hook, specific to Viper, which is run just *before* exiting the minibuffer.
842 ;; Beginning with Emacs 19.26, the standard `minibuffer-exit-hook' is run
843 ;; *after* exiting the minibuffer
844 (defvar vip-minibuffer-exit-hook nil)
845
846 (vip-deflocalvar vip-vi-minibuffer-minor-mode nil
847 "Minor mode that forces Vi-style when the Minibuffer is in Vi state.")
848 (vip-deflocalvar vip-insert-minibuffer-minor-mode nil
849 "Minor mode that forces Vi-style when the Minibuffer is in Insert state.")
850
851 (vip-deflocalvar vip-add-newline-at-eob t
852 "If t, always add a newline at the end of buffer.
853 Usually, Viper adds a newline character at the end of the last
854 line in a buffer, if it's missing. In some major modes, however, like
855 shell-mode, this is undesirable and must be set to nil. See vip-set-hooks.")
856
857
858 ;; Mode line
859 (defconst vip-vi-state-id "<V> "
860 "Mode line tag identifying the Vi mode of Viper.")
861 (defconst vip-emacs-state-id "<E> "
862 "Mode line tag identifying the Emacs mode of Viper.")
863 (defconst vip-insert-state-id "<I> "
864 "Mode line tag identifying the Insert mode of Viper.")
865 (defconst vip-replace-state-id "<R> "
866 "Mode line tag identifying the Replace mode of Viper.")
867
868 ;; Viper changes the default mode-line-buffer-identification
869 (setq-default mode-line-buffer-identification '(" %b"))
870
871 ;; Variable displaying the current Viper state in the mode line.
872 (vip-deflocalvar vip-mode-string vip-emacs-state-id)
873 (or (memq 'vip-mode-string global-mode-string)
874 (setq global-mode-string
875 (append '("" vip-mode-string) (cdr global-mode-string))))
876
877
878 (defvar vip-vi-state-hooks nil
879 "*Hooks run just before the switch to Vi mode is completed.")
880 (defvar vip-insert-state-hooks nil
881 "*Hooks run just before the switch to Insert mode is completed.")
882 (defvar vip-replace-state-hooks nil
883 "*Hooks run just before the switch to Replace mode is completed.")
884 (defvar vip-emacs-state-hooks nil
885 "*Hooks run just before the switch to Emacs mode is completed.")
886
887 (defvar vip-load-hooks nil
888 "Hooks run just after loading Viper.")
889
890
891 ;; Generic predicates
892
893 ;; These test functions are shamelessly lifted from vip 4.4.2 by Aamod Sane
894
895 ;; generate test functions
896 ;; given symbol foo, foo-p is the test function, foos is the set of
897 ;; Viper command keys
898 ;; (macroexpand '(vip-test-com-defun foo))
899 ;; (defun foo-p (com) (consp (memq (if (< com 0) (- com) com) foos)))
900
901 (defmacro vip-test-com-defun (name)
902 (let* (;;(snm (make-symbol "s1"))
903 (snm (symbol-name name))
904 ;;(nm-p (make-symbol "s2"))
905 (nm-p (intern (concat snm "-p")))
906 ;;(nms (make-symbol "s3"))
907 (nms (intern (concat snm "s"))))
908 (` (defun (, nm-p) (com)
909 (consp (memq (if (< com 0) (- com) com) (, nms)))))))
910
911 ;; Variables for defining VI commands
912
913 (defconst vip-prefix-commands '(?c ?d ?y ?! ?= ?# ?< ?> ?\")
914 "Modifying commands that can be prefixes to movement commands")
915 (vip-test-com-defun vip-prefix-command)
916
917 (defconst vip-charpair-commands '(?c ?d ?y ?! ?= ?< ?> ?r ?R)
918 "Commands that are pairs eg. dd. r and R here are a hack")
919 (vip-test-com-defun vip-charpair-command)
920
921 (defconst vip-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?H ?j ?k ?l
922 ?H ?M ?n ?t ?T ?w ?W ?$ ?%
923 ?^ ?( ?) ?- ?+ ?| ?{ ?} ?[ ?] ?' ?`
924 ?; ?, ?0 ?? ?/
925 )
926 "Movement commands")
927 (vip-test-com-defun vip-movement-command)
928
929 (defconst vip-dotable-commands '(?c ?d ?C ?D ?> ?<)
930 "Commands that can be repeated by .(dotted)")
931 (vip-test-com-defun vip-dotable-command)
932
933 (defconst vip-hash-cmds '(?c ?C ?g ?q ?S)
934 "Commands that can follow a #")
935 (vip-test-com-defun vip-hash-cmd)
936
937 (defconst vip-regsuffix-commands '(?d ?y ?Y ?D ?p ?P ?x ?X)
938 "Commands that may have registers as prefix")
939 (vip-test-com-defun vip-regsuffix-command)
940
941
942 \f
943 ;;; Arrange the keymaps
944 (require 'viper-keym)
945
946 \f
947 ;;;; CODE
948
949 ;; changing mode
950
951 ;; Change state to NEW-STATE---either emacs-state, vi-state, or insert-state.
952 (defun vip-change-state (new-state)
953 ;; keep them always fresh
954 (add-hook 'post-command-hook 'vip-post-command-sentinel t)
955 (add-hook 'pre-command-hook 'vip-pre-command-sentinel t)
956 ;; These hooks will be added back if switching to insert/replace mode
957 (remove-hook 'vip-post-command-hooks
958 'vip-insert-state-post-command-sentinel)
959 (remove-hook 'vip-pre-command-hooks
960 'vip-insert-state-pre-command-sentinel)
961 (cond ((eq new-state 'vi-state)
962 (cond ((member vip-current-state '(insert-state replace-state))
963
964 ;; move vip-last-posn-while-in-insert-state
965 ;; This is a normal hook that is executed in insert/replace
966 ;; states after each command. In Vi/Emacs state, it does
967 ;; nothing. We need to execute it here to make sure that
968 ;; the last posn was recorded when we hit ESC.
969 ;; It may be left unrecorded if the last thing done in
970 ;; insert/repl state was dabbrev-expansion or abbrev
971 ;; expansion caused by hitting ESC
972 (vip-insert-state-post-command-sentinel)
973
974 (condition-case conds
975 (progn
976 (vip-save-last-insertion
977 vip-insert-point
978 vip-last-posn-while-in-insert-state)
979 (if vip-began-as-replace
980 (setq vip-began-as-replace nil)
981 ;; repeat insert commands if numerical arg > 1
982 (save-excursion
983 (vip-repeat-insert-command))))
984 (error
985 (vip-message-conditions conds)))
986
987 (if (> (length vip-last-insertion) 0)
988 (vip-push-onto-ring vip-last-insertion
989 'vip-insertion-ring))
990
991 (if vip-ex-style-editing-in-insert
992 (or (bolp) (backward-char 1))))
993 ))
994
995 ;; insert or replace
996 ((memq new-state '(insert-state replace-state))
997 (if (memq vip-current-state '(emacs-state vi-state))
998 (vip-move-marker-locally 'vip-insert-point (point)))
999 (vip-move-marker-locally 'vip-last-posn-while-in-insert-state (point))
1000 (add-hook 'vip-post-command-hooks
1001 'vip-insert-state-post-command-sentinel t)
1002 (add-hook 'vip-pre-command-hooks
1003 'vip-insert-state-pre-command-sentinel t)
1004 )
1005 ) ; outermost cond
1006
1007 ;; Nothing needs to be done to switch to emacs mode! Just set some
1008 ;; variables, which is done in vip-change-state-to-emacs!
1009
1010 (setq vip-current-state new-state)
1011 (vip-normalize-minor-mode-map-alist)
1012 (vip-adjust-keys-for new-state)
1013 (vip-set-mode-vars-for new-state)
1014 (vip-refresh-mode-line)
1015 )
1016
1017
1018
1019 (defun vip-adjust-keys-for (state)
1020 "Make necessary adjustments to keymaps before entering STATE."
1021 (cond ((memq state '(insert-state replace-state))
1022 (if vip-auto-indent
1023 (progn
1024 (define-key vip-insert-basic-map "\C-m" 'vip-autoindent)
1025 (if vip-want-emacs-keys-in-insert
1026 ;; expert
1027 (define-key vip-insert-basic-map "\C-j" nil)
1028 ;; novice
1029 (define-key vip-insert-basic-map "\C-j" 'vip-autoindent))))
1030
1031 (setq vip-insert-diehard-minor-mode
1032 (not vip-want-emacs-keys-in-insert))
1033
1034 (if vip-want-ctl-h-help
1035 (progn
1036 (define-key vip-insert-basic-map "\C-h" 'help-command)
1037 (define-key vip-replace-map "\C-h" 'help-command))
1038 (define-key vip-insert-basic-map
1039 "\C-h" 'vip-del-backward-char-in-insert)
1040 (define-key vip-replace-map
1041 "\C-h" 'vip-del-backward-char-in-replace)))
1042
1043 (t
1044 (setq vip-vi-diehard-minor-mode (not vip-want-emacs-keys-in-vi))
1045 (if vip-want-ctl-h-help
1046 (define-key vip-vi-basic-map "\C-h" 'help-command)
1047 (define-key vip-vi-basic-map "\C-h" 'vip-backward-char)))
1048 ))
1049
1050
1051 (defun vip-normalize-minor-mode-map-alist ()
1052 "Normalizes minor-mode-map-alist by putting Viper keymaps first.
1053 This ensures that Viper bindings are in effect, regardless of which minor
1054 modes were turned on by the user or by other packages."
1055 (setq minor-mode-map-alist
1056 (vip-append-filter-alist
1057 (list
1058 (cons 'vip-vi-intercept-minor-mode vip-vi-intercept-map)
1059 (cons 'vip-vi-minibuffer-minor-mode vip-minibuffer-map)
1060 (cons 'vip-vi-local-user-minor-mode vip-vi-local-user-map)
1061 (cons 'vip-vi-kbd-minor-mode vip-vi-kbd-map)
1062 (cons 'vip-vi-global-user-minor-mode vip-vi-global-user-map)
1063 (cons 'vip-vi-state-modifier-minor-mode
1064 (if (keymapp
1065 (cdr (assoc major-mode vip-vi-state-modifier-alist)))
1066 (cdr (assoc major-mode vip-vi-state-modifier-alist))
1067 vip-empty-keymap))
1068 (cons 'vip-vi-diehard-minor-mode vip-vi-diehard-map)
1069 (cons 'vip-vi-basic-minor-mode vip-vi-basic-map)
1070 (cons 'vip-insert-intercept-minor-mode vip-insert-intercept-map)
1071 (cons 'vip-replace-minor-mode vip-replace-map)
1072 ;; vip-insert-minibuffer-minor-mode must come after
1073 ;; vip-replace-minor-mode
1074 (cons 'vip-insert-minibuffer-minor-mode
1075 vip-minibuffer-map)
1076 (cons 'vip-insert-local-user-minor-mode
1077 vip-insert-local-user-map)
1078 (cons 'vip-insert-kbd-minor-mode vip-insert-kbd-map)
1079 (cons 'vip-insert-global-user-minor-mode
1080 vip-insert-global-user-map)
1081 (cons 'vip-insert-state-modifier-minor-mode
1082 (if (keymapp
1083 (cdr
1084 (assoc major-mode vip-insert-state-modifier-alist)))
1085 (cdr
1086 (assoc major-mode vip-insert-state-modifier-alist))
1087 vip-empty-keymap))
1088 (cons 'vip-insert-diehard-minor-mode vip-insert-diehard-map)
1089 (cons 'vip-insert-basic-minor-mode vip-insert-basic-map)
1090 (cons 'vip-emacs-intercept-minor-mode
1091 vip-emacs-intercept-map)
1092 (cons 'vip-emacs-local-user-minor-mode
1093 vip-emacs-local-user-map)
1094 (cons 'vip-emacs-kbd-minor-mode vip-emacs-kbd-map)
1095 (cons 'vip-emacs-global-user-minor-mode
1096 vip-emacs-global-user-map)
1097 (cons 'vip-emacs-state-modifier-minor-mode
1098 (if (keymapp
1099 (cdr
1100 (assoc major-mode vip-emacs-state-modifier-alist)))
1101 (cdr
1102 (assoc major-mode vip-emacs-state-modifier-alist))
1103 vip-empty-keymap))
1104 )
1105 minor-mode-map-alist)))
1106
1107
1108
1109
1110 \f
1111 ;; Viper mode-changing commands and utilities
1112
1113 (defun vip-refresh-mode-line ()
1114 "Modifies mode-line-buffer-identification."
1115 (setq vip-mode-string
1116 (cond ((eq vip-current-state 'emacs-state) vip-emacs-state-id)
1117 ((eq vip-current-state 'vi-state) vip-vi-state-id)
1118 ((eq vip-current-state 'replace-state) vip-replace-state-id)
1119 ((eq vip-current-state 'insert-state) vip-insert-state-id)))
1120
1121 ;; Sets Viper mode string in global-mode-string
1122 (force-mode-line-update))
1123
1124 ;;;###autoload
1125 (defun viper-mode ()
1126 "Turn on Viper emulation of Vi."
1127 (interactive)
1128 (if (not noninteractive)
1129 (progn
1130 (if vip-first-time ; This check is important. Without it, startup and
1131 (progn ; expert-level msgs mix up when viper-mode recurses
1132 (setq vip-first-time nil)
1133 (if (not vip-inhibit-startup-message)
1134 (save-window-excursion
1135 (setq vip-inhibit-startup-message t)
1136 (delete-other-windows)
1137 (switch-to-buffer "Viper Startup Message")
1138 (erase-buffer)
1139 (insert
1140 (substitute-command-keys
1141 "Viper Is a Package for Emacs Rebels.
1142 It is also a VI Plan for Emacs Rescue and a venomous VI PERil.
1143
1144 Technically speaking, Viper is a Vi emulation package for GNU Emacs 19 and
1145 XEmacs 19. It supports virtually all of Vi and Ex functionality, extending
1146 and improving upon much of it.
1147
1148 1. Viper supports Vi at several levels. Level 1 is the closest to
1149 Vi, level 5 provides the most flexibility to depart from many Vi
1150 conventions.
1151
1152 You will be asked to specify your user level in a following screen.
1153
1154 If you select user level 1 then the keys ^X, ^C, ^Z, and ^G will
1155 behave as in VI, to smooth transition to Viper for the beginners.
1156 However, to use Emacs productively, you are advised to reach user
1157 level 3 or higher.
1158
1159 If your user level is 2 or higher, ^X and ^C will invoke Emacs
1160 functions,as usual in Emacs; ^Z will toggle vi/emacs modes, and
1161 ^G will be the usual Emacs's keyboard-quit (something like ^C in VI).
1162
1163 2. Vi exit functions (e.g., :wq, ZZ) work on INDIVIDUAL files -- they
1164 do not cause Emacs to quit, except at user level 1 (a novice).
1165 3. ^X^C EXITS EMACS.
1166 4. Viper supports multiple undo: `u' will undo. Typing `.' will repeat
1167 undo. Another `u' changes direction.
1168
1169 6. Emacs Meta functions are invoked by typing `_' or `\\ ESC'.
1170 On a window system, the best way is to use the Meta-key.
1171 7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly,
1172 if something funny happens. This would abort the current editing
1173 command.
1174
1175 You can get more information on Viper by:
1176
1177 a. Typing `:help' in Vi state
1178 b. Printing Viper manual, found in ./etc/viper.dvi
1179 c. Printing ViperCard, the Quick Reference, found in ./etc/viperCard.dvi
1180
1181 This startup message appears whenever you load Viper, unless you type `y' now."
1182 ))
1183 (goto-char (point-min))
1184 (if (y-or-n-p "Inhibit Viper startup message? ")
1185 (vip-save-setting
1186 'vip-inhibit-startup-message
1187 "Viper startup message inhibited"
1188 vip-custom-file-name t))
1189 (kill-buffer (current-buffer))))
1190 (message " ")
1191 (vip-set-expert-level 'dont-change-unless)))
1192 (vip-change-state-to-vi))))
1193
1194 ;;;###autoload
1195 (defalias 'vip-mode 'viper-mode)
1196
1197
1198 (defun vip-exit-insert-state ()
1199 "Switch from Insert state to Vi state."
1200 (interactive)
1201 (vip-change-state-to-vi))
1202
1203 (defun vip-set-mode-vars-for (state)
1204 "Sets Viper minor mode variables to put Viper's state STATE in effect."
1205
1206 ;; Emacs state
1207 (setq vip-vi-minibuffer-minor-mode nil
1208 vip-insert-minibuffer-minor-mode nil
1209 vip-vi-intercept-minor-mode nil
1210 vip-insert-intercept-minor-mode nil
1211
1212 vip-vi-local-user-minor-mode nil
1213 vip-vi-kbd-minor-mode nil
1214 vip-vi-global-user-minor-mode nil
1215 vip-vi-state-modifier-minor-mode nil
1216 vip-vi-diehard-minor-mode nil
1217 vip-vi-basic-minor-mode nil
1218
1219 vip-replace-minor-mode nil
1220
1221 vip-insert-local-user-minor-mode nil
1222 vip-insert-kbd-minor-mode nil
1223 vip-insert-global-user-minor-mode nil
1224 vip-insert-state-modifier-minor-mode nil
1225 vip-insert-diehard-minor-mode nil
1226 vip-insert-basic-minor-mode nil
1227 vip-emacs-intercept-minor-mode t
1228 vip-emacs-local-user-minor-mode t
1229 vip-emacs-kbd-minor-mode (not (vip-is-in-minibuffer))
1230 vip-emacs-global-user-minor-mode t
1231 vip-emacs-state-modifier-minor-mode t
1232 )
1233
1234 ;; Vi state
1235 (if (eq state 'vi-state) ; adjust for vi-state
1236 (setq
1237 vip-vi-intercept-minor-mode t
1238 vip-vi-minibuffer-minor-mode (vip-is-in-minibuffer)
1239 vip-vi-local-user-minor-mode t
1240 vip-vi-kbd-minor-mode (not (vip-is-in-minibuffer))
1241 vip-vi-global-user-minor-mode t
1242 vip-vi-state-modifier-minor-mode t
1243 ;; don't let the diehard keymap block command completion
1244 ;; and other things in the minibuffer
1245 vip-vi-diehard-minor-mode (not
1246 (or vip-want-emacs-keys-in-vi
1247 (vip-is-in-minibuffer)))
1248 vip-vi-basic-minor-mode t
1249 vip-emacs-intercept-minor-mode nil
1250 vip-emacs-local-user-minor-mode nil
1251 vip-emacs-kbd-minor-mode nil
1252 vip-emacs-global-user-minor-mode nil
1253 vip-emacs-state-modifier-minor-mode nil
1254 ))
1255
1256 ;; Insert and Replace states
1257 (if (member state '(insert-state replace-state))
1258 (setq
1259 vip-insert-intercept-minor-mode t
1260 vip-replace-minor-mode (eq state 'replace-state)
1261 vip-insert-minibuffer-minor-mode (vip-is-in-minibuffer)
1262 vip-insert-local-user-minor-mode t
1263 vip-insert-kbd-minor-mode (not (vip-is-in-minibuffer))
1264 vip-insert-global-user-minor-mode t
1265 vip-insert-state-modifier-minor-mode t
1266 ;; don't let the diehard keymap block command completion
1267 ;; and other things in the minibuffer
1268 vip-insert-diehard-minor-mode (not
1269 (or vip-want-emacs-keys-in-insert
1270 (vip-is-in-minibuffer)))
1271 vip-insert-basic-minor-mode t
1272 vip-emacs-intercept-minor-mode nil
1273 vip-emacs-local-user-minor-mode nil
1274 vip-emacs-kbd-minor-mode nil
1275 vip-emacs-global-user-minor-mode nil
1276 vip-emacs-state-modifier-minor-mode nil
1277 ))
1278
1279 ;; minibuffer faces
1280 (if window-system
1281 (setq vip-minibuffer-current-face
1282 (cond ((eq state 'emacs-state) vip-minibuffer-emacs-face)
1283 ((eq state 'vi-state) vip-minibuffer-vi-face)
1284 ((memq state '(insert-state replace-state))
1285 vip-minibuffer-insert-face))))
1286
1287 (if (vip-is-in-minibuffer)
1288 (vip-set-minibuffer-overlay))
1289 )
1290
1291 ;; This also takes care of the annoying incomplete lines in files.
1292 ;; Also, this fixed 'undo' to work vi-style for complex commands.
1293 (defun vip-change-state-to-vi ()
1294 "Change Viper state to Vi."
1295 (interactive)
1296 (if (and vip-first-time (not (vip-is-in-minibuffer)))
1297 (viper-mode)
1298 (if overwrite-mode (overwrite-mode nil))
1299 (if abbrev-mode (expand-abbrev))
1300 (if (and auto-fill-function (> (current-column) fill-column))
1301 (funcall auto-fill-function))
1302 (vip-add-newline-at-eob-if-necessary)
1303 (if vip-undo-needs-adjustment (vip-adjust-undo))
1304 (vip-change-state 'vi-state)
1305 (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode))
1306 (iso-accents-mode -1)) ; turn off iso accents
1307
1308 ;; Protection against user errors in hooks
1309 (condition-case conds
1310 (run-hooks 'vip-vi-state-hooks)
1311 (error
1312 (vip-message-conditions conds)))))
1313
1314 (defun vip-change-state-to-insert ()
1315 "Change Viper state to Insert."
1316 (interactive)
1317 (vip-change-state 'insert-state)
1318 (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode))
1319 (iso-accents-mode 1)) ; turn iso accents on
1320
1321 ;; Protection against user errors in hooks
1322 (condition-case conds
1323 (run-hooks 'vip-insert-state-hooks)
1324 (error
1325 (vip-message-conditions conds))))
1326
1327 (defsubst vip-downgrade-to-insert ()
1328 (setq vip-current-state 'insert-state
1329 vip-replace-minor-mode nil)
1330 )
1331
1332
1333
1334 ;; Change to replace state. When the end of replacement region is reached,
1335 ;; replace state changes to insert state.
1336 (defun vip-change-state-to-replace (&optional non-R-cmd)
1337 (vip-change-state 'replace-state)
1338 (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode))
1339 (iso-accents-mode 1)) ; turn iso accents on
1340 ;; Run insert-state-hook
1341 (condition-case conds
1342 (run-hooks 'vip-insert-state-hooks 'vip-replace-state-hooks)
1343 (error
1344 (vip-message-conditions conds)))
1345
1346 (if non-R-cmd
1347 (vip-start-replace)
1348 ;; 'R' is implemented using Emacs's overwrite-mode
1349 (vip-start-R-mode))
1350 )
1351
1352
1353 (defun vip-change-state-to-emacs ()
1354 "Change Viper state to Emacs."
1355 (interactive)
1356 (vip-change-state 'emacs-state)
1357 (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode))
1358 (iso-accents-mode 1)) ; turn iso accents on
1359
1360 ;; Protection agains user errors in hooks
1361 (condition-case conds
1362 (run-hooks 'vip-emacs-state-hooks)
1363 (error
1364 (vip-message-conditions conds))))
1365
1366 ;; escape to emacs mode termporarily
1367 (defun vip-escape-to-emacs (arg &optional events)
1368 "Escape to Emacs state from Vi state for one Emacs command.
1369 ARG is used as the prefix value for the executed command. If
1370 EVENTS is a list of events, which become the beginning of the command."
1371 (interactive "P")
1372 (vip-escape-to-state arg events 'emacs-state))
1373
1374 ;; escape to Vi mode termporarily
1375 (defun vip-escape-to-vi ()
1376 "Escape from Emacs state to Vi state for one Vi 1-character command.
1377 This doesn't work with prefix arguments or most complex commands like
1378 cw, dw, etc. But it does work with some 2-character commands,
1379 like dd or dr."
1380 (interactive)
1381 (vip-escape-to-state nil nil 'vi-state))
1382
1383 ;; Escape to STATE mode for one Emacs command.
1384 (defun vip-escape-to-state (arg events state)
1385 (let (com key prefix-arg)
1386 ;; this temporarily turns off Viper's minor mode keymaps
1387 (vip-set-mode-vars-for state)
1388 (vip-normalize-minor-mode-map-alist)
1389 (if events (vip-set-unread-command-events events))
1390
1391 ;; protect against keyboard quit and other errors
1392 (condition-case nil
1393 (progn
1394 (unwind-protect
1395 (progn
1396 (setq com (key-binding (setq key
1397 (if vip-xemacs-p
1398 (read-key-sequence nil)
1399 (read-key-sequence nil t)))))
1400 ;; In case of indirection--chase definitions.
1401 ;; Have to do it here because we execute this command under
1402 ;; different keymaps, so command-execute may not do the
1403 ;; right thing there
1404 (while (vectorp com) (setq com (key-binding com))))
1405 nil)
1406 ;; exec command in the right Viper state
1407 ;; otherwise, if we switch buffers in the escaped command,
1408 ;; Viper's mode vars will remain those of `state'. When we return
1409 ;; to the orig buffer, the bindings will be screwed up.
1410 (vip-set-mode-vars-for vip-current-state)
1411
1412 ;; this-command, last-command-char, last-command-event
1413 (setq this-command com)
1414 (if vip-xemacs-p ; XEmacs represents key sequences as vectors
1415 (setq last-command-event (vip-seq-last-elt key)
1416 last-command-char (event-to-character last-command-event))
1417 ;; Emacs represents them as sequences (str or vec)
1418 (setq last-command-event (vip-seq-last-elt key)
1419 last-command-char last-command-event))
1420
1421 (if (commandp com)
1422 (progn
1423 (setq prefix-arg arg)
1424 (command-execute com)))
1425 )
1426 (quit (ding))
1427 (error (beep 1))))
1428 (vip-set-mode-vars-for vip-current-state)) ; set state in new buffer
1429
1430 (defun vip-exec-form-in-emacs (form)
1431 "Execute FORM in Emacs, temporarily disabling Viper's minor modes.
1432 Similar to vip-escape-to-emacs, but accepts forms rather than keystrokes."
1433 (let ((buff (current-buffer))
1434 result)
1435 (vip-set-mode-vars-for 'emacs-state)
1436 (setq result (eval form))
1437 (if (not (equal buff (current-buffer))) ; cmd switched buffer
1438 (save-excursion
1439 (set-buffer buff)
1440 (vip-set-mode-vars-for vip-current-state)))
1441 (vip-set-mode-vars-for vip-current-state)
1442 result))
1443
1444 \f
1445
1446 ;; This is needed because minor modes sometimes override essential Viper
1447 ;; bindings. By letting Viper know which files these modes are in, it will
1448 ;; arrange to reorganize minor-mode-map-alist so that things will work right.
1449 (defun vip-harness-minor-mode (load-file)
1450 "Familiarize Viper with a minor mode defined in LOAD_FILE.
1451 Minor modes that have their own keymaps may overshadow Viper keymaps.
1452 This function is designed to make Viper aware of the packages that define
1453 such minor modes.
1454 Usage:
1455 (vip-harness-minor-mode load-file)
1456
1457 LOAD-FILE is a name of the file where the specific minor mode is defined.
1458 Suffixes such as .el or .elc should be stripped."
1459
1460 (interactive "sEnter name of the load file: ")
1461
1462 (vip-eval-after-load load-file '(vip-normalize-minor-mode-map-alist))
1463
1464 ;; This is a work-around the emacs bug that doesn't let us make
1465 ;; minor-mode-map-alist permanent-local.
1466 ;; This workaround changes the default for minor-mode-map-alist
1467 ;; each time a harnessed minor mode adds its own keymap to the a-list.
1468 (vip-eval-after-load load-file '(setq-default minor-mode-map-alist
1469 minor-mode-map-alist))
1470 )
1471
1472 ;; This doesn't work, i.e., doesn't replace vip-harness-minor-mode
1473 ;; function, since autoloaded files don't seem to be loaded with lisp's
1474 ;; `load' function.
1475 ;;(defadvice load (after vip-load-advice activate)
1476 ;; "Rearrange `minor-mode-map-alist' after loading a file or a library."
1477 ;; (vip-normalize-minor-mode-map-alist)
1478 ;; (setq-default minor-mode-map-alist minor-mode-map-alist))
1479
1480
1481 \f
1482 (defun vip-ESC (arg)
1483 "Emulate ESC key in Emacs.
1484 Prevents multiple escape keystrokes if vip-no-multiple-ESC is true. In that
1485 case \@ will be bound to ESC. If vip-no-multiple-ESC is 'twice double ESC
1486 would dings in vi-state. Other ESC sequences are emulated via the current
1487 Emacs's major mode keymap. This is more convenient on dumb terminals and in
1488 Emacs -nw, since this won't block functional keys such as up,down,
1489 etc. Meta key also will work. When vip-no-multiple-ESC is nil, ESC key
1490 behaves as in Emacs, any number of multiple escapes is allowed."
1491 (interactive "P")
1492 (let (char)
1493 (cond ((and (not vip-no-multiple-ESC) (eq vip-current-state 'vi-state))
1494 (setq char (vip-read-char-exclusive))
1495 (vip-escape-to-emacs arg (list ?\e char) ))
1496 ((and (eq vip-no-multiple-ESC 'twice)
1497 (eq vip-current-state 'vi-state))
1498 (setq char (vip-read-char-exclusive))
1499 (if (= char (string-to-char vip-ESC-key))
1500 (ding)
1501 (vip-escape-to-emacs arg (list ?\e char) )))
1502 (t (ding)))
1503 ))
1504
1505 (defun vip-alternate-ESC (arg)
1506 "ESC key without checking for multiple keystrokes."
1507 (interactive "P")
1508 (vip-escape-to-emacs arg '(?\e)))
1509
1510 \f
1511 ;; Intercept ESC sequences on dumb terminals.
1512 ;; Based on the idea contributed by Marcelino Veiga Tuimil <mveiga@dit.upm.es>
1513
1514 ;; Check if last key was ESC and if so try to reread it as a function key.
1515 ;; But only if there are characters to read during a very short time.
1516 ;; Returns the last event, if any.
1517 (defun vip-envelop-ESC-key ()
1518 (let ((event last-input-event)
1519 (keyseq [nil])
1520 inhibit-quit)
1521 (if (vip-ESC-event-p event)
1522 (progn
1523 (if (vip-fast-keysequence-p)
1524 (progn
1525 (let ((vip-vi-intercept-minor-mode nil)
1526 (vip-insert-intercept-minor-mode nil)
1527 (vip-emacs-intercept-minor-mode nil)
1528 (vip-vi-state-modifier-minor-mode nil)
1529 (vip-vi-global-user-minor-mode nil)
1530 (vip-vi-local-user-minor-mode nil)
1531 (vip-replace-minor-mode nil) ; actually unnecessary
1532 (vip-insert-state-modifier-minor-mode nil)
1533 (vip-insert-global-user-minor-mode nil)
1534 (vip-insert-local-user-minor-mode nil)
1535 (vip-emacs-state-modifier-minor-mode nil)
1536 (vip-emacs-global-user-minor-mode nil)
1537 (vip-emacs-local-user-minor-mode nil)
1538 )
1539 ;; The treatment of XEmacs, below, is temporary, since we
1540 ;; don't know how XEmacs will implement dumb terminals.
1541 ;; Note: the treatment of fast keysequences here is
1542 ;; needed only on dumb terminals in order to be able to
1543 ;; handle function keys correctly.
1544 (if vip-xemacs-p
1545 (setq keyseq (vector event))
1546 (vip-set-unread-command-events event)
1547 (setq keyseq
1548 (funcall
1549 (ad-get-orig-definition 'read-key-sequence) nil))
1550 ))
1551 ;; If keyseq translates into something that still has ESC
1552 ;; in the beginning, separate ESC from the rest of the seq.
1553 ;;
1554 ;; This is needed for the following reason:
1555 ;; If ESC is the first symbol, we interpret it as if the
1556 ;; user typed ESC and then quickly some other symbols.
1557 ;; If ESC is not the first one, then the key sequence
1558 ;; entered was apparently translated into a function key or
1559 ;; something (e.g., one may have
1560 ;; (define-key function-key-map "\e[192z" [f11])
1561 ;; which would translate the escape-sequence generated by
1562 ;; f11 in an xterm window into the symbolic key f11.
1563 (if (vip-ESC-event-p (elt keyseq 0))
1564 (progn
1565 ;; put keys following ESC on the unread list
1566 ;; and return ESC as the key-sequence
1567 (vip-set-unread-command-events (subseq keyseq 1))
1568 (setq last-input-event event
1569 keyseq "\e")))
1570 ) ; end progn
1571
1572 ;; this is escape event with nothing after it
1573 ;; put in unread-command-event and then re-read
1574 (vip-set-unread-command-events event)
1575 (setq keyseq
1576 (funcall (ad-get-orig-definition 'read-key-sequence) nil))
1577 ))
1578 ;; not an escape event
1579 (setq keyseq (vector event)))
1580 keyseq))
1581
1582
1583
1584 (defadvice read-key-sequence (around vip-read-key-sequence-ad activate)
1585 (let (inhibit-quit event keyseq)
1586 (setq keyseq ad-do-it)
1587 (setq event (if vip-xemacs-p
1588 (elt keyseq 0) ; XEmacs returns vector of events
1589 (elt (listify-key-sequence keyseq) 0)))
1590 (if (vip-ESC-event-p event)
1591 (let (unread-command-events unread-command-event)
1592 (vip-set-unread-command-events keyseq)
1593 (if (vip-fast-keysequence-p)
1594 (let ((vip-vi-global-user-minor-mode nil)
1595 (vip-vi-local-user-minor-mode nil)
1596 (vip-replace-minor-mode nil) ; actually unnecessary
1597 (vip-insert-global-user-minor-mode nil)
1598 (vip-insert-local-user-minor-mode nil))
1599 (setq keyseq ad-do-it))
1600 (setq keyseq ad-do-it))))
1601 keyseq))
1602
1603 (defadvice describe-key (before vip-read-key-sequence-ad protect activate)
1604 "Force `describe-key' to read key via `read-key-sequence'."
1605 (interactive (list (vip-events-to-keys
1606 (read-key-sequence "Describe key: ")))))
1607
1608 (defadvice describe-key-briefly
1609 (before vip-read-key-sequence-ad protect activate)
1610 "Force `describe-key-briefly' to read key via `read-key-sequence'."
1611 (interactive (list (vip-events-to-keys
1612 (read-key-sequence "Describe key briefly: ")))))
1613
1614 (defun vip-intercept-ESC-key ()
1615 "Listen to ESC key.
1616 If a sequence of keys starting with ESC is issued with very short delays,
1617 interpret these keys in Emacs mode, so ESC won't be interpreted as a Vi key."
1618 (interactive)
1619 (let ((cmd (or (key-binding (vip-envelop-ESC-key))
1620 '(lambda () (interactive) (error "")))))
1621
1622 ;; call the actual function to execute ESC (if no other symbols followed)
1623 ;; or the key bound to the ESC sequence (if the sequence was issued
1624 ;; with very short delay between characters.
1625 (if (eq cmd 'vip-intercept-ESC-key)
1626 (setq cmd
1627 (cond ((eq vip-current-state 'vi-state)
1628 'vip-ESC)
1629 ((eq vip-current-state 'insert-state)
1630 'vip-exit-insert-state)
1631 ((eq vip-current-state 'replace-state)
1632 'vip-replace-state-exit-cmd)
1633 (t 'vip-change-state-to-vi)
1634 )))
1635 (call-interactively cmd)))
1636
1637
1638 \f
1639 ;; prefix argument for Vi mode
1640
1641 ;; In Vi mode, prefix argument is a dotted pair (NUM . COM) where NUM
1642 ;; represents the numeric value of the prefix argument and COM represents
1643 ;; command prefix such as "c", "d", "m" and "y".
1644
1645 (defun vip-prefix-arg-value (event com)
1646 "Compute numeric prefix arg value.
1647 Invoked by CHAR. COM is the command part obtained so far."
1648 (let (value)
1649 ;; read while number
1650 (while (and (numberp event) (>= event ?0) (<= event ?9))
1651 (setq value (+ (* (if (numberp value) value 0) 10) (- event ?0)))
1652 (setq event (vip-read-event-convert-to-char)))
1653
1654 (setq prefix-arg value)
1655 (if com (setq prefix-arg (cons prefix-arg com)))
1656 (while (eq event ?U)
1657 (vip-describe-arg prefix-arg)
1658 (setq event (vip-read-event-convert-to-char)))
1659 (vip-set-unread-command-events event)))
1660
1661 (defun vip-prefix-arg-com (char value com)
1662 "Vi operator as prefix argument."
1663 (let ((cont t))
1664 (while (and cont
1665 (memq char
1666 (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\"
1667 vip-buffer-search-char)))
1668 (if com
1669 ;; this means that we already have a command character, so we
1670 ;; construct a com list and exit while. however, if char is "
1671 ;; it is an error.
1672 (progn
1673 ;; new com is (CHAR . OLDCOM)
1674 (if (memq char '(?# ?\")) (error ""))
1675 (setq com (cons char com))
1676 (setq cont nil))
1677 ;; If com is nil we set com as char, and read more. Again, if char
1678 ;; is ", we read the name of register and store it in vip-use-register.
1679 ;; if char is !, =, or #, a complete com is formed so we exit the
1680 ;; while loop.
1681 (cond ((memq char '(?! ?=))
1682 (setq com char)
1683 (setq char (read-char))
1684 (setq cont nil))
1685 ((= char ?#)
1686 ;; read a char and encode it as com
1687 (setq com (+ 128 (read-char)))
1688 (setq char (read-char)))
1689 ((= char ?\")
1690 (let ((reg (read-char)))
1691 (if (vip-valid-register reg)
1692 (setq vip-use-register reg)
1693 (error ""))
1694 (setq char (read-char))))
1695 (t
1696 (setq com char)
1697 (setq char (vip-read-char-exclusive)))))))
1698 (if (atom com)
1699 ;; com is a single char, so we construct prefix-arg
1700 ;; and if char is ?, describe prefix arg, otherwise exit by
1701 ;; pushing the char back
1702 (progn
1703 (setq prefix-arg (cons value com))
1704 (while (= char ?U)
1705 (vip-describe-arg prefix-arg)
1706 (setq char (read-char)))
1707 (vip-set-unread-command-events char)
1708 )
1709 ;; as com is non-nil, this means that we have a command to execute
1710 (if (memq (car com) '(?r ?R))
1711 ;; execute apropriate region command.
1712 (let ((char (car com)) (com (cdr com)))
1713 (setq prefix-arg (cons value com))
1714 (if (= char ?r) (vip-region prefix-arg)
1715 (vip-Region prefix-arg))
1716 ;; reset prefix-arg
1717 (setq prefix-arg nil))
1718 ;; otherwise, reset prefix arg and call appropriate command
1719 (setq value (if (null value) 1 value))
1720 (setq prefix-arg nil)
1721 (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C)))
1722 ((equal com '(?d . ?d)) (vip-line (cons value ?D)))
1723 ((equal com '(?d . ?y)) (vip-yank-defun))
1724 ((equal com '(?y . ?y)) (vip-line (cons value ?Y)))
1725 ((equal com '(?< . ?<)) (vip-line (cons value ?<)))
1726 ((equal com '(?> . ?>)) (vip-line (cons value ?>)))
1727 ((equal com '(?! . ?!)) (vip-line (cons value ?!)))
1728 ((equal com '(?= . ?=)) (vip-line (cons value ?=)))
1729 (t (error ""))))))
1730
1731 (defun vip-describe-arg (arg)
1732 (let (val com)
1733 (setq val (vip-P-val arg)
1734 com (vip-getcom arg))
1735 (if (null val)
1736 (if (null com)
1737 (message "Value is nil, and command is nil")
1738 (message "Value is nil, and command is `%c'" com))
1739 (if (null com)
1740 (message "Value is `%d', and command is nil" val)
1741 (message "Value is `%d', and command is `%c'" val com)))))
1742
1743 (defun vip-digit-argument (arg)
1744 "Begin numeric argument for the next command."
1745 (interactive "P")
1746 (vip-prefix-arg-value last-command-char
1747 (if (consp arg) (cdr arg) nil)))
1748
1749 (defun vip-command-argument (arg)
1750 "Accept a motion command as an argument."
1751 (interactive "P")
1752 (condition-case nil
1753 (vip-prefix-arg-com
1754 last-command-char
1755 (cond ((null arg) nil)
1756 ((consp arg) (car arg))
1757 ((numberp arg) arg)
1758 (t (error vip-InvalidCommandArgument)))
1759 (cond ((null arg) nil)
1760 ((consp arg) (cdr arg))
1761 ((numberp arg) nil)
1762 (t (error vip-InvalidCommandArgument))))
1763 (quit (setq vip-use-register nil)
1764 (signal 'quit nil)))
1765 (vip-deactivate-mark))
1766
1767 ;; Get value part of prefix-argument ARG.
1768 (defsubst vip-p-val (arg)
1769 (cond ((null arg) 1)
1770 ((consp arg) (if (null (car arg)) 1 (car arg)))
1771 (t arg)))
1772
1773 ;; Get raw value part of prefix-argument ARG.
1774 (defsubst vip-P-val (arg)
1775 (cond ((consp arg) (car arg))
1776 (t arg)))
1777
1778 ;; Get com part of prefix-argument ARG.
1779 (defsubst vip-getcom (arg)
1780 (cond ((null arg) nil)
1781 ((consp arg) (cdr arg))
1782 (t nil)))
1783
1784 ;; Get com part of prefix-argument ARG and modify it.
1785 (defun vip-getCom (arg)
1786 (let ((com (vip-getcom arg)))
1787 (cond ((equal com ?c) ?C)
1788 ((equal com ?d) ?D)
1789 ((equal com ?y) ?Y)
1790 (t com))))
1791
1792 \f
1793 ;; repeat last destructive command
1794
1795 ;; Append region to text in register REG.
1796 ;; START and END are buffer positions indicating what to append.
1797 (defsubst vip-append-to-register (reg start end)
1798 (set-register reg (concat (or (get-register reg) "")
1799 (buffer-substring start end))))
1800
1801 ;; define functions to be executed
1802
1803 ;; invoked by C command
1804 (defun vip-exec-change (m-com com)
1805 ;; handle C cmd at the eol and at eob.
1806 (if (or (and (eolp) (= vip-com-point (point)))
1807 (= vip-com-point (point-max)))
1808 (progn
1809 (insert " ")(backward-char 1)))
1810 (if (= vip-com-point (point))
1811 (vip-forward-char-carefully))
1812 (if (= com ?c)
1813 (vip-change vip-com-point (point))
1814 (vip-change-subr vip-com-point (point))))
1815
1816 ;; this is invoked by vip-substitute-line
1817 (defun vip-exec-Change (m-com com)
1818 (save-excursion
1819 (set-mark vip-com-point)
1820 (vip-enlarge-region (mark t) (point))
1821 (if vip-use-register
1822 (progn
1823 (cond ((vip-valid-register vip-use-register '(letter digit))
1824 ;;(vip-valid-register vip-use-register '(letter)
1825 (copy-to-register
1826 vip-use-register (mark t) (point) nil))
1827 ((vip-valid-register vip-use-register '(Letter))
1828 (vip-append-to-register
1829 (downcase vip-use-register) (mark t) (point)))
1830 (t (setq vip-use-register nil)
1831 (error vip-InvalidRegister vip-use-register)))
1832 (setq vip-use-register nil)))
1833 (delete-region (mark t) (point)))
1834 (open-line 1)
1835 (if (= com ?C) (vip-change-mode-to-insert) (vip-yank-last-insertion)))
1836
1837 (defun vip-exec-delete (m-com com)
1838 (if vip-use-register
1839 (progn
1840 (cond ((vip-valid-register vip-use-register '(letter digit))
1841 ;;(vip-valid-register vip-use-register '(letter))
1842 (copy-to-register
1843 vip-use-register vip-com-point (point) nil))
1844 ((vip-valid-register vip-use-register '(Letter))
1845 (vip-append-to-register
1846 (downcase vip-use-register) vip-com-point (point)))
1847 (t (setq vip-use-register nil)
1848 (error vip-InvalidRegister vip-use-register)))
1849 (setq vip-use-register nil)))
1850 (setq last-command
1851 (if (eq last-command 'd-command) 'kill-region nil))
1852 (kill-region vip-com-point (point))
1853 (setq this-command 'd-command)
1854 (if vip-ex-style-motion
1855 (if (and (eolp) (not (bolp))) (backward-char 1))))
1856
1857 (defun vip-exec-Delete (m-com com)
1858 (save-excursion
1859 (set-mark vip-com-point)
1860 (vip-enlarge-region (mark t) (point))
1861 (if vip-use-register
1862 (progn
1863 (cond ((vip-valid-register vip-use-register '(letter digit))
1864 ;;(vip-valid-register vip-use-register '(letter))
1865 (copy-to-register
1866 vip-use-register (mark t) (point) nil))
1867 ((vip-valid-register vip-use-register '(Letter))
1868 (vip-append-to-register
1869 (downcase vip-use-register) (mark t) (point)))
1870 (t (setq vip-use-register nil)
1871 (error vip-InvalidRegister vip-use-register)))
1872 (setq vip-use-register nil)))
1873 (setq last-command
1874 (if (eq last-command 'D-command) 'kill-region nil))
1875 (kill-region (mark t) (point))
1876 (if (eq m-com 'vip-line) (setq this-command 'D-command)))
1877 (back-to-indentation))
1878
1879 (defun vip-exec-yank (m-com com)
1880 (if vip-use-register
1881 (progn
1882 (cond ((vip-valid-register vip-use-register '(letter digit))
1883 ;; (vip-valid-register vip-use-register '(letter))
1884 (copy-to-register
1885 vip-use-register vip-com-point (point) nil))
1886 ((vip-valid-register vip-use-register '(Letter))
1887 (vip-append-to-register
1888 (downcase vip-use-register) vip-com-point (point)))
1889 (t (setq vip-use-register nil)
1890 (error vip-InvalidRegister vip-use-register)))
1891 (setq vip-use-register nil)))
1892 (setq last-command nil)
1893 (copy-region-as-kill vip-com-point (point))
1894 (goto-char vip-com-point))
1895
1896 (defun vip-exec-Yank (m-com com)
1897 (save-excursion
1898 (set-mark vip-com-point)
1899 (vip-enlarge-region (mark t) (point))
1900 (if vip-use-register
1901 (progn
1902 (cond ((vip-valid-register vip-use-register '(letter digit))
1903 ;;(vip-valid-register vip-use-register '(letter))
1904 (copy-to-register
1905 vip-use-register (mark t) (point) nil))
1906 ((vip-valid-register vip-use-register '(Letter))
1907 (vip-append-to-register
1908 (downcase vip-use-register) (mark t) (point)))
1909 (t (setq vip-use-register nil)
1910 (error vip-InvalidRegister vip-use-register)))
1911 (setq vip-use-register nil)))
1912 (setq last-command nil)
1913 (copy-region-as-kill (mark t) (point)))
1914 (goto-char vip-com-point))
1915
1916 (defun vip-exec-bang (m-com com)
1917 (save-excursion
1918 (set-mark vip-com-point)
1919 (vip-enlarge-region (mark t) (point))
1920 (shell-command-on-region
1921 (mark t) (point)
1922 (if (= com ?!)
1923 (setq vip-last-shell-com
1924 (vip-read-string-with-history
1925 "!"
1926 nil
1927 'vip-shell-history
1928 (car vip-shell-history)
1929 ))
1930 vip-last-shell-com)
1931 t)))
1932
1933 (defun vip-exec-equals (m-com com)
1934 (save-excursion
1935 (set-mark vip-com-point)
1936 (vip-enlarge-region (mark t) (point))
1937 (if (> (mark t) (point)) (exchange-point-and-mark))
1938 (indent-region (mark t) (point) nil)))
1939
1940 (defun vip-exec-shift (m-com com)
1941 (save-excursion
1942 (set-mark vip-com-point)
1943 (vip-enlarge-region (mark t) (point))
1944 (if (> (mark t) (point)) (exchange-point-and-mark))
1945 (indent-rigidly (mark t) (point)
1946 (if (= com ?>)
1947 vip-shift-width
1948 (- vip-shift-width)))))
1949
1950 ;; this is needed because some commands fake com by setting it to ?r, which
1951 ;; denotes repeated insert command.
1952 (defsubst vip-exec-dummy (m-com com)
1953 nil)
1954
1955 (defun vip-exec-buffer-search (m-com com)
1956 (setq vip-s-string (buffer-substring (point) vip-com-point))
1957 (setq vip-s-forward t)
1958 (setq vip-search-history (cons vip-s-string vip-search-history))
1959 (vip-search vip-s-string vip-s-forward 1))
1960
1961 (defvar vip-exec-array (make-vector 128 nil))
1962
1963 ;; Using a dispatch array allows adding functions like buffer search
1964 ;; without affecting other functions. Buffer search can now be bound
1965 ;; to any character.
1966
1967 (aset vip-exec-array ?c 'vip-exec-change)
1968 (aset vip-exec-array ?C 'vip-exec-Change)
1969 (aset vip-exec-array ?d 'vip-exec-delete)
1970 (aset vip-exec-array ?D 'vip-exec-Delete)
1971 (aset vip-exec-array ?y 'vip-exec-yank)
1972 (aset vip-exec-array ?Y 'vip-exec-Yank)
1973 (aset vip-exec-array ?r 'vip-exec-dummy)
1974 (aset vip-exec-array ?! 'vip-exec-bang)
1975 (aset vip-exec-array ?< 'vip-exec-shift)
1976 (aset vip-exec-array ?> 'vip-exec-shift)
1977 (aset vip-exec-array ?= 'vip-exec-equals)
1978
1979
1980
1981 ;; This function is called by various movement commands to execute a
1982 ;; destructive command on the region specified by the movement command. For
1983 ;; instance, if the user types cw, then the command vip-forward-word will
1984 ;; call vip-execute-com to execute vip-exec-change, which eventually will
1985 ;; call vip-change to invoke the replace mode on the region.
1986 ;;
1987 ;; The list (M-COM VAL COM REG INSETED-TEXT COMMAND-KEYS) is set to
1988 ;; vip-d-com for later use by vip-repeat.
1989 (defun vip-execute-com (m-com val com)
1990 (let ((reg vip-use-register))
1991 ;; this is the special command `#'
1992 (if (> com 128)
1993 (vip-special-prefix-com (- com 128))
1994 (let ((fn (aref vip-exec-array (if (< com 0) (- com) com))))
1995 (if (null fn)
1996 (error "%c: %s" com vip-InvalidViCommand)
1997 (funcall fn m-com com))))
1998 (if (vip-dotable-command-p com)
1999 (vip-set-destructive-command
2000 (list m-com val
2001 (if (memq com (list ?c ?C ?!)) (- com) com)
2002 reg nil nil)))
2003 ))
2004
2005
2006 (defun vip-repeat (arg)
2007 "Re-execute last destructive command.
2008 Use the info in vip-d-com, which has the form
2009 \(com val ch reg inserted-text command-keys\),
2010 where `com' is the command to be re-executed, `val' is the
2011 argument to `com', `ch' is a flag for repeat, and `reg' is optional;
2012 if it exists, it is the name of the register for `com'.
2013 If the prefix argument, ARG, is non-nil, it is used instead of `val'."
2014 (interactive "P")
2015 (let ((save-point (point)) ; save point before repeating prev cmd
2016 ;; Pass along that we are repeating a destructive command
2017 ;; This tells vip-set-destructive-command not to update
2018 ;; vip-command-ring
2019 (vip-intermediate-command 'vip-repeat))
2020 (if (eq last-command 'vip-undo)
2021 ;; if the last command was vip-undo, then undo-more
2022 (vip-undo-more)
2023 ;; otherwise execute the command stored in vip-d-com. if arg is non-nil
2024 ;; its prefix value is used as new prefix value for the command.
2025 (let ((m-com (car vip-d-com))
2026 (val (vip-P-val arg))
2027 (com (nth 2 vip-d-com))
2028 (reg (nth 3 vip-d-com)))
2029 (if (null val) (setq val (nth 1 vip-d-com)))
2030 (if (null m-com) (error "No previous command to repeat."))
2031 (setq vip-use-register reg)
2032 (if (nth 4 vip-d-com) ; text inserted by command
2033 (setq vip-last-insertion (nth 4 vip-d-com)
2034 vip-d-char (nth 4 vip-d-com)))
2035 (funcall m-com (cons val com))
2036 (if (and vip-keep-point-on-repeat (< save-point (point)))
2037 (goto-char save-point)) ; go back to before repeat.
2038 (if (and (eolp) (not (bolp)))
2039 (backward-char 1))
2040 ))
2041 (if vip-undo-needs-adjustment (vip-adjust-undo)) ; take care of undo
2042 ;; If the prev cmd was rotating the command ring, this means that `.' has
2043 ;; just executed a command from that ring. So, push it on the ring again.
2044 ;; If we are just executing previous command , then don't push vip-d-com
2045 ;; because vip-d-com is not fully constructed in this case (its keys and
2046 ;; the inserted text may be nil). Besides, in this case, the command
2047 ;; executed by `.' is already on the ring.
2048 (if (eq last-command 'vip-display-current-destructive-command)
2049 (vip-push-onto-ring vip-d-com 'vip-command-ring))
2050 (vip-deactivate-mark)
2051 ))
2052
2053 (defun vip-repeat-from-history ()
2054 "Repeat a destructive command from history.
2055 Doesn't change vip-command-ring in any way, so `.' will work as before
2056 executing this command.
2057 This command is supposed to be bound to a two-character Vi macro where
2058 the second character is a digit 0 to 9. The digit indicates which
2059 history command to execute. `<char>0' is equivalent to `.', `<char>1'
2060 invokes the command before that, etc."
2061 (interactive)
2062 (let* ((vip-intermediate-command 'repeating-display-destructive-command)
2063 (idx (cond (vip-this-kbd-macro
2064 (string-to-number
2065 (symbol-name (elt vip-this-kbd-macro 1))))
2066 (t 0)))
2067 (num idx)
2068 (vip-d-com vip-d-com))
2069
2070 (or (and (numberp num) (<= 0 num) (<= num 9))
2071 (setq idx 0
2072 num 0)
2073 (message
2074 "`vip-repeat-from-history' must be invoked as a Vi macro bound to `<key><digit>'"))
2075 (while (< 0 num)
2076 (setq vip-d-com (vip-special-ring-rotate1 vip-command-ring -1))
2077 (setq num (1- num)))
2078 (vip-repeat nil)
2079 (while (> idx num)
2080 (vip-special-ring-rotate1 vip-command-ring 1)
2081 (setq num (1+ num)))
2082 ))
2083
2084
2085 (defun vip-special-prefix-com (char)
2086 "This command is invoked interactively by the key sequence #<char>."
2087 (cond ((= char ?c)
2088 (downcase-region (min vip-com-point (point))
2089 (max vip-com-point (point))))
2090 ((= char ?C)
2091 (upcase-region (min vip-com-point (point))
2092 (max vip-com-point (point))))
2093 ((= char ?g)
2094 (push-mark vip-com-point t)
2095 (vip-global-execute))
2096 ((= char ?q)
2097 (push-mark vip-com-point t)
2098 (vip-quote-region))
2099 ((= char ?s) (funcall vip-spell-function vip-com-point (point)))
2100 (t (error "#%c: %s" char vip-InvalidViCommand))))
2101
2102 \f
2103 ;; undoing
2104
2105 (defun vip-undo ()
2106 "Undo previous change."
2107 (interactive)
2108 (message "undo!")
2109 (let ((modified (buffer-modified-p))
2110 (before-undo-pt (point-marker))
2111 (after-change-functions after-change-functions)
2112 undo-beg-posn undo-end-posn)
2113
2114 ;; no need to remove this hook, since this var has scope inside a let.
2115 (add-hook 'after-change-functions
2116 '(lambda (beg end len)
2117 (setq undo-beg-posn beg
2118 undo-end-posn (or end beg))))
2119
2120 (undo-start)
2121 (undo-more 2)
2122 (setq undo-beg-posn (or undo-beg-posn before-undo-pt)
2123 undo-end-posn (or undo-end-posn undo-beg-posn))
2124
2125 (goto-char undo-beg-posn)
2126 (sit-for 0)
2127 (if (and vip-keep-point-on-undo
2128 (pos-visible-in-window-p before-undo-pt))
2129 (progn
2130 (push-mark (point-marker) t)
2131 (vip-sit-for-short 300)
2132 (goto-char undo-end-posn)
2133 (vip-sit-for-short 300)
2134 (if (and (> (abs (- undo-beg-posn before-undo-pt)) 1)
2135 (> (abs (- undo-end-posn before-undo-pt)) 1))
2136 (goto-char before-undo-pt)
2137 (goto-char undo-beg-posn)))
2138 (push-mark before-undo-pt t))
2139 (if (and (eolp) (not (bolp))) (backward-char 1))
2140 (if (not modified) (set-buffer-modified-p t)))
2141 (setq this-command 'vip-undo))
2142
2143 (defun vip-undo-more ()
2144 "Continue undoing previous changes."
2145 (message "undo more!")
2146 (condition-case nil
2147 (undo-more 1)
2148 (error (beep)
2149 (message "No further undo information in this buffer")))
2150 (if (and (eolp) (not (bolp))) (backward-char 1))
2151 (setq this-command 'vip-undo))
2152
2153 ;; The following two functions are used to set up undo properly.
2154 ;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines,
2155 ;; they are undone all at once.
2156 (defun vip-adjust-undo ()
2157 (let ((inhibit-quit t)
2158 tmp tmp2)
2159 (setq vip-undo-needs-adjustment nil)
2160 (if (listp buffer-undo-list)
2161 (if (setq tmp (memq vip-buffer-undo-list-mark buffer-undo-list))
2162 (progn
2163 (setq tmp2 (cdr tmp)) ; the part after mark
2164
2165 ;; cut tail from buffer-undo-list temporarily by direct
2166 ;; manipulation with pointers in buffer-undo-list
2167 (setcdr tmp nil)
2168
2169 (setq buffer-undo-list (delq nil buffer-undo-list))
2170 (setq buffer-undo-list
2171 (delq vip-buffer-undo-list-mark buffer-undo-list))
2172 ;; restore tail of buffer-undo-list
2173 (setq buffer-undo-list (nconc buffer-undo-list tmp2)))
2174 (setq buffer-undo-list (delq nil buffer-undo-list))))))
2175
2176
2177 (defun vip-set-complex-command-for-undo ()
2178 (if (listp buffer-undo-list)
2179 (if (not vip-undo-needs-adjustment)
2180 (let ((inhibit-quit t))
2181 (setq buffer-undo-list
2182 (cons vip-buffer-undo-list-mark buffer-undo-list))
2183 (setq vip-undo-needs-adjustment t)))))
2184
2185
2186
2187
2188 (defun vip-display-current-destructive-command ()
2189 (let ((text (nth 4 vip-d-com))
2190 (keys (nth 5 vip-d-com))
2191 (max-text-len 30))
2192
2193 (setq this-command 'vip-display-current-destructive-command)
2194
2195 (message " `.' runs %s%s"
2196 (concat "`" (vip-array-to-string keys) "'")
2197 (vip-abbreviate-string text max-text-len
2198 " inserting `" "'" " ......."))
2199 ))
2200
2201
2202 ;; don't change vip-d-com if it was vip-repeat command invoked with `.'
2203 ;; or in some other way (non-interactively).
2204 (defun vip-set-destructive-command (list)
2205 (or (eq vip-intermediate-command 'vip-repeat)
2206 (progn
2207 (setq vip-d-com list)
2208 (setcar (nthcdr 5 vip-d-com)
2209 (vip-array-to-string (this-command-keys)))
2210 (vip-push-onto-ring vip-d-com 'vip-command-ring))))
2211
2212 (defun vip-prev-destructive-command (next)
2213 "Find previous destructive command in the history of destructive commands.
2214 With prefix argument, find next destructive command."
2215 (interactive "P")
2216 (let (cmd vip-intermediate-command)
2217 (if (eq last-command 'vip-display-current-destructive-command)
2218 ;; repeated search through command history
2219 (setq vip-intermediate-command 'repeating-display-destructive-command)
2220 ;; first search through command history--set temp ring
2221 (setq vip-temp-command-ring (copy-list vip-command-ring)))
2222 (setq cmd (if next
2223 (vip-special-ring-rotate1 vip-temp-command-ring 1)
2224 (vip-special-ring-rotate1 vip-temp-command-ring -1)))
2225 (if (null cmd)
2226 ()
2227 (setq vip-d-com cmd))
2228 (vip-display-current-destructive-command)))
2229
2230 (defun vip-next-destructive-command ()
2231 "Find next destructive command in the history of destructive commands."
2232 (interactive)
2233 (vip-prev-destructive-command 'next))
2234
2235 (defun vip-insert-prev-from-insertion-ring (arg)
2236 "Cycles through insertion ring in the direction of older insertions.
2237 Undoes previous insertion and inserts new.
2238 With prefix argument, cycles in the direction of newer elements.
2239 In minibuffer, this command executes whatever the invocation key is bound
2240 to in the global map, instead of cycling through the insertion ring."
2241 (interactive "P")
2242 (let (vip-intermediate-command)
2243 (if (eq last-command 'vip-insert-from-insertion-ring)
2244 (progn ; repeated search through insertion history
2245 (setq vip-intermediate-command 'repeating-insertion-from-ring)
2246 (if (eq vip-current-state 'replace-state)
2247 (undo 1)
2248 (if vip-last-inserted-string-from-insertion-ring
2249 (backward-delete-char
2250 (length vip-last-inserted-string-from-insertion-ring))))
2251 )
2252 ;;first search through insertion history
2253 (setq vip-temp-insertion-ring (copy-list vip-insertion-ring)))
2254 (setq this-command 'vip-insert-from-insertion-ring)
2255 ;; so that things will be undone properly
2256 (setq buffer-undo-list (cons nil buffer-undo-list))
2257 (setq vip-last-inserted-string-from-insertion-ring
2258 (vip-special-ring-rotate1 vip-temp-insertion-ring (if arg 1 -1)))
2259
2260 ;; this change of vip-intermediate-command must come after
2261 ;; vip-special-ring-rotate1, so that the ring will rotate, but before the
2262 ;; insertion.
2263 (setq vip-intermediate-command nil)
2264 (if vip-last-inserted-string-from-insertion-ring
2265 (insert vip-last-inserted-string-from-insertion-ring))
2266 ))
2267
2268 (defun vip-insert-next-from-insertion-ring ()
2269 "Cycles through insertion ring in the direction of older insertions. Undoes previous insertion and inserts new."
2270 (interactive)
2271 (vip-insert-prev-from-insertion-ring 'next))
2272
2273 \f
2274 ;; some region utilities
2275
2276 (defun vip-add-newline-at-eob-if-necessary ()
2277 "If at the last line of buffer, add \\n before eob, if newline is missing."
2278 (save-excursion
2279 (end-of-line)
2280 ;; make sure all lines end with newline, unless in the minibuffer or
2281 ;; when requested otherwise (vip-add-newline-at-eob is nil)
2282 (if (and
2283 (eobp)
2284 (not (bolp))
2285 vip-add-newline-at-eob
2286 (not (vip-is-in-minibuffer)))
2287 (insert "\n"))))
2288
2289 (defun vip-yank-defun ()
2290 (mark-defun)
2291 (copy-region-as-kill (point) (mark t)))
2292
2293 (defun vip-enlarge-region (beg end)
2294 "Enlarge region between BEG and END."
2295 (or beg (setq beg end)) ; if beg is nil, set to end
2296 (or end (setq end beg)) ; if end is nil, set to beg
2297
2298 (if (< beg end)
2299 (progn (goto-char beg) (set-mark end))
2300 (goto-char end)
2301 (set-mark beg))
2302 (beginning-of-line)
2303 (exchange-point-and-mark)
2304 (if (or (not (eobp)) (not (bolp))) (forward-line 1))
2305 (if (not (eobp)) (beginning-of-line))
2306 (if (> beg end) (exchange-point-and-mark)))
2307
2308
2309 (defun vip-quote-region ()
2310 "Quote region by each line with a user supplied string."
2311 (setq vip-quote-string
2312 (vip-read-string-with-history
2313 "Quote string: "
2314 nil
2315 'vip-quote-region-history
2316 vip-quote-string))
2317 (vip-enlarge-region (point) (mark t))
2318 (if (> (point) (mark t)) (exchange-point-and-mark))
2319 (insert vip-quote-string)
2320 (beginning-of-line)
2321 (forward-line 1)
2322 (while (and (< (point) (mark t)) (bolp))
2323 (insert vip-quote-string)
2324 (beginning-of-line)
2325 (forward-line 1)))
2326
2327
2328 ;; Tells whether BEG is on the same line as END.
2329 ;; If one of the args is nil, it'll return nil.
2330 (defun vip-same-line (beg end)
2331 (let ((selective-display nil))
2332 (cond ((and beg end)
2333 ;; This 'if' is needed because Emacs treats the next empty line
2334 ;; as part of the previous line.
2335 (if (or (> beg (point-max)) (> end (point-max))) ; out of range
2336 ()
2337 (if (and (> end beg) (= (vip-line-pos 'start) end))
2338 (setq end (min (1+ end) (point-max))))
2339 (if (and (> beg end) (= (vip-line-pos 'start) beg))
2340 (setq beg (min (1+ beg) (point-max))))
2341 (<= (count-lines beg end) 1) ))
2342
2343 (t nil))
2344 ))
2345
2346
2347 ;; Check if the string ends with a newline.
2348 (defun vip-end-with-a-newline-p (string)
2349 (or (string= string "")
2350 (= (vip-seq-last-elt string) ?\n)))
2351
2352 (defun vip-tmp-insert-at-eob (msg)
2353 (let ((savemax (point-max)))
2354 (goto-char savemax)
2355 (insert msg)
2356 (sit-for 2)
2357 (goto-char savemax) (delete-region (point) (point-max))
2358 ))
2359
2360
2361 \f
2362 ;;; Minibuffer business
2363
2364 (defsubst vip-set-minibuffer-style ()
2365 (add-hook 'minibuffer-setup-hook 'vip-minibuffer-setup-sentinel))
2366
2367
2368 (defun vip-minibuffer-setup-sentinel ()
2369 (let ((hook (if vip-vi-style-in-minibuffer
2370 'vip-change-state-to-insert
2371 'vip-change-state-to-emacs)))
2372 (funcall hook)
2373
2374 ;; Make sure the minibufer overlay is kept up-to-date. In XEmacs also
2375 ;; guards against the possibility of detaching this overlay.
2376 (add-hook 'vip-post-command-hooks 'vip-move-minibuffer-overlay)
2377 ))
2378
2379 ;; Interpret last event in the local map
2380 (defun vip-exit-minibuffer ()
2381 (interactive)
2382 (let (command)
2383 (setq command (local-key-binding (char-to-string last-command-char)))
2384 (if command
2385 (command-execute command)
2386 (exit-minibuffer))))
2387
2388
2389 (defun vip-set-search-face ()
2390 (if (not window-system)
2391 ()
2392 (defvar vip-search-face
2393 (progn
2394 (make-face 'vip-search-face)
2395 (or (face-differs-from-default-p 'vip-search-face)
2396 ;; face wasn't set in .vip or .Xdefaults
2397 (if (vip-can-use-colors "Black" "khaki")
2398 (progn
2399 (set-face-background 'vip-search-face "khaki")
2400 (set-face-foreground 'vip-search-face "Black"))
2401 (copy-face 'italic 'vip-search-face)
2402 (set-face-underline-p 'vip-search-face t)))
2403 'vip-search-face)
2404 "*Face used to flash out the search pattern.")
2405 ))
2406
2407
2408 (defun vip-set-minibuffer-faces ()
2409 (if (not window-system)
2410 ()
2411 (defvar vip-minibuffer-emacs-face
2412 (progn
2413 (make-face 'vip-minibuffer-emacs-face)
2414 (or (face-differs-from-default-p 'vip-minibuffer-emacs-face)
2415 ;; face wasn't set in .vip or .Xdefaults
2416 (if vip-vi-style-in-minibuffer
2417 ;; emacs state is an exception in the minibuffer
2418 (if (vip-can-use-colors "darkseagreen2" "Black")
2419 (progn
2420 (set-face-background
2421 'vip-minibuffer-emacs-face "darkseagreen2")
2422 (set-face-foreground
2423 'vip-minibuffer-emacs-face "Black"))
2424 (copy-face 'highlight 'vip-minibuffer-emacs-face))
2425 ;; emacs state is the main state in the minibuffer
2426 (if (vip-can-use-colors "Black" "pink")
2427 (progn
2428 (set-face-background 'vip-minibuffer-emacs-face "pink")
2429 (set-face-foreground
2430 'vip-minibuffer-emacs-face "Black"))
2431 (copy-face 'italic 'vip-minibuffer-emacs-face))
2432 ))
2433 'vip-minibuffer-emacs-face)
2434 "Face used in the Minibuffer when it is in Emacs state.")
2435
2436 (defvar vip-minibuffer-insert-face
2437 (progn
2438 (make-face 'vip-minibuffer-insert-face)
2439 (or (face-differs-from-default-p 'vip-minibuffer-insert-face)
2440 (if vip-vi-style-in-minibuffer
2441 (if (vip-can-use-colors "Black" "pink")
2442 (progn
2443 (set-face-background 'vip-minibuffer-insert-face "pink")
2444 (set-face-foreground
2445 'vip-minibuffer-insert-face "Black"))
2446 (copy-face 'italic 'vip-minibuffer-insert-face))
2447 ;; If Insert state is an exception
2448 (if (vip-can-use-colors "darkseagreen2" "Black")
2449 (progn
2450 (set-face-background
2451 'vip-minibuffer-insert-face "darkseagreen2")
2452 (set-face-foreground
2453 'vip-minibuffer-insert-face "Black"))
2454 (copy-face 'highlight 'vip-minibuffer-insert-face))
2455 (vip-italicize-face 'vip-minibuffer-insert-face)))
2456 'vip-minibuffer-insert-face)
2457 "Face used in the Minibuffer when it is in Insert state.")
2458
2459 (defvar vip-minibuffer-vi-face
2460 (progn
2461 (make-face 'vip-minibuffer-vi-face)
2462 (or (face-differs-from-default-p 'vip-minibuffer-vi-face)
2463 (if vip-vi-style-in-minibuffer
2464 (if (vip-can-use-colors "Black" "grey")
2465 (progn
2466 (set-face-background 'vip-minibuffer-vi-face "grey")
2467 (set-face-foreground 'vip-minibuffer-vi-face "Black"))
2468 (copy-face 'bold 'vip-minibuffer-vi-face))
2469 (copy-face 'bold 'vip-minibuffer-vi-face)
2470 (invert-face 'vip-minibuffer-vi-face)))
2471 'vip-minibuffer-vi-face)
2472 "Face used in the Minibuffer when it is in Vi state.")
2473
2474 ;; the current face used in the minibuffer
2475 (vip-deflocalvar vip-minibuffer-current-face vip-minibuffer-emacs-face "")
2476 ))
2477
2478
2479 \f
2480 ;;; Reading string with history
2481
2482 (defun vip-read-string-with-history (prompt &optional initial
2483 history-var default keymap)
2484 ;; Reads string, prompting with PROMPT and inserting the INITIAL
2485 ;; value. Uses HISTORY-VAR. DEFAULT is the default value to accept if the
2486 ;; input is an empty string. Uses KEYMAP, if given, or the
2487 ;; minibuffer-local-map.
2488 ;; Default value is displayed until the user types something in the
2489 ;; minibuffer.
2490 (let ((minibuffer-setup-hook
2491 '(lambda ()
2492 (if (stringp initial)
2493 (progn
2494 (sit-for 840)
2495 (erase-buffer)
2496 (insert initial)))
2497 (vip-minibuffer-setup-sentinel)))
2498 (val "")
2499 (padding "")
2500 temp-msg)
2501
2502 (setq keymap (or keymap minibuffer-local-map)
2503 initial (or initial "")
2504 temp-msg (if default
2505 (format "(default: %s) " default)
2506 ""))
2507
2508 (setq vip-incomplete-ex-cmd nil)
2509 (setq val (read-from-minibuffer prompt
2510 (concat temp-msg initial val padding)
2511 keymap nil history-var))
2512 (setq minibuffer-setup-hook nil
2513 padding (vip-array-to-string (this-command-keys))
2514 temp-msg "")
2515 ;; the following overcomes a glaring bug in history handling
2516 ;; in XEmacs 19.11
2517 (if (not (string= val (car (eval history-var))))
2518 (set history-var (cons val (eval history-var))))
2519 (if (or (string= (nth 0 (eval history-var)) (nth 1 (eval history-var)))
2520 (string= (nth 0 (eval history-var)) ""))
2521 (set history-var (cdr (eval history-var))))
2522 (if (string= val "")
2523 (or default "")
2524 val)))
2525
2526
2527 \f
2528 ;; insertion commands
2529
2530 ;; Called when state changes from Insert Vi command mode.
2531 ;; Repeats the insertion command if Insert state was entered with prefix
2532 ;; argument > 1.
2533 (defun vip-repeat-insert-command ()
2534 (let ((i-com (car vip-d-com))
2535 (val (nth 1 vip-d-com))
2536 (char (nth 2 vip-d-com)))
2537 (if (and val (> val 1)) ; first check that val is non-nil
2538 (progn
2539 (setq vip-d-com (list i-com (1- val) ?r nil nil nil))
2540 (vip-repeat nil)
2541 (setq vip-d-com (list i-com val char nil nil nil))
2542 ))))
2543
2544 (defun vip-insert (arg)
2545 "Insert before point."
2546 (interactive "P")
2547 (vip-set-complex-command-for-undo)
2548 (let ((val (vip-p-val arg))
2549 (com (vip-getcom arg)))
2550 (vip-set-destructive-command (list 'vip-insert val ?r nil nil nil))
2551 (if com
2552 (vip-loop val (vip-yank-last-insertion))
2553 (vip-change-state-to-insert))))
2554
2555 (defun vip-append (arg)
2556 "Append after point."
2557 (interactive "P")
2558 (vip-set-complex-command-for-undo)
2559 (let ((val (vip-p-val arg))
2560 (com (vip-getcom arg)))
2561 (vip-set-destructive-command (list 'vip-append val ?r nil nil nil))
2562 (if (not (eolp)) (forward-char))
2563 (if (equal com ?r)
2564 (vip-loop val (vip-yank-last-insertion))
2565 (vip-change-state-to-insert))))
2566
2567 (defun vip-Append (arg)
2568 "Append at end of line."
2569 (interactive "P")
2570 (vip-set-complex-command-for-undo)
2571 (let ((val (vip-p-val arg))
2572 (com (vip-getcom arg)))
2573 (vip-set-destructive-command (list 'vip-Append val ?r nil nil nil))
2574 (end-of-line)
2575 (if (equal com ?r)
2576 (vip-loop val (vip-yank-last-insertion))
2577 (vip-change-state-to-insert))))
2578
2579 (defun vip-Insert (arg)
2580 "Insert before first non-white."
2581 (interactive "P")
2582 (vip-set-complex-command-for-undo)
2583 (let ((val (vip-p-val arg))
2584 (com (vip-getcom arg)))
2585 (vip-set-destructive-command (list 'vip-Insert val ?r nil nil nil))
2586 (back-to-indentation)
2587 (if (equal com ?r)
2588 (vip-loop val (vip-yank-last-insertion))
2589 (vip-change-state-to-insert))))
2590
2591 (defun vip-open-line (arg)
2592 "Open line below."
2593 (interactive "P")
2594 (vip-set-complex-command-for-undo)
2595 (let ((val (vip-p-val arg))
2596 (com (vip-getcom arg)))
2597 (vip-set-destructive-command (list 'vip-open-line val ?r nil nil nil))
2598 (let ((col (current-indentation)))
2599 (if (equal com ?r)
2600 (vip-loop val
2601 (progn
2602 (end-of-line)
2603 (newline 1)
2604 (if vip-auto-indent
2605 (progn (setq vip-cted t) (indent-to col)))
2606 (vip-yank-last-insertion)))
2607 (end-of-line)
2608 (newline 1)
2609 (if vip-auto-indent (progn (setq vip-cted t) (indent-to col)))
2610 (vip-change-state-to-insert)
2611 ))))
2612
2613 (defun vip-Open-line (arg)
2614 "Open line above."
2615 (interactive "P")
2616 (vip-set-complex-command-for-undo)
2617 (let ((val (vip-p-val arg))
2618 (com (vip-getcom arg)))
2619 (vip-set-destructive-command (list 'vip-Open-line val ?r nil nil nil))
2620 (let ((col (current-indentation)))
2621 (if (equal com ?r)
2622 (vip-loop val
2623 (progn
2624 (beginning-of-line)
2625 (open-line 1)
2626 (if vip-auto-indent
2627 (progn (setq vip-cted t) (indent-to col)))
2628 (vip-yank-last-insertion)))
2629 (beginning-of-line)
2630 (open-line 1)
2631 (if vip-auto-indent (progn (setq vip-cted t) (indent-to col)))
2632 (vip-change-state-to-insert)))))
2633
2634 (defun vip-open-line-at-point (arg)
2635 "Open line at point."
2636 (interactive "P")
2637 (vip-set-complex-command-for-undo)
2638 (let ((val (vip-p-val arg))
2639 (com (vip-getcom arg)))
2640 (vip-set-destructive-command
2641 (list 'vip-open-line-at-point val ?r nil nil nil))
2642 (if (equal com ?r)
2643 (vip-loop val
2644 (progn
2645 (open-line 1)
2646 (vip-yank-last-insertion)))
2647 (open-line 1)
2648 (vip-change-state-to-insert))))
2649
2650 (defun vip-substitute (arg)
2651 "Substitute characters."
2652 (interactive "P")
2653 (let ((val (vip-p-val arg))
2654 (com (vip-getcom arg)))
2655 (push-mark nil t)
2656 (forward-char val)
2657 (if (equal com ?r)
2658 (vip-change-subr (mark t) (point))
2659 (vip-change (mark t) (point)))
2660 (vip-set-destructive-command (list 'vip-substitute val ?r nil nil nil))
2661 ))
2662
2663 (defun vip-substitute-line (arg)
2664 "Substitute lines."
2665 (interactive "p")
2666 (vip-set-complex-command-for-undo)
2667 (vip-line (cons arg ?C)))
2668
2669 ;; Prepare for replace
2670 (defun vip-start-replace ()
2671 (setq vip-began-as-replace t
2672 vip-sitting-in-replace t
2673 vip-replace-chars-to-delete 0
2674 vip-replace-chars-deleted 0)
2675 (add-hook 'vip-after-change-functions 'vip-replace-mode-spy-after t)
2676 (add-hook 'vip-before-change-functions 'vip-replace-mode-spy-before t)
2677 ;; this will get added repeatedly, but no harm
2678 (add-hook 'after-change-functions 'vip-after-change-sentinel t)
2679 (add-hook 'before-change-functions 'vip-before-change-sentinel t)
2680 (vip-move-marker-locally 'vip-last-posn-in-replace-region
2681 (vip-replace-start))
2682 (add-hook 'vip-post-command-hooks 'vip-replace-state-post-command-sentinel t)
2683 (add-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t)
2684 )
2685
2686 ;; Runs vip-after-change-functions inside after-change-functions
2687 (defun vip-after-change-sentinel (beg end len)
2688 (let ((list vip-after-change-functions))
2689 (while list
2690 (funcall (car list) beg end len)
2691 (setq list (cdr list)))))
2692
2693 ;; Runs vip-before-change-functions inside before-change-functions
2694 (defun vip-before-change-sentinel (beg end)
2695 (let ((list vip-before-change-functions))
2696 (while list
2697 (funcall (car list) beg end)
2698 (setq list (cdr list)))))
2699
2700 (defun vip-post-command-sentinel ()
2701 (run-hooks 'vip-post-command-hooks))
2702
2703 (defun vip-pre-command-sentinel ()
2704 (run-hooks 'vip-pre-command-hooks))
2705
2706 ;; Needed so that Viper will be able to figure the last inserted
2707 ;; chunk of text with reasonable accuracy.
2708 (defun vip-insert-state-post-command-sentinel ()
2709 (if (and (memq vip-current-state '(insert-state replace-state))
2710 vip-insert-point
2711 (>= (point) vip-insert-point))
2712 (setq vip-last-posn-while-in-insert-state (point-marker)))
2713 (if (and (eq this-command 'dabbrev-expand)
2714 (integerp vip-pre-command-point)
2715 (> vip-insert-point vip-pre-command-point))
2716 (move-marker vip-insert-point vip-pre-command-point))
2717 )
2718
2719 (defun vip-insert-state-pre-command-sentinel ()
2720 (if (and (eq this-command 'dabbrev-expand)
2721 (markerp vip-insert-point)
2722 (marker-position vip-insert-point))
2723 (setq vip-pre-command-point (marker-position vip-insert-point))))
2724
2725 (defun vip-R-state-post-command-sentinel ()
2726 ;; This is needed despite vip-replace-state-pre-command-sentinel
2727 ;; When you jump to another buffer in another frame, the pre-command
2728 ;; hook won't change cursor color to default in that other frame.
2729 ;; So, if the second frame cursor was red and we set the point
2730 ;; outside the replacement region, then the cursor color woll remain
2731 ;; red. Restoring the default, below, prevents this.
2732 (vip-restore-cursor-color)
2733 (if (and (<= (vip-replace-start) (point))
2734 (<= (point) (vip-replace-end)))
2735 (vip-change-cursor-color vip-replace-overlay-cursor-color)))
2736
2737 (defun vip-replace-state-pre-command-sentinel ()
2738 (vip-restore-cursor-color))
2739
2740 (defun vip-replace-state-post-command-sentinel ()
2741 ;; This is needed despite vip-replace-state-pre-command-sentinel
2742 ;; When you jump to another buffer in another frame, the pre-command
2743 ;; hook won't change cursor color to default in that other frame.
2744 ;; So, if the second frame cursor was red and we set the point
2745 ;; outside the replacement region, then the cursor color woll remain
2746 ;; red. Restoring the default, below, prevents this.
2747 (vip-restore-cursor-color)
2748 (cond
2749 ((eq vip-current-state 'replace-state)
2750 ;; delete characters to compensate for inserted chars.
2751 (let ((replace-boundary
2752 ;; distinguish empty repl-reg-end-symbol from non-empty
2753 (- (vip-replace-end)
2754 (if (eq (length vip-replace-region-end-symbol) 0)
2755 0 1)))
2756 )
2757
2758 (save-excursion
2759 (goto-char vip-last-posn-in-replace-region)
2760 (delete-char vip-replace-chars-to-delete)
2761 (setq vip-replace-chars-to-delete 0
2762 vip-replace-chars-deleted 0)
2763 ;; terminate replace mode if reached replace limit
2764 (if (= vip-last-posn-in-replace-region
2765 (vip-replace-end))
2766 (vip-finish-change vip-last-posn-in-replace-region)))
2767
2768 (if (and (<= (vip-replace-start) (point))
2769 (<= (point) replace-boundary))
2770 (progn
2771 ;; the state may have changed in vip-finish-change above
2772 (if (eq vip-current-state 'replace-state)
2773 (vip-change-cursor-color vip-replace-overlay-cursor-color))
2774 (setq vip-last-posn-in-replace-region (point-marker))))
2775 ))
2776
2777 (t ;; terminate replace mode if changed Viper states.
2778 (vip-finish-change vip-last-posn-in-replace-region)))
2779 )
2780
2781
2782 ;; checks how many chars were deleted by the last change
2783 (defun vip-replace-mode-spy-before (beg end)
2784 (setq vip-replace-chars-deleted (- end beg
2785 (max 0 (- end (vip-replace-end)))
2786 (max 0 (- (vip-replace-start) beg))
2787 ))
2788 )
2789
2790 ;; Invoked as an after-change-function to set up parameters of the last change
2791 (defun vip-replace-mode-spy-after (beg end length)
2792 (if (memq vip-intermediate-command '(repeating-insertion-from-ring))
2793 (progn
2794 (setq vip-replace-chars-to-delete 0)
2795 (vip-move-marker-locally
2796 'vip-last-posn-in-replace-region (point)))
2797
2798 (let (beg-col end-col real-end chars-to-delete)
2799 (setq real-end (min end (vip-replace-end)))
2800 (save-excursion
2801 (goto-char beg)
2802 (setq beg-col (current-column))
2803 (goto-char real-end)
2804 (setq end-col (current-column)))
2805
2806 ;; If beg of change is outside the replacement region, then don't
2807 ;; delete anything in the repl region (set chars-to-delete to 0).
2808 ;;
2809 ;; This works fine except that we have to take special care of
2810 ;; dabbrev-expand. The problem stems from new-dabbrev.el, which
2811 ;; sometimes simply shifts the repl region rightwards, without
2812 ;; deleting an equal amount of characters.
2813 ;;
2814 ;; The reason why new-dabbrev.el causes this are this:
2815 ;; if one dinamically completes a partial word that starts before the
2816 ;; replacement region (but ends inside)then new-dabbrev.el first
2817 ;; moves cursor backwards, to the beginning of the word to be
2818 ;; completed (say, pt A). Then it inserts the
2819 ;; completed word and then deletes the old, incomplete part.
2820 ;; Since the complete word is inserted at position before the repl
2821 ;; region, the next If-statement would have set chars-to-delete to 0
2822 ;; unless we check for the current command, which must be
2823 ;; dabbrev-expand.
2824 ;;
2825 ;; We should be able deal with these problems in a better way
2826 ;; when emacs will have overlays with sticky back ends.
2827 ;; In fact, it would be also useful to add overlays for insert
2828 ;; regions as well, since this will let us capture the situation when
2829 ;; dabbrev-expand goes back past the insertion point to find the
2830 ;; beginning of the word to be expanded.
2831 (if (or (and (<= (vip-replace-start) beg)
2832 (<= beg (vip-replace-end)))
2833 (and (= length 0) (eq this-command 'dabbrev-expand)))
2834 (setq chars-to-delete
2835 (max (- end-col beg-col) (- real-end beg) 0))
2836 (setq chars-to-delete 0))
2837
2838 ;; if beg = last change position, it means that we are within the
2839 ;; same command that does multiple changes. Moreover, it means
2840 ;; that we have two subsequent changes (insert/delete) that
2841 ;; complement each other.
2842 (if (= beg (marker-position vip-last-posn-in-replace-region))
2843 (setq vip-replace-chars-to-delete
2844 (- (+ chars-to-delete vip-replace-chars-to-delete)
2845 vip-replace-chars-deleted))
2846 (setq vip-replace-chars-to-delete chars-to-delete))
2847
2848 (vip-move-marker-locally
2849 'vip-last-posn-in-replace-region
2850 (max (if (> end (vip-replace-end)) (vip-replace-start) end)
2851 (or (marker-position vip-last-posn-in-replace-region)
2852 (vip-replace-start))
2853 ))
2854
2855 (setq vip-replace-chars-to-delete
2856 (max 0 (min vip-replace-chars-to-delete
2857 (- (vip-replace-end)
2858 vip-last-posn-in-replace-region))))
2859 )))
2860
2861
2862 ;; Delete stuff between posn and the end of vip-replace-overlay-marker, if
2863 ;; posn is within the overlay.
2864 (defun vip-finish-change (posn)
2865 (remove-hook 'vip-after-change-functions 'vip-replace-mode-spy-after)
2866 (remove-hook 'vip-before-change-functions 'vip-replace-mode-spy-before)
2867 (remove-hook 'vip-post-command-hooks
2868 'vip-replace-state-post-command-sentinel)
2869 (remove-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel)
2870 (vip-restore-cursor-color)
2871 (setq vip-sitting-in-replace nil) ; just in case we'll need to know it
2872 (save-excursion
2873 (if (and
2874 vip-replace-overlay
2875 (>= posn (vip-replace-start))
2876 (< posn (vip-replace-end)))
2877 (delete-region posn (vip-replace-end)))
2878 )
2879
2880 (if (eq vip-current-state 'replace-state)
2881 (vip-downgrade-to-insert))
2882 ;; replace mode ended => nullify vip-last-posn-in-replace-region
2883 (vip-move-marker-locally 'vip-last-posn-in-replace-region nil)
2884 (vip-hide-replace-overlay)
2885 (vip-refresh-mode-line)
2886 (vip-put-string-on-kill-ring vip-last-replace-region)
2887 )
2888
2889 (defun vip-put-string-on-kill-ring (string)
2890 "Make STRING be the first element of the kill ring."
2891 (setq kill-ring (cons string kill-ring))
2892 (if (> (length kill-ring) kill-ring-max)
2893 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
2894 (setq kill-ring-yank-pointer kill-ring))
2895
2896 (defun vip-finish-R-mode ()
2897 (remove-hook 'vip-post-command-hooks 'vip-R-state-post-command-sentinel)
2898 (remove-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel)
2899 (vip-downgrade-to-insert))
2900
2901 (defun vip-start-R-mode ()
2902 ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number
2903 (overwrite-mode 1)
2904 (add-hook 'vip-post-command-hooks 'vip-R-state-post-command-sentinel t)
2905 (add-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t)
2906 )
2907
2908
2909
2910 (defun vip-replace-state-exit-cmd ()
2911 "Binding for keys that cause Replace state to switch to Vi or to Insert.
2912 These keys are ESC, RET, and LineFeed"
2913 (interactive)
2914 (if overwrite-mode ;; If you are in replace mode invoked via 'R'
2915 (vip-finish-R-mode)
2916 (vip-finish-change vip-last-posn-in-replace-region))
2917 (let (com)
2918 (if (eq this-command 'vip-intercept-ESC-key)
2919 (setq com 'vip-exit-insert-state)
2920 (vip-set-unread-command-events last-input-char)
2921 (setq com (key-binding (read-key-sequence nil))))
2922
2923 (condition-case conds
2924 (command-execute com)
2925 (error
2926 (vip-message-conditions conds)))
2927 )
2928 (vip-hide-replace-overlay))
2929
2930
2931 (defun vip-overwrite (arg)
2932 "This is the function bound to 'R'---unlimited replace.
2933 Similar to Emacs's own overwrite-mode."
2934 (interactive "P")
2935 (let ((val (vip-p-val arg))
2936 (com (vip-getcom arg)) (len))
2937 (vip-set-destructive-command (list 'vip-overwrite val ?r nil nil nil))
2938 (if com
2939 (progn
2940 ;; Viper saves inserted text in vip-last-insertion
2941 (setq len (length vip-last-insertion))
2942 (delete-char len)
2943 (vip-loop val (vip-yank-last-insertion)))
2944 (setq last-command 'vip-overwrite)
2945 (vip-set-complex-command-for-undo)
2946 (vip-set-replace-overlay (point) (vip-line-pos 'end))
2947 (vip-change-state-to-replace)
2948 )))
2949
2950 \f
2951 ;; line commands
2952
2953 (defun vip-line (arg)
2954 (let ((val (car arg))
2955 (com (cdr arg)))
2956 (vip-move-marker-locally 'vip-com-point (point))
2957 (if (not (eobp))
2958 (next-line (1- val)))
2959 ;; this ensures that dd, cc, D, yy will do the right thing on the last
2960 ;; line of buffer when this line has no \n.
2961 (vip-add-newline-at-eob-if-necessary)
2962 (vip-execute-com 'vip-line val com))
2963 (if (and (eobp) (not (bobp))) (forward-line -1))
2964 )
2965
2966 (defun vip-yank-line (arg)
2967 "Yank ARG lines (in Vi's sense)."
2968 (interactive "P")
2969 (let ((val (vip-p-val arg)))
2970 (vip-line (cons val ?Y))))
2971
2972 \f
2973 ;; region commands
2974
2975 (defun vip-region (arg)
2976 (interactive "P")
2977 (let ((val (vip-P-val arg))
2978 (com (vip-getcom arg)))
2979 (vip-move-marker-locally 'vip-com-point (point))
2980 (exchange-point-and-mark)
2981 (vip-execute-com 'vip-region val com)))
2982
2983 (defun vip-Region (arg)
2984 (interactive "P")
2985 (let ((val (vip-P-val arg))
2986 (com (vip-getCom arg)))
2987 (vip-move-marker-locally 'vip-com-point (point))
2988 (exchange-point-and-mark)
2989 (vip-execute-com 'vip-Region val com)))
2990
2991 (defun vip-replace-char (arg)
2992 "Replace the following ARG chars by the character read."
2993 (interactive "P")
2994 (if (and (eolp) (bolp)) (error "I see no character to replace here"))
2995 (let ((val (vip-p-val arg))
2996 (com (vip-getcom arg)))
2997 (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val)
2998 (if (and (eolp) (not (bolp))) (forward-char 1))
2999 (vip-set-destructive-command
3000 (list 'vip-replace-char val ?r nil vip-d-char nil))
3001 ))
3002
3003 (defun vip-replace-char-subr (char arg)
3004 (delete-char arg t)
3005 (setq vip-d-char char)
3006 (vip-loop (if (> arg 0) arg (- arg))
3007 (if (eq char ?\C-m) (insert "\n") (insert char)))
3008 (backward-char arg))
3009
3010 (defun vip-replace-string ()
3011 "The old replace string function.
3012 If you supply null string as the string to be replaced,
3013 the query replace mode will toggle between string replace and regexp replace.
3014 This function comes from VIP 3.5 and is not used in Viper. A nostalgic user
3015 can bind it to a key, if necessary."
3016 (interactive)
3017 (let (str)
3018 (setq str (vip-read-string-with-history
3019 (if vip-re-replace "Replace regexp: " "Replace string: ")
3020 nil ; no initial
3021 'vip-replace1-history
3022 (car vip-replace1-history) ; default
3023 ))
3024 (if (string= str "")
3025 (progn
3026 (setq vip-re-replace (not vip-re-replace))
3027 (message (format "Replace mode changed to %s"
3028 (if vip-re-replace "regexp replace"
3029 "string replace"))))
3030 (if vip-re-replace
3031 (replace-regexp
3032 str
3033 (vip-read-string-with-history
3034 (format "Replace regexp `%s' with: " str)
3035 nil ; no initial
3036 'vip-replace2-history
3037 (car vip-replace2-history) ; default
3038 ))
3039 (replace-string
3040 str
3041 (vip-read-string-with-history
3042 (format "Replace `%s' with: " str)
3043 nil ; no initial
3044 'vip-replace2-history
3045 (car vip-replace2-history) ; default
3046 )))
3047 )))
3048
3049 \f
3050 ;; basic cursor movement. j, k, l, h commands.
3051
3052 (defun vip-forward-char (arg)
3053 "Move point right ARG characters (left if ARG negative).
3054 On reaching end of line, stop and signal error."
3055 (interactive "P")
3056 (let ((val (vip-p-val arg))
3057 (com (vip-getcom arg)))
3058 (if com (vip-move-marker-locally 'vip-com-point (point)))
3059 (if vip-ex-style-motion
3060 (progn
3061 ;; the boundary condition check gets weird here because
3062 ;; forward-char may be the parameter of a delete, and 'dl' works
3063 ;; just like 'x' for the last char on a line, so we have to allow
3064 ;; the forward motion before the 'vip-execute-com', but, of
3065 ;; course, 'dl' doesn't work on an empty line, so we have to
3066 ;; catch that condition before 'vip-execute-com'
3067 (if (and (eolp) (bolp)) (error "") (forward-char val))
3068 (if com (vip-execute-com 'vip-forward-char val com))
3069 (if (eolp) (progn (backward-char 1) (error ""))))
3070 (forward-char val)
3071 (if com (vip-execute-com 'vip-forward-char val com)))))
3072
3073 (defun vip-backward-char (arg)
3074 "Move point left ARG characters (right if ARG negative).
3075 On reaching beginning of line, stop and signal error."
3076 (interactive "P")
3077 (let ((val (vip-p-val arg))
3078 (com (vip-getcom arg)))
3079 (if com (vip-move-marker-locally 'vip-com-point (point)))
3080 (if vip-ex-style-motion
3081 (progn
3082 (if (bolp) (error "") (backward-char val))
3083 (if com (vip-execute-com 'vip-backward-char val com)))
3084 (backward-char val)
3085 (if com (vip-execute-com 'vip-backward-char val com)))))
3086
3087 (defun vip-forward-char-carefully (&optional arg)
3088 "Like forward-char, but doesn't move at end of buffer."
3089 (setq arg (or arg 1))
3090 (if (>= (point-max) (+ (point) arg))
3091 (forward-char arg)
3092 (goto-char (point-max))))
3093
3094 (defun vip-backward-char-carefully (&optional arg)
3095 "Like backward-char, but doesn't move at end of buffer."
3096 (setq arg (or arg 1))
3097 (if (<= (point-min) (- (point) arg))
3098 (backward-char arg)
3099 (goto-char (point-min))))
3100
3101
3102 \f
3103 ;;; Word command
3104
3105 ;; Words are formed from alpha's and nonalphas - <sp>,\t\n are separators
3106 ;; for word movement. When executed with a destructive command, \n is
3107 ;; usually left untouched for the last word.
3108
3109 ;; skip only one \n
3110 (defun vip-skip-separators (forward)
3111 (if forward
3112 (progn
3113 (skip-chars-forward " \t")
3114 (if (looking-at "\n")
3115 (progn
3116 (forward-char)
3117 (skip-chars-forward " \t"))))
3118 (skip-chars-backward " \t")
3119 (backward-char)
3120 (if (looking-at "\n")
3121 (skip-chars-backward " \t")
3122 (forward-char))))
3123
3124 (defconst vip-ALPHA "a-zA-Z0-9_")
3125 (defconst vip-ALPHA-B (concat "[" vip-ALPHA "]"))
3126 (defconst vip-NONALPHA (concat "^" vip-ALPHA))
3127 (defconst vip-NONALPHA-B (concat "[" vip-NONALPHA "]"))
3128 (defconst vip-SEP " \t\n")
3129 (defconst vip-SEP-B (concat "[" vip-SEP "]"))
3130 (defconst vip-NONSEP (concat "^" vip-SEP))
3131 (defconst vip-NONSEP-B (concat "[" vip-NONSEP "]"))
3132 (defconst vip-ALPHASEP (concat vip-ALPHA vip-SEP))
3133 (defconst vip-ALPHASEP-B (concat "[" vip-ALPHASEP "]"))
3134 (defconst vip-NONALPHASEP (concat "^" vip-ALPHASEP ))
3135 (defconst vip-NONALPHASEP-B (concat "[" vip-NONALPHASEP "]"))
3136
3137
3138 (defun vip-forward-word-kernel (val)
3139 (while (> val 0)
3140 (cond ((looking-at vip-ALPHA-B)
3141 (skip-chars-forward vip-ALPHA)
3142 (vip-skip-separators t))
3143 ((looking-at vip-SEP-B)
3144 (vip-skip-separators t))
3145 ((looking-at vip-NONALPHASEP-B)
3146 (skip-chars-forward vip-NONALPHASEP)
3147 (vip-skip-separators t)))
3148 (setq val (1- val))))
3149
3150 (defun vip-fwd-skip (pat aux-pat lim)
3151 (if (and (save-excursion
3152 (re-search-backward pat lim t))
3153 (= (point) (match-end 0)))
3154 (goto-char (match-beginning 0)))
3155 (skip-chars-backward aux-pat lim)
3156 (if (= (point) lim)
3157 (vip-forward-char-carefully))
3158 )
3159
3160
3161 (defun vip-forward-word (arg)
3162 "Forward word."
3163 (interactive "P")
3164 (let ((val (vip-p-val arg))
3165 (com (vip-getcom arg)))
3166 (if com (vip-move-marker-locally 'vip-com-point (point)))
3167 (vip-forward-word-kernel val)
3168 (if com (progn
3169 (cond ((memq com (list ?c (- ?c) ?y (- ?y)))
3170 (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point))
3171 ((vip-dotable-command-p com)
3172 (vip-fwd-skip "\n[ \t]*" "" vip-com-point)))
3173 (vip-execute-com 'vip-forward-word val com)))))
3174
3175
3176 (defun vip-forward-Word (arg)
3177 "Forward word delimited by white character."
3178 (interactive "P")
3179 (let ((val (vip-p-val arg))
3180 (com (vip-getcom arg)))
3181 (if com (vip-move-marker-locally 'vip-com-point (point)))
3182 (vip-loop val
3183 (progn
3184 (skip-chars-forward vip-NONSEP)
3185 (vip-skip-separators t)))
3186 (if com (progn
3187 (cond ((memq com (list ?c (- ?c) ?y (- ?y)))
3188 (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point))
3189 ((vip-dotable-command-p com)
3190 (vip-fwd-skip "\n[ \t]*" "" vip-com-point)))
3191 (vip-execute-com 'vip-forward-Word val com)))))
3192
3193
3194 ;; this is a bit different from Vi, but Vi's end of word
3195 ;; makes no sense whatsoever
3196 (defun vip-end-of-word-kernel ()
3197 (if (vip-end-of-word-p) (forward-char))
3198 (if (looking-at "[ \t\n]")
3199 (skip-chars-forward vip-SEP))
3200
3201 (cond ((looking-at vip-ALPHA-B) (skip-chars-forward vip-ALPHA))
3202 ((looking-at vip-NONALPHASEP-B)
3203 (skip-chars-forward vip-NONALPHASEP)))
3204 (vip-backward-char-carefully))
3205
3206 (defun vip-end-of-word-p ()
3207 (if (eobp) t
3208 (save-excursion
3209 (cond ((looking-at vip-ALPHA-B)
3210 (forward-char)
3211 (looking-at vip-NONALPHA-B))
3212 ((looking-at vip-NONALPHASEP-B)
3213 (forward-char)
3214 (looking-at vip-ALPHASEP-B))))))
3215
3216 (defun vip-one-char-word-p ()
3217 (let ((step 2))
3218 (save-excursion
3219 (cond ((looking-at vip-ALPHA-B)
3220 (if (bobp) (setq step 1) (backward-char))
3221 (if (or (bobp) (looking-at vip-NONALPHA-B))
3222 (progn
3223 (forward-char step)
3224 (looking-at vip-NONALPHA-B))
3225 nil))
3226 ((looking-at vip-NONALPHASEP-B)
3227 (if (bobp) (setq step 1) (backward-char))
3228 (if (or (bobp) (looking-at vip-ALPHASEP-B))
3229 (progn
3230 (forward-char step)
3231 (looking-at vip-ALPHASEP-B))
3232 nil))))))
3233
3234 (defun vip-one-char-Word-p ()
3235 (and (looking-at vip-NONSEP-B)
3236 (save-excursion
3237 (if (bobp)
3238 t
3239 (backward-char)
3240 (looking-at vip-SEP-B)))
3241 (save-excursion
3242 (forward-char)
3243 (or (eobp)
3244 (looking-at vip-SEP-B)))))
3245
3246 (defun vip-end-of-word (arg &optional careful)
3247 "Move point to end of current word."
3248 (interactive "P")
3249 (let ((val (vip-p-val arg))
3250 (com (vip-getcom arg)))
3251 (if com (vip-move-marker-locally 'vip-com-point (point)))
3252 (vip-loop val (vip-end-of-word-kernel))
3253 (if com
3254 (progn
3255 (forward-char)
3256 (vip-execute-com 'vip-end-of-word val com)))))
3257
3258 (defun vip-end-of-Word (arg)
3259 "Forward to end of word delimited by white character."
3260 (interactive "P")
3261 (let ((val (vip-p-val arg))
3262 (com (vip-getcom arg)))
3263 (if com (vip-move-marker-locally 'vip-com-point (point)))
3264 (vip-loop val
3265 (progn
3266 (vip-end-of-word-kernel)
3267 (if (not (re-search-forward
3268 vip-SEP-B nil t 1))
3269 (goto-char (point-max)))
3270 (skip-chars-backward vip-SEP)
3271 (backward-char)))
3272 (if com
3273 (progn
3274 (forward-char)
3275 (vip-execute-com 'vip-end-of-Word val com)))))
3276
3277 (defun vip-backward-word-kernel (val)
3278 (while (> val 0)
3279 (backward-char)
3280 (cond ((looking-at vip-ALPHA-B)
3281 (skip-chars-backward vip-ALPHA))
3282 ((looking-at vip-SEP-B)
3283 (forward-char)
3284 (vip-skip-separators nil)
3285 (backward-char)
3286 (cond ((looking-at vip-ALPHA-B)
3287 (skip-chars-backward vip-ALPHA))
3288 ((looking-at vip-NONALPHASEP-B)
3289 (skip-chars-backward vip-NONALPHASEP))
3290 (t (forward-char))))
3291 ((looking-at vip-NONALPHASEP-B)
3292 (skip-chars-backward vip-NONALPHASEP)))
3293 (setq val (1- val))))
3294
3295 (defun vip-backward-word (arg)
3296 "Backward word."
3297 (interactive "P")
3298 (let ((val (vip-p-val arg))
3299 (com (vip-getcom arg)))
3300 (if com
3301 (let (i)
3302 (if (setq i (save-excursion (backward-char) (looking-at "\n")))
3303 (backward-char))
3304 (vip-move-marker-locally 'vip-com-point (point))
3305 (if i (forward-char))))
3306 (vip-backward-word-kernel val)
3307 (if com (vip-execute-com 'vip-backward-word val com))))
3308
3309 (defun vip-backward-Word (arg)
3310 "Backward word delimited by white character."
3311 (interactive "P")
3312 (let ((val (vip-p-val arg))
3313 (com (vip-getcom arg)))
3314 (if com
3315 (let (i)
3316 (if (setq i (save-excursion (backward-char) (looking-at "\n")))
3317 (backward-char))
3318 (vip-move-marker-locally 'vip-com-point (point))
3319 (if i (forward-char))))
3320 (vip-loop val
3321 (progn
3322 (vip-skip-separators nil)
3323 (skip-chars-backward vip-NONSEP)))
3324 (if com (vip-execute-com 'vip-backward-Word val com))))
3325
3326
3327 \f
3328 ;; line commands
3329
3330 (defun vip-beginning-of-line (arg)
3331 "Go to beginning of line."
3332 (interactive "P")
3333 (let ((val (vip-p-val arg))
3334 (com (vip-getcom arg)))
3335 (if com (vip-move-marker-locally 'vip-com-point (point)))
3336 (beginning-of-line val)
3337 (if com (vip-execute-com 'vip-beginning-of-line val com))))
3338
3339 (defun vip-bol-and-skip-white (arg)
3340 "Beginning of line at first non-white character."
3341 (interactive "P")
3342 (let ((val (vip-p-val arg))
3343 (com (vip-getcom arg)))
3344 (if com (vip-move-marker-locally 'vip-com-point (point)))
3345 (forward-to-indentation (1- val))
3346 (if com (vip-execute-com 'vip-bol-and-skip-white val com))))
3347
3348 (defun vip-goto-eol (arg)
3349 "Go to end of line."
3350 (interactive "P")
3351 (let ((val (vip-p-val arg))
3352 (com (vip-getcom arg)))
3353 (if com (vip-move-marker-locally 'vip-com-point (point)))
3354 (end-of-line val)
3355 (if com (vip-execute-com 'vip-goto-eol val com))
3356 (if vip-ex-style-motion
3357 (if (and (eolp) (not (bolp))
3358 ;; a fix for vip-change-to-eol
3359 (not (equal vip-current-state 'insert-state)))
3360 (backward-char 1)
3361 ))))
3362
3363
3364 (defun vip-goto-col (arg)
3365 "Go to ARG's column."
3366 (interactive "P")
3367 (let ((val (vip-p-val arg))
3368 (com (vip-getcom arg)))
3369 (save-excursion
3370 (end-of-line)
3371 (if (> val (1+ (current-column))) (error "")))
3372 (if com (vip-move-marker-locally 'vip-com-point (point)))
3373 (beginning-of-line)
3374 (forward-char (1- val))
3375 (if com (vip-execute-com 'vip-goto-col val com))))
3376
3377
3378 (defun vip-next-line (arg)
3379 "Go to next line."
3380 (interactive "P")
3381 (let ((val (vip-p-val arg))
3382 (com (vip-getCom arg)))
3383 (if com (vip-move-marker-locally 'vip-com-point (point)))
3384 (next-line val)
3385 (if vip-ex-style-motion
3386 (if (and (eolp) (not (bolp))) (backward-char 1)))
3387 (setq this-command 'next-line)
3388 (if com (vip-execute-com 'vip-next-line val com))))
3389
3390 (defun vip-next-line-at-bol (arg)
3391 "Next line at beginning of line."
3392 (interactive "P")
3393 (save-excursion
3394 (end-of-line)
3395 (if (eobp) (error "Last line in buffer")))
3396 (let ((val (vip-p-val arg))
3397 (com (vip-getCom arg)))
3398 (if com (vip-move-marker-locally 'vip-com-point (point)))
3399 (forward-line val)
3400 (back-to-indentation)
3401 (if com (vip-execute-com 'vip-next-line-at-bol val com))))
3402
3403 (defun vip-previous-line (arg)
3404 "Go to previous line."
3405 (interactive "P")
3406 (let ((val (vip-p-val arg))
3407 (com (vip-getCom arg)))
3408 (if com (vip-move-marker-locally 'vip-com-point (point)))
3409 (previous-line val)
3410 (if vip-ex-style-motion
3411 (if (and (eolp) (not (bolp))) (backward-char 1)))
3412 (setq this-command 'previous-line)
3413 (if com (vip-execute-com 'vip-previous-line val com))))
3414
3415
3416 (defun vip-previous-line-at-bol (arg)
3417 "Previous line at beginning of line."
3418 (interactive "P")
3419 (save-excursion
3420 (beginning-of-line)
3421 (if (bobp) (error "First line in buffer")))
3422 (let ((val (vip-p-val arg))
3423 (com (vip-getCom arg)))
3424 (if com (vip-move-marker-locally 'vip-com-point (point)))
3425 (forward-line (- val))
3426 (back-to-indentation)
3427 (if com (vip-execute-com 'vip-previous-line val com))))
3428
3429 (defun vip-change-to-eol (arg)
3430 "Change to end of line."
3431 (interactive "P")
3432 (vip-goto-eol (cons arg ?c)))
3433
3434 (defun vip-kill-line (arg)
3435 "Delete line."
3436 (interactive "P")
3437 (vip-goto-eol (cons arg ?d)))
3438
3439 (defun vip-erase-line (arg)
3440 "Erase line."
3441 (interactive "P")
3442 (vip-beginning-of-line (cons arg ?d)))
3443
3444 \f
3445 ;; moving around
3446
3447 (defun vip-goto-line (arg)
3448 "Go to ARG's line. Without ARG go to end of buffer."
3449 (interactive "P")
3450 (let ((val (vip-P-val arg))
3451 (com (vip-getCom arg)))
3452 (vip-move-marker-locally 'vip-com-point (point))
3453 (vip-deactivate-mark)
3454 (push-mark nil t)
3455 (if (null val)
3456 (goto-char (point-max))
3457 (goto-char (point-min))
3458 (forward-line (1- val)))
3459 (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
3460 (back-to-indentation)
3461 (if com (vip-execute-com 'vip-goto-line val com))))
3462
3463 (defun vip-find-char (arg char forward offset)
3464 "Find ARG's occurrence of CHAR on the current line.
3465 If FORWARD then search is forward, otherwise backward. OFFSET is used to
3466 adjust point after search."
3467 (or (char-or-string-p char) (error ""))
3468 (let ((arg (if forward arg (- arg)))
3469 (cmd (if (eq vip-intermediate-command 'vip-repeat)
3470 (nth 5 vip-d-com)
3471 (vip-array-to-string (this-command-keys))))
3472 point)
3473 (save-excursion
3474 (save-restriction
3475 (if (> arg 0)
3476 (narrow-to-region
3477 ;; forward search begins here
3478 (if (eolp) (error "Command `%s': At end of line" cmd) (point))
3479 ;; forward search ends here
3480 (progn (end-of-line) (point)))
3481 (narrow-to-region
3482 ;; backward search begins from here
3483 (if (bolp)
3484 (error "Command `%s': At beginning of line" cmd) (point))
3485 ;; backward search ends here
3486 (progn (beginning-of-line) (point))))
3487 ;; if arg > 0, point is forwarded before search.
3488 (if (> arg 0) (goto-char (1+ (point-min)))
3489 (goto-char (point-max)))
3490 (if (let ((case-fold-search nil))
3491 (search-forward (char-to-string char) nil 0 arg))
3492 (setq point (point))
3493 (error "Command `%s': `%c' not found" cmd char))))
3494 (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0))))))
3495
3496 (defun vip-find-char-forward (arg)
3497 "Find char on the line.
3498 If called interactively read the char to find from the terminal, and if
3499 called from vip-repeat, the char last used is used. This behaviour is
3500 controlled by the sign of prefix numeric value."
3501 (interactive "P")
3502 (let ((val (vip-p-val arg))
3503 (com (vip-getcom arg)))
3504 (if (> val 0)
3505 ;; this means that the function was called interactively
3506 (setq vip-f-char (read-char)
3507 vip-f-forward t
3508 vip-f-offset nil)
3509 ;; vip-repeat --- set vip-F-char from command-keys
3510 (setq vip-F-char (if (stringp (nth 5 vip-d-com))
3511 (vip-seq-last-elt (nth 5 vip-d-com))
3512 vip-F-char)
3513 vip-f-char vip-F-char)
3514 (setq val (- val)))
3515 (if com (vip-move-marker-locally 'vip-com-point (point)))
3516 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil)
3517 (setq val (- val))
3518 (if com
3519 (progn
3520 (setq vip-F-char vip-f-char) ; set new vip-F-char
3521 (forward-char)
3522 (vip-execute-com 'vip-find-char-forward val com)))))
3523
3524 (defun vip-goto-char-forward (arg)
3525 "Go up to char ARG forward on line."
3526 (interactive "P")
3527 (let ((val (vip-p-val arg))
3528 (com (vip-getcom arg)))
3529 (if (> val 0)
3530 ;; this means that the function was called interactively
3531 (setq vip-f-char (read-char)
3532 vip-f-forward t
3533 vip-f-offset t)
3534 ;; vip-repeat --- set vip-F-char from command-keys
3535 (setq vip-F-char (if (stringp (nth 5 vip-d-com))
3536 (vip-seq-last-elt (nth 5 vip-d-com))
3537 vip-F-char)
3538 vip-f-char vip-F-char)
3539 (setq val (- val)))
3540 (if com (vip-move-marker-locally 'vip-com-point (point)))
3541 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t)
3542 (setq val (- val))
3543 (if com
3544 (progn
3545 (setq vip-F-char vip-f-char) ; set new vip-F-char
3546 (forward-char)
3547 (vip-execute-com 'vip-goto-char-forward val com)))))
3548
3549 (defun vip-find-char-backward (arg)
3550 "Find char ARG on line backward."
3551 (interactive "P")
3552 (let ((val (vip-p-val arg))
3553 (com (vip-getcom arg)))
3554 (if (> val 0)
3555 ;; this means that the function was called interactively
3556 (setq vip-f-char (read-char)
3557 vip-f-forward nil
3558 vip-f-offset nil)
3559 ;; vip-repeat --- set vip-F-char from command-keys
3560 (setq vip-F-char (if (stringp (nth 5 vip-d-com))
3561 (vip-seq-last-elt (nth 5 vip-d-com))
3562 vip-F-char)
3563 vip-f-char vip-F-char)
3564 (setq val (- val)))
3565 (if com (vip-move-marker-locally 'vip-com-point (point)))
3566 (vip-find-char
3567 val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil)
3568 (setq val (- val))
3569 (if com
3570 (progn
3571 (setq vip-F-char vip-f-char) ; set new vip-F-char
3572 (vip-execute-com 'vip-find-char-backward val com)))))
3573
3574 (defun vip-goto-char-backward (arg)
3575 "Go up to char ARG backward on line."
3576 (interactive "P")
3577 (let ((val (vip-p-val arg))
3578 (com (vip-getcom arg)))
3579 (if (> val 0)
3580 ;; this means that the function was called interactively
3581 (setq vip-f-char (read-char)
3582 vip-f-forward nil
3583 vip-f-offset t)
3584 ;; vip-repeat --- set vip-F-char from command-keys
3585 (setq vip-F-char (if (stringp (nth 5 vip-d-com))
3586 (vip-seq-last-elt (nth 5 vip-d-com))
3587 vip-F-char)
3588 vip-f-char vip-F-char)
3589 (setq val (- val)))
3590 (if com (vip-move-marker-locally 'vip-com-point (point)))
3591 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t)
3592 (setq val (- val))
3593 (if com
3594 (progn
3595 (setq vip-F-char vip-f-char) ; set new vip-F-char
3596 (vip-execute-com 'vip-goto-char-backward val com)))))
3597
3598 (defun vip-repeat-find (arg)
3599 "Repeat previous find command."
3600 (interactive "P")
3601 (let ((val (vip-p-val arg))
3602 (com (vip-getcom arg)))
3603 (vip-deactivate-mark)
3604 (if com (vip-move-marker-locally 'vip-com-point (point)))
3605 (vip-find-char val vip-f-char vip-f-forward vip-f-offset)
3606 (if com
3607 (progn
3608 (if vip-f-forward (forward-char))
3609 (vip-execute-com 'vip-repeat-find val com)))))
3610
3611 (defun vip-repeat-find-opposite (arg)
3612 "Repeat previous find command in the opposite direction."
3613 (interactive "P")
3614 (let ((val (vip-p-val arg))
3615 (com (vip-getcom arg)))
3616 (vip-deactivate-mark)
3617 (if com (vip-move-marker-locally 'vip-com-point (point)))
3618 (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset)
3619 (if com
3620 (progn
3621 (if vip-f-forward (forward-char))
3622 (vip-execute-com 'vip-repeat-find-opposite val com)))))
3623
3624 \f
3625 ;; window scrolling etc.
3626
3627 (defun vip-other-window (arg)
3628 "Switch to other window."
3629 (interactive "p")
3630 (other-window arg)
3631 (or (not (eq vip-current-state 'emacs-state))
3632 (string= (buffer-name (current-buffer)) " *Minibuf-1*")
3633 (vip-change-state-to-vi)))
3634
3635 (defun vip-window-top (arg)
3636 "Go to home window line."
3637 (interactive "P")
3638 (let ((val (vip-p-val arg))
3639 (com (vip-getCom arg)))
3640 (if com (vip-move-marker-locally 'vip-com-point (point)))
3641 (push-mark nil t)
3642 (move-to-window-line (1- val))
3643 (if (not com) (back-to-indentation))
3644 (if com (vip-execute-com 'vip-window-top val com))))
3645
3646 (defun vip-window-middle (arg)
3647 "Go to middle window line."
3648 (interactive "P")
3649 (let ((val (vip-p-val arg))
3650 (com (vip-getCom arg)))
3651 (if com (vip-move-marker-locally 'vip-com-point (point)))
3652 (push-mark nil t)
3653 (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
3654 (if (not com) (back-to-indentation))
3655 (if com (vip-execute-com 'vip-window-middle val com))))
3656
3657 (defun vip-window-bottom (arg)
3658 "Go to last window line."
3659 (interactive "P")
3660 (let ((val (vip-p-val arg))
3661 (com (vip-getCom arg)))
3662 (if com (vip-move-marker-locally 'vip-com-point (point)))
3663 (push-mark nil t)
3664 (move-to-window-line (- val))
3665 (if (not com) (back-to-indentation))
3666 (if com (vip-execute-com 'vip-window-bottom val com))))
3667
3668 (defun vip-line-to-top (arg)
3669 "Put current line on the home line."
3670 (interactive "p")
3671 (recenter (1- arg)))
3672
3673 (defun vip-line-to-middle (arg)
3674 "Put current line on the middle line."
3675 (interactive "p")
3676 (recenter (+ (1- arg) (/ (1- (window-height)) 2))))
3677
3678 (defun vip-line-to-bottom (arg)
3679 "Put current line on the last line."
3680 (interactive "p")
3681 (recenter (- (window-height) (1+ arg))))
3682
3683 \f
3684 ;; paren match
3685 ;; must correct this to only match ( to ) etc. On the other hand
3686 ;; it is good that paren match gets confused, because that way you
3687 ;; catch _all_ imbalances.
3688
3689 (defun vip-paren-match (arg)
3690 "Go to the matching parenthesis."
3691 (interactive "P")
3692 (let ((com (vip-getcom arg)))
3693 (if (numberp arg)
3694 (if (or (> arg 99) (< arg 1))
3695 (error "Prefix must be between 1 and 99")
3696 (goto-char
3697 (if (> (point-max) 80000)
3698 (* (/ (point-max) 100) arg)
3699 (/ (* (point-max) arg) 100)))
3700 (back-to-indentation))
3701 (let (lim)
3702 (if (and (eolp) (not (bolp))) (forward-char -1))
3703 (save-excursion
3704 (end-of-line)
3705 (setq lim (point)))
3706 (if (re-search-forward "[][(){}]" lim t)
3707 (backward-char)
3708 (error "No matching character on line")))
3709 (cond ((looking-at "[\(\[{]")
3710 (if com (vip-move-marker-locally 'vip-com-point (point)))
3711 (forward-sexp 1)
3712 (if com
3713 (vip-execute-com 'vip-paren-match nil com)
3714 (backward-char)))
3715 ((looking-at "[])}]")
3716 (forward-char)
3717 (if com (vip-move-marker-locally 'vip-com-point (point)))
3718 (backward-sexp 1)
3719 (if com (vip-execute-com 'vip-paren-match nil com)))
3720 (t (error ""))))))
3721
3722 \f
3723 ;; sentence ,paragraph and heading
3724
3725 (defun vip-forward-sentence (arg)
3726 "Forward sentence."
3727 (interactive "P")
3728 (push-mark nil t)
3729 (let ((val (vip-p-val arg))
3730 (com (vip-getcom arg)))
3731 (if com (vip-move-marker-locally 'vip-com-point (point)))
3732 (forward-sentence val)
3733 (if com (vip-execute-com 'vip-forward-sentence nil com))))
3734
3735 (defun vip-backward-sentence (arg)
3736 "Backward sentence."
3737 (interactive "P")
3738 (push-mark nil t)
3739 (let ((val (vip-p-val arg))
3740 (com (vip-getcom arg)))
3741 (if com (vip-move-marker-locally 'vip-com-point (point)))
3742 (backward-sentence val)
3743 (if com (vip-execute-com 'vip-backward-sentence nil com))))
3744
3745 (defun vip-forward-paragraph (arg)
3746 "Forward paragraph."
3747 (interactive "P")
3748 (push-mark nil t)
3749 (let ((val (vip-p-val arg))
3750 (com (vip-getCom arg)))
3751 (if com (vip-move-marker-locally 'vip-com-point (point)))
3752 (forward-paragraph val)
3753 (if com (vip-execute-com 'vip-forward-paragraph nil com))))
3754
3755 (defun vip-backward-paragraph (arg)
3756 "Backward paragraph."
3757 (interactive "P")
3758 (push-mark nil t)
3759 (let ((val (vip-p-val arg))
3760 (com (vip-getCom arg)))
3761 (if com (vip-move-marker-locally 'vip-com-point (point)))
3762 (backward-paragraph val)
3763 (if com (vip-execute-com 'vip-backward-paragraph nil com))))
3764
3765 ;; should be mode-specific etc.
3766
3767 (defun vip-prev-heading (arg)
3768 (interactive "P")
3769 (let ((val (vip-p-val arg))
3770 (com (vip-getCom arg)))
3771 (if com (vip-move-marker-locally 'vip-com-point (point)))
3772 (re-search-backward vip-heading-start nil t val)
3773 (goto-char (match-beginning 0))
3774 (if com (vip-execute-com 'vip-prev-heading nil com))))
3775
3776 (defun vip-heading-end (arg)
3777 (interactive "P")
3778 (let ((val (vip-p-val arg))
3779 (com (vip-getCom arg)))
3780 (if com (vip-move-marker-locally 'vip-com-point (point)))
3781 (re-search-forward vip-heading-end nil t val)
3782 (goto-char (match-beginning 0))
3783 (if com (vip-execute-com 'vip-heading-end nil com))))
3784
3785 (defun vip-next-heading (arg)
3786 (interactive "P")
3787 (let ((val (vip-p-val arg))
3788 (com (vip-getCom arg)))
3789 (if com (vip-move-marker-locally 'vip-com-point (point)))
3790 (end-of-line)
3791 (re-search-forward vip-heading-start nil t val)
3792 (goto-char (match-beginning 0))
3793 (if com (vip-execute-com 'vip-next-heading nil com))))
3794
3795 \f
3796 ;; scrolling
3797
3798 (setq scroll-step 1)
3799
3800 (defun vip-scroll (arg)
3801 "Scroll to next screen."
3802 (interactive "p")
3803 (if (> arg 0)
3804 (while (> arg 0)
3805 (scroll-up)
3806 (setq arg (1- arg)))
3807 (while (> 0 arg)
3808 (scroll-down)
3809 (setq arg (1+ arg)))))
3810
3811 (defun vip-scroll-back (arg)
3812 "Scroll to previous screen."
3813 (interactive "p")
3814 (vip-scroll (- arg)))
3815
3816 (defun vip-scroll-down (arg)
3817 "Pull down half screen."
3818 (interactive "P")
3819 (condition-case nil
3820 (if (null arg)
3821 (scroll-down (/ (window-height) 2))
3822 (scroll-down arg))
3823 (error (beep 1)
3824 (message "Beginning of buffer")
3825 (goto-char (point-min)))))
3826
3827 (defun vip-scroll-down-one (arg)
3828 "Scroll up one line."
3829 (interactive "p")
3830 (scroll-down arg))
3831
3832 (defun vip-scroll-up (arg)
3833 "Pull up half screen."
3834 (interactive "P")
3835 (condition-case nil
3836 (if (null arg)
3837 (scroll-up (/ (window-height) 2))
3838 (scroll-up arg))
3839 (error (beep 1)
3840 (message "End of buffer")
3841 (goto-char (point-max)))))
3842
3843 (defun vip-scroll-up-one (arg)
3844 "Scroll down one line."
3845 (interactive "p")
3846 (scroll-up arg))
3847
3848 \f
3849 ;; searching
3850
3851 (defun vip-if-string (prompt)
3852 (let ((s (vip-read-string-with-history
3853 prompt
3854 nil ; no initial
3855 'vip-search-history
3856 (car vip-search-history))))
3857 (if (not (string= s ""))
3858 (setq vip-s-string s))))
3859
3860
3861 (defun vip-toggle-search-style (arg)
3862 "Toggle the value of vip-case-fold-search/vip-re-search.
3863 Without prefix argument, will ask which search style to toggle. With prefix
3864 arg 1,toggles vip-case-fold-search; with arg 2 toggles vip-re-search.
3865
3866 Although this function is bound to \\[vip-toggle-search-style], the most
3867 convenient way to use it is to bind `//' to the macro
3868 `1 M-x vip-toggle-search-style' and `///' to
3869 `2 M-x vip-toggle-search-style'. In this way, hitting `//' quickly will
3870 toggle case-fold-search and hitting `/' three times witth toggle regexp
3871 search. Macros are more convenient in this case because they don't affect
3872 the Emacs binding of `/'."
3873 (interactive "P")
3874 (let (msg)
3875 (cond ((or (eq arg 1)
3876 (and (null arg)
3877 (y-or-n-p (format "Search style: '%s'. Want '%s'? "
3878 (if vip-case-fold-search
3879 "case-insensitive" "case-sensitive")
3880 (if vip-case-fold-search
3881 "case-sensitive"
3882 "case-insensitive")))))
3883 (setq vip-case-fold-search (null vip-case-fold-search))
3884 (if vip-case-fold-search
3885 (setq msg "Search becomes case-insensitive")
3886 (setq msg "Search becomes case-sensitive")))
3887 ((or (eq arg 2)
3888 (and (null arg)
3889 (y-or-n-p (format "Search style: '%s'. Want '%s'? "
3890 (if vip-re-search
3891 "regexp-search" "vanilla-search")
3892 (if vip-re-search
3893 "vanilla-search"
3894 "regexp-search")))))
3895 (setq vip-re-search (null vip-re-search))
3896 (if vip-re-search
3897 (setq msg "Search becomes regexp-style")
3898 (setq msg "Search becomes vanilla-style")))
3899 (t
3900 (setq msg "Search style remains unchanged")))
3901 (prin1 msg t)))
3902
3903
3904 (defun vip-search-forward (arg)
3905 "Search a string forward.
3906 ARG is used to find the ARG's occurrence of the string.
3907 Null string will repeat previous search."
3908 (interactive "P")
3909 (let ((val (vip-P-val arg))
3910 (com (vip-getcom arg))
3911 (old-str vip-s-string))
3912 (setq vip-s-forward t)
3913 (vip-if-string "/")
3914 ;; this is not used at present, but may be used later
3915 (if (or (not (equal old-str vip-s-string))
3916 (not (markerp vip-local-search-start-marker))
3917 (not (marker-buffer vip-local-search-start-marker)))
3918 (setq vip-local-search-start-marker (point-marker)))
3919 (vip-search vip-s-string t val)
3920 (if com
3921 (progn
3922 (vip-move-marker-locally 'vip-com-point (mark t))
3923 (vip-execute-com 'vip-search-next val com)))))
3924
3925 (defun vip-search-backward (arg)
3926 "Search a string backward.
3927 ARG is used to find the ARG's occurrence of the string.
3928 Null string will repeat previous search."
3929 (interactive "P")
3930 (let ((val (vip-P-val arg))
3931 (com (vip-getcom arg))
3932 (old-str vip-s-string))
3933 (setq vip-s-forward nil)
3934 (vip-if-string "?")
3935 ;; this is not used at present, but may be used later
3936 (if (or (not (equal old-str vip-s-string))
3937 (not (markerp vip-local-search-start-marker))
3938 (not (marker-buffer vip-local-search-start-marker)))
3939 (setq vip-local-search-start-marker (point-marker)))
3940 (vip-search vip-s-string nil val)
3941 (if com
3942 (progn
3943 (vip-move-marker-locally 'vip-com-point (mark t))
3944 (vip-execute-com 'vip-search-next val com)))))
3945
3946
3947 (defun vip-search (string forward arg &optional no-offset init-point)
3948 "Search for COUNT's occurrence of STRING.
3949 Search is forward if FORWARD is non-nil, otherwise backward.
3950 INIT-POINT is the position where search is to start.
3951 Arguments: (STRING FORWARD COUNT &optional NO-OFFSET INIT-POINT LIMIT)."
3952 (if (not (equal string ""))
3953 (let ((val (vip-p-val arg))
3954 (com (vip-getcom arg))
3955 (null-arg (null (vip-P-val arg))) (offset (not no-offset))
3956 (case-fold-search vip-case-fold-search)
3957 (start-point (or init-point (point))))
3958 (vip-deactivate-mark)
3959 (if forward
3960 (condition-case nil
3961 (progn
3962 (if offset (vip-forward-char-carefully))
3963 (if vip-re-search
3964 (progn
3965 (re-search-forward string nil nil val)
3966 (re-search-backward string))
3967 (search-forward string nil nil val)
3968 (search-backward string))
3969 (vip-flash-search-pattern)
3970 (if (not (equal start-point (point)))
3971 (push-mark start-point t)))
3972 (search-failed
3973 (if (and null-arg vip-search-wrap-around-t)
3974 (progn
3975 (message "Search wrapped around end of buffer")
3976 (goto-char (point-min))
3977 (vip-search string forward (cons 1 com) t start-point)
3978 ;; delete the wrapped around message
3979 (sit-for 2)(message "")
3980 )
3981 (goto-char start-point)
3982 (error "`%s': %s not found"
3983 string
3984 (if vip-re-search "Pattern" "String"))
3985 )))
3986 ;; backward
3987 (condition-case nil
3988 (progn
3989 (if vip-re-search
3990 (re-search-backward string nil nil val)
3991 (search-backward string nil nil val))
3992 (vip-flash-search-pattern)
3993 (if (not (equal start-point (point)))
3994 (push-mark start-point t)))
3995 (search-failed
3996 (if (and null-arg vip-search-wrap-around-t)
3997 (progn
3998 (message "Search wrapped around beginning of buffer")
3999 (goto-char (point-max))
4000 (vip-search string forward (cons 1 com) t start-point)
4001 ;; delete the wrapped around message
4002 (sit-for 2)(message "")
4003 )
4004 (goto-char start-point)
4005 (error "`%s': %s not found"
4006 string
4007 (if vip-re-search "Pattern" "String"))
4008 )))))))
4009
4010 (defun vip-search-next (arg)
4011 "Repeat previous search."
4012 (interactive "P")
4013 (let ((val (vip-p-val arg))
4014 (com (vip-getcom arg)))
4015 (if (null vip-s-string) (error vip-NoPrevSearch))
4016 (vip-search vip-s-string vip-s-forward arg)
4017 (if com
4018 (progn
4019 (vip-move-marker-locally 'vip-com-point (mark t))
4020 (vip-execute-com 'vip-search-next val com)))))
4021
4022 (defun vip-search-Next (arg)
4023 "Repeat previous search in the reverse direction."
4024 (interactive "P")
4025 (let ((val (vip-p-val arg))
4026 (com (vip-getcom arg)))
4027 (if (null vip-s-string) (error vip-NoPrevSearch))
4028 (vip-search vip-s-string (not vip-s-forward) arg)
4029 (if com
4030 (progn
4031 (vip-move-marker-locally 'vip-com-point (mark t))
4032 (vip-execute-com 'vip-search-Next val com)))))
4033
4034
4035 ;; Search contents of buffer defined by one of Viper's motion commands.
4036 ;; Repeatable via `n' and `N'.
4037 (defun vip-buffer-search-enable (&optional c)
4038 (cond (c (setq vip-buffer-search-char c))
4039 ((null vip-buffer-search-char)
4040 (setq vip-buffer-search-char ?g)))
4041 (define-key vip-vi-basic-map
4042 (char-to-string vip-buffer-search-char) 'vip-command-argument)
4043 (aset vip-exec-array vip-buffer-search-char 'vip-exec-buffer-search)
4044 (setq vip-prefix-commands (cons vip-buffer-search-char vip-prefix-commands)))
4045
4046 (defun vip-isearch-forward (arg)
4047 "This is a Viper wrap-around for isearch-forward."
4048 (interactive "P")
4049 ;; emacs bug workaround
4050 (if (listp arg) (setq arg (car arg)))
4051 (vip-exec-form-in-emacs (list 'isearch-forward arg)))
4052
4053 (defun vip-isearch-backward (arg)
4054 "This is a Viper wrap-around for isearch-backward."
4055 (interactive "P")
4056 ;; emacs bug workaround
4057 (if (listp arg) (setq arg (car arg)))
4058 (vip-exec-form-in-emacs (list 'isearch-backward arg)))
4059
4060 \f
4061 ;; visiting and killing files, buffers
4062
4063 (defun vip-switch-to-buffer ()
4064 "Switch to buffer in the current window."
4065 (interactive)
4066 (let (buffer)
4067 (setq buffer
4068 (read-buffer
4069 (format "Switch to buffer in this window \(%s\): "
4070 (buffer-name (other-buffer (current-buffer))))))
4071 (switch-to-buffer buffer)
4072 ))
4073
4074 (defun vip-switch-to-buffer-other-window ()
4075 "Switch to buffer in another window."
4076 (interactive)
4077 (let (buffer)
4078 (setq buffer
4079 (read-buffer
4080 (format "Switch to buffer in another window \(%s\): "
4081 (buffer-name (other-buffer (current-buffer))))))
4082 (switch-to-buffer-other-window buffer)
4083 ))
4084
4085 (defun vip-kill-buffer ()
4086 "Kill a buffer."
4087 (interactive)
4088 (let (buffer buffer-name)
4089 (setq buffer-name
4090 (read-buffer
4091 (format "Kill buffer \(%s\): "
4092 (buffer-name (current-buffer)))))
4093 (setq buffer
4094 (if (null buffer-name)
4095 (current-buffer)
4096 (get-buffer buffer-name)))
4097 (if (null buffer) (error "`%s': No such buffer" buffer-name))
4098 (if (or (not (buffer-modified-p buffer))
4099 (y-or-n-p
4100 (format
4101 "Buffer `%s' is modified, are you sure you want to kill it? "
4102 buffer-name)))
4103 (kill-buffer buffer)
4104 (error "Buffer not killed"))))
4105
4106
4107 (defvar vip-smart-suffix-list '("" "tex" "c" "cc" "el" "p")
4108 "*List of suffixes that Viper automatically tries to append to filenames ending with a `.'.
4109 This is useful when you the current directory contains files with the same
4110 prefix and many different suffixes. Usually, only one of the suffixes
4111 represents an editable file. However, file completion will stop at the `.'
4112 The smart suffix feature lets you hit RET in such a case, and Viper will
4113 select the appropriate suffix.
4114
4115 Suffixes are tried in the order given and the first suffix for which a
4116 corresponding file exists is selected. If no file exists for any of the
4117 suffixes, the user is asked to confirm.
4118
4119 To turn this feature off, set this variable to nil.")
4120
4121 ;; Try to add suffix to files ending with a `.'
4122 ;; Useful when the user hits RET on a non-completed file name.
4123 (defun vip-file-add-suffix ()
4124 (let ((count 0)
4125 (len (length vip-smart-suffix-list))
4126 (file (buffer-string))
4127 found key cmd suff)
4128 (goto-char (point-max))
4129 (if (and vip-smart-suffix-list (string-match "\\.$" file))
4130 (progn
4131 (while (and (not found) (< count len))
4132 (setq suff (nth count vip-smart-suffix-list)
4133 count (1+ count))
4134 (if (file-exists-p (format "%s%s" file suff))
4135 (progn
4136 (setq found t)
4137 (insert suff))))
4138
4139 (if found
4140 ()
4141 (vip-tmp-insert-at-eob " [Please complete file name]")
4142 (unwind-protect
4143 (while (not (memq cmd '(exit-minibuffer vip-exit-minibuffer)))
4144 (setq cmd
4145 (key-binding (setq key (read-key-sequence nil))))
4146 (cond ((eq cmd 'self-insert-command)
4147 (if vip-xemacs-p
4148 (insert (events-to-keys key))
4149 (insert key)))
4150 ((memq cmd '(exit-minibuffer vip-exit-minibuffer))
4151 nil)
4152 (t (command-execute cmd)))
4153 )))
4154 ))
4155 ))
4156
4157
4158 ;; Advice for use in find-file and read-file-name commands.
4159 (defadvice exit-minibuffer (before vip-exit-minibuffer-advice activate)
4160 "Runs vip-minibuffer-exit-hook just before exiting the minibuffer.
4161 Beginning with Emacs 19.26, the standard `minibuffer-exit-hook' is run
4162 *after* exiting the minibuffer."
4163 (run-hooks 'vip-minibuffer-exit-hook))
4164
4165 (defadvice find-file (before vip-add-suffix-advice activate)
4166 "Uses read-file-name to read arguments."
4167 (interactive (list (read-file-name "Find file: "
4168 nil default-directory))))
4169
4170 (defadvice find-file-other-window (before vip-add-suffix-advice activate)
4171 "Uses read-file-name to read arguments."
4172 (interactive (list (read-file-name "Find file in other window: "
4173 nil default-directory))))
4174
4175 ;; find-file-other-screen doesn't need advice because it apparently uses
4176 ;; read-file-name to read its argument.
4177 (defadvice find-file-other-frame (before vip-add-suffix-advice activate)
4178 "Uses read-file-name to read arguments."
4179 (interactive (list (read-file-name "Find file in other frame: "
4180 nil default-directory))))
4181
4182 (defadvice read-file-name (around vip-suffix-advice activate)
4183 "Makes exit-minibuffer run `vip-file-add-suffix' as a hook."
4184 (let ((vip-minibuffer-exit-hook 'vip-file-add-suffix))
4185 ad-do-it))
4186
4187 ;; must be after we did advice or else the advice won't take hold
4188 (if vip-xemacs-p
4189 (fset 'vip-find-file-other-frame
4190 (symbol-function 'find-file-other-screen))
4191 (fset 'vip-find-file-other-frame
4192 (symbol-function 'find-file-other-frame)))
4193
4194
4195 \f
4196 ;; yank and pop
4197
4198 (defsubst vip-yank (text)
4199 "Yank TEXT silently. This works correctly with Emacs's yank-pop command."
4200 (insert text)
4201 (setq this-command 'yank))
4202
4203 (defun vip-put-back (arg)
4204 "Put back after point/below line."
4205 (interactive "P")
4206 (let ((val (vip-p-val arg))
4207 (text (if vip-use-register
4208 (cond ((vip-valid-register vip-use-register '(digit))
4209 (current-kill (- vip-use-register ?1) 'do-not-rotate))
4210 ((vip-valid-register vip-use-register)
4211 (get-register (downcase vip-use-register)))
4212 (t (error vip-InvalidRegister vip-use-register)))
4213 (current-kill 0))))
4214 (if (null text)
4215 (if vip-use-register
4216 (let ((reg vip-use-register))
4217 (setq vip-use-register nil)
4218 (error vip-EmptyRegister reg))
4219 (error "")))
4220 (setq vip-use-register nil)
4221 (if (vip-end-with-a-newline-p text)
4222 (progn
4223 (if (eobp)
4224 (insert "\n")
4225 (forward-line 1))
4226 (beginning-of-line))
4227 (if (not (eolp)) (vip-forward-char-carefully)))
4228 (set-marker (vip-mark-marker) (point) (current-buffer))
4229 (vip-set-destructive-command
4230 (list 'vip-put-back val nil vip-use-register nil nil))
4231 (vip-loop val (vip-yank text)))
4232 (exchange-point-and-mark)
4233 (vip-deactivate-mark))
4234
4235 (defun vip-Put-back (arg)
4236 "Put back at point/above line."
4237 (interactive "P")
4238 (let ((val (vip-p-val arg))
4239 (text (if vip-use-register
4240 (cond ((vip-valid-register vip-use-register '(digit))
4241 (current-kill (- vip-use-register ?1) 'do-not-rotate))
4242 ((vip-valid-register vip-use-register)
4243 (get-register (downcase vip-use-register)))
4244 (t (error vip-InvalidRegister vip-use-register)))
4245 (current-kill 0))))
4246 (if (null text)
4247 (if vip-use-register
4248 (let ((reg vip-use-register))
4249 (setq vip-use-register nil)
4250 (error vip-EmptyRegister reg))
4251 (error "")))
4252 (setq vip-use-register nil)
4253 (if (vip-end-with-a-newline-p text) (beginning-of-line))
4254 (vip-set-destructive-command
4255 (list 'vip-Put-back val nil vip-use-register nil nil))
4256 (set-marker (vip-mark-marker) (point) (current-buffer))
4257 (vip-loop val (vip-yank text)))
4258 (exchange-point-and-mark)
4259 (vip-deactivate-mark))
4260
4261
4262 (defun vip-copy-region-as-kill (beg end)
4263 "Copy region to kill-ring.
4264 If BEG and END do not belong to the same buffer, copy empty region."
4265 (condition-case nil
4266 (copy-region-as-kill beg end)
4267 (error (copy-region-as-kill beg beg))))
4268
4269 (defun vip-save-last-insertion (beg end)
4270 "Saves last inserted text for possible use by vip-repeat command."
4271 (setq vip-last-insertion (buffer-substring beg end))
4272 (or (< (length vip-d-com) 5)
4273 (setcar (nthcdr 4 vip-d-com) vip-last-insertion))
4274 (or (null vip-command-ring)
4275 (ring-empty-p vip-command-ring)
4276 (progn
4277 (setcar (nthcdr 4 (vip-current-ring-item vip-command-ring))
4278 vip-last-insertion)
4279 ;; del most recent elt, if identical to the second most-recent
4280 (vip-cleanup-ring vip-command-ring)))
4281 )
4282
4283 (defsubst vip-yank-last-insertion ()
4284 "Inserts the text saved by the previous vip-save-last-insertion command."
4285 (condition-case nil
4286 (insert vip-last-insertion)
4287 (error nil)))
4288
4289
4290 (defun vip-delete-char (arg)
4291 "Delete character."
4292 (interactive "P")
4293 (let ((val (vip-p-val arg)))
4294 (vip-set-destructive-command (list 'vip-delete-char val nil nil nil nil))
4295 (if (> val 1)
4296 (save-excursion
4297 (let ((here (point)))
4298 (end-of-line)
4299 (if (> val (- (point) here))
4300 (setq val (- (point) here))))))
4301 (if (and (eq val 0) (not vip-ex-style-motion)) (setq val 1))
4302 (if (and vip-ex-style-motion (eolp))
4303 (if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch
4304 (if vip-use-register
4305 (progn
4306 (cond ((vip-valid-register vip-use-register '((Letter)))
4307 (vip-append-to-register
4308 (downcase vip-use-register) (point) (- (point) val)))
4309 ((vip-valid-register vip-use-register)
4310 (copy-to-register
4311 vip-use-register (point) (- (point) val) nil))
4312 (t (error vip-InvalidRegister vip-use-register)))
4313 (setq vip-use-register nil)))
4314 (if vip-ex-style-motion
4315 (progn
4316 (delete-char val t)
4317 (if (and (eolp) (not (bolp))) (backward-char 1)))
4318 (if (eolp)
4319 (delete-backward-char val t)
4320 (delete-char val t)))))
4321
4322 (defun vip-delete-backward-char (arg)
4323 "Delete previous character. On reaching beginning of line, stop and beep."
4324 (interactive "P")
4325 (let ((val (vip-p-val arg)))
4326 (vip-set-destructive-command
4327 (list 'vip-delete-backward-char val nil nil nil nil))
4328 (if (> val 1)
4329 (save-excursion
4330 (let ((here (point)))
4331 (beginning-of-line)
4332 (if (> val (- here (point)))
4333 (setq val (- here (point)))))))
4334 (if vip-use-register
4335 (progn
4336 (cond ((vip-valid-register vip-use-register '(Letter))
4337 (vip-append-to-register
4338 (downcase vip-use-register) (point) (+ (point) val)))
4339 ((vip-valid-register vip-use-register)
4340 (copy-to-register
4341 vip-use-register (point) (+ (point) val) nil))
4342 (t (error vip-InvalidRegister vip-use-register)))
4343 (setq vip-use-register nil)))
4344 (if (bolp) (ding)
4345 (delete-backward-char val t))))
4346
4347 (defun vip-del-backward-char-in-insert ()
4348 "Delete 1 char backwards while in insert mode."
4349 (interactive)
4350 (if (and vip-ex-style-editing-in-insert (bolp))
4351 (beep 1)
4352 (delete-backward-char 1 t)))
4353
4354 (defun vip-del-backward-char-in-replace ()
4355 "Delete one character in replace mode.
4356 If `vip-delete-backwards-in-replace' is t, then DEL key actually deletes
4357 charecters. If it is nil, then the cursor just moves backwards, similarly
4358 to Vi. The variable `vip-ex-style-editing-in-insert', if t, doesn't let the
4359 cursor move past the beginning of the replacement region."
4360 (interactive)
4361 (cond (vip-delete-backwards-in-replace
4362 (cond ((not (bolp))
4363 (delete-backward-char 1 t))
4364 (vip-ex-style-editing-in-insert
4365 (beep 1))
4366 ((bobp)
4367 (beep 1))
4368 (t
4369 (delete-backward-char 1 t))))
4370 (vip-ex-style-editing-in-insert
4371 (if (bolp)
4372 (beep 1)
4373 (backward-char 1)))
4374 (t
4375 (backward-char 1))))
4376
4377
4378 \f
4379 ;; join lines.
4380
4381 (defun vip-join-lines (arg)
4382 "Join this line to next, if ARG is nil. Otherwise, join ARG lines."
4383 (interactive "*P")
4384 (let ((val (vip-P-val arg)))
4385 (vip-set-destructive-command (list 'vip-join-lines val nil nil nil nil))
4386 (vip-loop (if (null val) 1 (1- val))
4387 (progn
4388 (end-of-line)
4389 (if (not (eobp))
4390 (progn
4391 (forward-line 1)
4392 (delete-region (point) (1- (point)))
4393 (fixup-whitespace)))))))
4394
4395 \f
4396 ;; Replace state
4397
4398 (defun vip-change (beg end)
4399 (if (markerp beg) (setq beg (marker-position beg)))
4400 (if (markerp end) (setq end (marker-position end)))
4401 ;; beg is sometimes (mark t), which may be nil
4402 (or beg (setq beg end))
4403
4404 (vip-set-complex-command-for-undo)
4405 (if vip-use-register
4406 (progn
4407 (copy-to-register vip-use-register beg end nil)
4408 (setq vip-use-register nil)))
4409 (vip-set-replace-overlay beg end)
4410 (setq last-command nil) ; separate repl text from prev kills
4411
4412 (if (= (vip-replace-start) (point-max))
4413 (error "End of buffer"))
4414
4415 (setq vip-last-replace-region
4416 (buffer-substring (vip-replace-start)
4417 (vip-replace-end)))
4418
4419 ;; protect against error while inserting "@" and other disasters
4420 ;; (e.g., read-only buff)
4421 (condition-case conds
4422 (if (vip-same-line (vip-replace-start)
4423 (vip-replace-end))
4424 (let ((delim-end (if (= (length vip-replace-region-end-symbol) 0)
4425 ""
4426 (substring vip-replace-region-end-symbol 0 1))))
4427
4428 ;; tabs cause problems in replace, so untabify
4429 (goto-char (vip-replace-end))
4430 (insert-before-markers "@") ; put placeholder after the TAB
4431
4432 (untabify (vip-replace-start) (point))
4433 ;; del @ and the char under the '$'; don't put on kill ring
4434 (delete-backward-char (1+ (length delim-end)))
4435 (insert delim-end)
4436 ;; this move takes care of the last posn in the overlay, which
4437 ;; has to be shifted because of insert. We can't simply insert
4438 ;; "$" before-markers because then overlay-start will shift the
4439 ;; beginning of the overlay in case we are replacing a single
4440 ;; character. This fixes the bug with `s' and `cl' commands.
4441 (vip-move-replace-overlay (vip-replace-start) (point))
4442 (goto-char (vip-replace-start))
4443 (vip-change-state-to-replace t))
4444 (kill-region (vip-replace-start)
4445 (vip-replace-end))
4446 (vip-change-state-to-insert))
4447 (error ;; make sure that the overlay doesn't stay.
4448 ;; go back to the original point
4449 (goto-char (vip-replace-start))
4450 (vip-hide-replace-overlay)
4451 (vip-message-conditions conds))))
4452
4453
4454 (defun vip-change-subr (beg end)
4455 ;; beg is sometimes (mark t), which may be nil
4456 (or beg (setq beg end))
4457
4458 (if vip-use-register
4459 (progn
4460 (copy-to-register vip-use-register beg end nil)
4461 (setq vip-use-register nil)))
4462 (kill-region beg end)
4463 (setq this-command 'vip-change)
4464 (vip-yank-last-insertion))
4465
4466 (defun vip-toggle-case (arg)
4467 "Toggle character case."
4468 (interactive "P")
4469 (let ((val (vip-p-val arg)) (c))
4470 (vip-set-destructive-command (list 'vip-toggle-case val nil nil nil nil))
4471 (while (> val 0)
4472 (setq c (following-char))
4473 (delete-char 1 nil)
4474 (if (eq c (upcase c))
4475 (insert-char (downcase c) 1)
4476 (insert-char (upcase c) 1))
4477 (setq val (1- val)))))
4478
4479 \f
4480 ;; query replace
4481
4482 (defun vip-query-replace ()
4483 "Query replace.
4484 If a null string is suplied as the string to be replaced,
4485 the query replace mode will toggle between string replace
4486 and regexp replace."
4487 (interactive)
4488 (let (str)
4489 (setq str (vip-read-string-with-history
4490 (if vip-re-query-replace "Query replace regexp: "
4491 "Query replace: ")
4492 nil ; no initial
4493 'vip-replace1-history
4494 (car vip-replace1-history) ; default
4495 ))
4496 (if (string= str "")
4497 (progn
4498 (setq vip-re-query-replace (not vip-re-query-replace))
4499 (message "Query replace mode changed to %s"
4500 (if vip-re-query-replace "regexp replace"
4501 "string replace")))
4502 (if vip-re-query-replace
4503 (query-replace-regexp
4504 str
4505 (vip-read-string-with-history
4506 (format "Query replace regexp `%s' with: " str)
4507 nil ; no initial
4508 'vip-replace1-history
4509 (car vip-replace1-history) ; default
4510 ))
4511 (query-replace
4512 str
4513 (vip-read-string-with-history
4514 (format "Query replace `%s' with: " str)
4515 nil ; no initial
4516 'vip-replace1-history
4517 (car vip-replace1-history) ; default
4518 ))))))
4519
4520 \f
4521 ;; marking
4522
4523 (defun vip-mark-beginning-of-buffer ()
4524 (interactive)
4525 (push-mark (point))
4526 (goto-char (point-min))
4527 (exchange-point-and-mark)
4528 (message "Mark set at the beginning of buffer"))
4529
4530 (defun vip-mark-end-of-buffer ()
4531 (interactive)
4532 (push-mark (point))
4533 (goto-char (point-max))
4534 (exchange-point-and-mark)
4535 (message "Mark set at the end of buffer"))
4536
4537 (defun vip-mark-point ()
4538 (interactive)
4539 (let ((char (vip-read-char-exclusive)))
4540 (cond ((and (<= ?a char) (<= char ?z))
4541 (point-to-register (1+ (- char ?a))))
4542 ((= char ?<) (vip-mark-beginning-of-buffer))
4543 ((= char ?>) (vip-mark-end-of-buffer))
4544 ((= char ?.) (vip-set-mark-if-necessary))
4545 ((= char ?,) (vip-cycle-through-mark-ring))
4546 ((= char ?D) (mark-defun))
4547 (t (error ""))
4548 )))
4549
4550 ;; Algorithm: If first invocation of this command save mark on ring, goto
4551 ;; mark, M0, and pop the most recent elt from the mark ring into mark,
4552 ;; making it into the new mark, M1.
4553 ;; Push this mark back and set mark to the original point position, p1.
4554 ;; So, if you hit '' or `` then you can return to p1.
4555 ;;
4556 ;; If repeated command, pop top elt from the ring into mark and
4557 ;; jump there. This forgets the position, p1, and puts M1 back into mark.
4558 ;; Then we save the current pos, which is M0, jump to M1 and pop M2 from
4559 ;; the ring into mark. Push M2 back on the ring and set mark to M0.
4560 ;; etc.
4561 (defun vip-cycle-through-mark-ring ()
4562 "Visit previous locations on the mark ring.
4563 One can use `` and '' to temporarily jump 1 step back."
4564 (let* ((sv-pt (point)))
4565 ;; if repeated `m,' command, pop the previously saved mark.
4566 ;; Prev saved mark is actually prev saved point. It is used if the
4567 ;; user types `` or '' and is discarded
4568 ;; from the mark ring by the next `m,' command.
4569 ;; In any case, go to the previous or previously saved mark.
4570 ;; Then push the current mark (popped off the ring) and set current
4571 ;; point to be the mark. Current pt as mark is discarded by the next
4572 ;; m, command.
4573 (if (eq last-command 'vip-cycle-through-mark-ring)
4574 ()
4575 ;; save current mark if the first iteration
4576 (setq mark-ring (delete (vip-mark-marker) mark-ring))
4577 (if (mark t)
4578 (push-mark (mark t) t)) )
4579 (pop-mark)
4580 (set-mark-command 1)
4581 ;; don't duplicate mark on the ring
4582 (setq mark-ring (delete (vip-mark-marker) mark-ring))
4583 (push-mark sv-pt t)
4584 (vip-deactivate-mark)
4585 (setq this-command 'vip-cycle-through-mark-ring)
4586 ))
4587
4588
4589 (defun vip-goto-mark (arg)
4590 "Go to mark."
4591 (interactive "P")
4592 (let ((char (read-char))
4593 (com (vip-getcom arg)))
4594 (vip-goto-mark-subr char com nil)))
4595
4596 (defun vip-goto-mark-and-skip-white (arg)
4597 "Go to mark and skip to first non-white character on line."
4598 (interactive "P")
4599 (let ((char (read-char))
4600 (com (vip-getCom arg)))
4601 (vip-goto-mark-subr char com t)))
4602
4603 (defun vip-goto-mark-subr (char com skip-white)
4604 (if (eobp)
4605 (if (bobp)
4606 (error "Empty buffer")
4607 (backward-char 1)))
4608 (cond ((vip-valid-register char '(letter))
4609 (let* ((buff (current-buffer))
4610 (reg (1+ (- char ?a)))
4611 (text-marker (get-register reg)))
4612 (if com (vip-move-marker-locally 'vip-com-point (point)))
4613 (if (not (vip-valid-marker text-marker))
4614 (error (format vip-EmptyTextmarker char)))
4615 (if (and (vip-same-line (point) vip-last-jump)
4616 (= (point) vip-last-jump-ignore))
4617 (push-mark vip-last-jump t)
4618 (push-mark nil t)) ; no msg
4619 (vip-register-to-point reg)
4620 (setq vip-last-jump (point-marker))
4621 (cond (skip-white
4622 (back-to-indentation)
4623 (setq vip-last-jump-ignore (point))))
4624 (if com
4625 (if (equal buff (current-buffer))
4626 (vip-execute-com (if skip-white
4627 'vip-goto-mark-and-skip-white
4628 'vip-goto-mark)
4629 nil com)
4630 (switch-to-buffer buff)
4631 (goto-char vip-com-point)
4632 (vip-change-state-to-vi)
4633 (error "")))))
4634 ((and (not skip-white) (= char ?`))
4635 (if com (vip-move-marker-locally 'vip-com-point (point)))
4636 (if (and (vip-same-line (point) vip-last-jump)
4637 (= (point) vip-last-jump-ignore))
4638 (goto-char vip-last-jump))
4639 (if (= (point) (mark t)) (pop-mark))
4640 (exchange-point-and-mark)
4641 (setq vip-last-jump (point-marker)
4642 vip-last-jump-ignore 0)
4643 (if com (vip-execute-com 'vip-goto-mark nil com)))
4644 ((and skip-white (= char ?'))
4645 (if com (vip-move-marker-locally 'vip-com-point (point)))
4646 (if (and (vip-same-line (point) vip-last-jump)
4647 (= (point) vip-last-jump-ignore))
4648 (goto-char vip-last-jump))
4649 (if (= (point) (mark t)) (pop-mark))
4650 (exchange-point-and-mark)
4651 (setq vip-last-jump (point))
4652 (back-to-indentation)
4653 (setq vip-last-jump-ignore (point))
4654 (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com)))
4655 (t (error vip-InvalidTextmarker char))))
4656
4657 (defun vip-insert-tab ()
4658 (interactive)
4659 (insert-tab))
4660
4661 (defun vip-exchange-point-and-mark ()
4662 (interactive)
4663 (exchange-point-and-mark)
4664 (back-to-indentation))
4665
4666 ;; Input Mode Indentation
4667
4668 (defun vip-forward-indent ()
4669 "Indent forward -- `C-t' in Vi."
4670 (interactive)
4671 (setq vip-cted t)
4672 (indent-to (+ (current-column) vip-shift-width)))
4673
4674 (defun vip-backward-indent ()
4675 "Backtab, C-d in VI"
4676 (interactive)
4677 (if vip-cted
4678 (let ((p (point)) (c (current-column)) bol (indent t))
4679 (if (vip-looking-back "[0^]")
4680 (progn
4681 (if (= ?^ (preceding-char)) (setq vip-preserve-indent t))
4682 (delete-backward-char 1)
4683 (setq p (point))
4684 (setq indent nil)))
4685 (save-excursion
4686 (beginning-of-line)
4687 (setq bol (point)))
4688 (if (re-search-backward "[^ \t]" bol 1) (forward-char))
4689 (delete-region (point) p)
4690 (if indent
4691 (indent-to (- c vip-shift-width)))
4692 (if (or (bolp) (vip-looking-back "[^ \t]"))
4693 (setq vip-cted nil)))))
4694
4695 (defun vip-autoindent ()
4696 "Auto Indentation, Vi-style."
4697 (interactive)
4698 (let ((col (current-indentation)))
4699 (if (not vip-preserve-indent)
4700 (setq vip-current-indent col)
4701 (setq vip-preserve-indent nil))
4702 (newline 1)
4703 (if vip-auto-indent
4704 (progn
4705 (setq vip-cted t)
4706 (indent-to vip-current-indent)))))
4707
4708
4709 ;; Viewing registers
4710
4711 (defun vip-ket-function (arg)
4712 "Function called by \], the ket. View registers and call \]\]."
4713 (interactive "P")
4714 (let ((reg (read-char)))
4715 (cond ((vip-valid-register reg '(letter Letter))
4716 (view-register (downcase reg)))
4717 ((vip-valid-register reg '(digit))
4718 (let ((text (current-kill (- reg ?1) 'do-not-rotate)))
4719 (save-excursion
4720 (set-buffer (get-buffer-create "*Output*"))
4721 (delete-region (point-min) (point-max))
4722 (insert (format "Register %c contains the string:\n" reg))
4723 (insert text)
4724 (goto-char (point-min)))
4725 (display-buffer "*Output*")))
4726 ((= ?\] reg)
4727 (vip-next-heading arg))
4728 (t (error
4729 vip-InvalidRegister reg)))))
4730
4731 (defun vip-brac-function (arg)
4732 "Function called by \[, the brac. View textmarkers and call \[\["
4733 (interactive "P")
4734 (let ((reg (read-char)))
4735 (cond ((= ?\[ reg)
4736 (vip-prev-heading arg))
4737 ((= ?\] reg)
4738 (vip-heading-end arg))
4739 ((vip-valid-register reg '(letter))
4740 (let* ((val (get-register (1+ (- reg ?a))))
4741 (buf (if (not val)
4742 (error
4743 (format vip-EmptyTextmarker reg))
4744 (marker-buffer val)))
4745 (pos (marker-position val))
4746 line-no text (s pos) (e pos))
4747 (save-excursion
4748 (set-buffer (get-buffer-create "*Output*"))
4749 (delete-region (point-min) (point-max))
4750 (if (and buf pos)
4751 (progn
4752 (save-excursion
4753 (set-buffer buf)
4754 (setq line-no (1+ (count-lines (point-min) val)))
4755 (goto-char pos)
4756 (beginning-of-line)
4757 (if (re-search-backward "[^ \t]" nil t)
4758 (progn
4759 (beginning-of-line)
4760 (setq s (point))))
4761 (goto-char pos)
4762 (forward-line 1)
4763 (if (re-search-forward "[^ \t]" nil t)
4764 (progn
4765 (end-of-line)
4766 (setq e (point))))
4767 (setq text (buffer-substring s e))
4768 (setq text (format "%s<%c>%s"
4769 (substring text 0 (- pos s))
4770 reg (substring text (- pos s)))))
4771 (insert
4772 (format
4773 "Textmarker `%c' is in buffer `%s' at line %d.\n"
4774 reg (buffer-name buf) line-no))
4775 (insert (format "Here is some text around %c:\n\n %s"
4776 reg text)))
4777 (insert (format vip-EmptyTextmarker reg)))
4778 (goto-char (point-min)))
4779 (display-buffer "*Output*")))
4780 (t (error vip-InvalidTextmarker reg)))))
4781
4782
4783 \f
4784 ;; commands in insertion mode
4785
4786 (defun vip-delete-backward-word (arg)
4787 "Delete previous word."
4788 (interactive "p")
4789 (save-excursion
4790 (push-mark nil t)
4791 (backward-word arg)
4792 (delete-region (point) (mark t))
4793 (pop-mark)))
4794
4795
4796 (defun vip-set-expert-level (&optional dont-change-unless)
4797 "Sets the expert level for a Viper user.
4798 Can be called interactively to change (temporarily or permanently) the
4799 current expert level.
4800
4801 The optional argument DONT-CHANGE-UNLESS if not nil, says that
4802 the level should not be changed, unless its current value is
4803 meaningless (i.e., not one of 1,2,3,4,5).
4804
4805 User level determines the setting of Viper variables that are most
4806 sensitive for VI-style look-and-feel."
4807
4808 (interactive)
4809
4810 (if (not (numberp vip-expert-level)) (setq vip-expert-level 0))
4811
4812 (save-window-excursion
4813 (delete-other-windows)
4814 ;; if 0 < vip-expert-level < vip-max-expert-level
4815 ;; & dont-change-unless = t -- use it; else ask
4816 (vip-ask-level dont-change-unless))
4817
4818 (setq vip-always t
4819 vip-ex-style-motion t
4820 vip-ex-style-editing-in-insert t
4821 vip-want-ctl-h-help nil)
4822
4823 (cond
4824 ;; a novice or a beginner
4825 ((eq vip-expert-level 1)
4826 (global-set-key vip-toggle-key ;; in emacs-state
4827 (if window-system
4828 'vip-iconify
4829 'suspend-emacs))
4830 (setq vip-no-multiple-ESC t
4831 vip-re-search t
4832 vip-vi-style-in-minibuffer t
4833 vip-search-wrap-around-t t
4834 vip-want-emacs-keys-in-vi nil
4835 vip-want-emacs-keys-in-insert nil))
4836
4837 ;; an intermediate to guru
4838 ((and (> vip-expert-level 1) (< vip-expert-level 5))
4839 (setq vip-no-multiple-ESC (if window-system t 'twice)
4840 vip-want-emacs-keys-in-vi t
4841 vip-want-emacs-keys-in-insert (> vip-expert-level 2))
4842
4843 (if (eq vip-expert-level 4) ; respect user's ex-style motions
4844 ; and vip-no-multiple-ESC
4845 (progn
4846 (setq-default vip-ex-style-editing-in-insert
4847 (cdr (assoc 'vip-ex-style-editing-in-insert
4848 vip-saved-user-settings))
4849 vip-ex-style-motion
4850 (cdr (assoc 'vip-ex-style-motion
4851 vip-saved-user-settings)))
4852 (setq vip-ex-style-motion
4853 (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings))
4854 vip-ex-style-editing-in-insert
4855 (cdr (assoc 'vip-ex-style-editing-in-insert
4856 vip-saved-user-settings))
4857 vip-re-search
4858 (cdr (assoc 'vip-re-search vip-saved-user-settings))
4859 vip-no-multiple-ESC
4860 (cdr (assoc 'vip-no-multiple-ESC
4861 vip-saved-user-settings))))))
4862
4863 ;; A wizard
4864 ;; Ideally, if 5 is selected, a buffer should pop up to let the
4865 ;; user toggle variable values.
4866 (t (setq-default vip-ex-style-editing-in-insert
4867 (cdr (assoc 'vip-ex-style-editing-in-insert
4868 vip-saved-user-settings))
4869 vip-ex-style-motion
4870 (cdr (assoc 'vip-ex-style-motion
4871 vip-saved-user-settings)))
4872 (setq vip-want-ctl-h-help
4873 (cdr (assoc 'vip-want-ctl-h-help vip-saved-user-settings))
4874 vip-always
4875 (cdr (assoc 'vip-always vip-saved-user-settings))
4876 vip-no-multiple-ESC
4877 (cdr (assoc 'vip-no-multiple-ESC vip-saved-user-settings))
4878 vip-ex-style-motion
4879 (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings))
4880 vip-ex-style-editing-in-insert
4881 (cdr (assoc 'vip-ex-style-editing-in-insert
4882 vip-saved-user-settings))
4883 vip-re-search
4884 (cdr (assoc 'vip-re-search vip-saved-user-settings))
4885 vip-want-emacs-keys-in-vi
4886 (cdr (assoc 'vip-want-emacs-keys-in-vi
4887 vip-saved-user-settings))
4888 vip-want-emacs-keys-in-insert
4889 (cdr (assoc 'vip-want-emacs-keys-in-insert
4890 vip-saved-user-settings)))))
4891 (vip-set-mode-vars-for vip-current-state)
4892 (if (or vip-always
4893 (and (> vip-expert-level 0) (> 5 vip-expert-level)))
4894 (vip-set-hooks)))
4895
4896 (defun vip-ask-level (dont-change-unless)
4897 "Ask user expert level."
4898 (let ((ask-buffer " *vip-ask-level*")
4899 level-changed repeated)
4900 (save-window-excursion
4901 (switch-to-buffer ask-buffer)
4902
4903 (or (eq this-command 'vip-set-expert-level)
4904 (and
4905 (<= vip-expert-level vip-max-expert-level)
4906 (>= vip-expert-level 1))
4907 (progn
4908 (insert "
4909
4910 *** Important Notice for VIP users***
4911
4912 This is VIPER
4913
4914 @joke
4915 Viper Is a Package for Emacs Rebels,
4916 a VI Plan for Emacs Rescue,
4917 and a venomous VI PERil.
4918 @end joke
4919
4920 Technically speaking, Viper is a new Vi emulator that replaces
4921 the old VIP package.
4922
4923 Viper emulates Vi much better than VIP. It also significantly
4924 extends and improves upon Vi in many useful ways.
4925
4926 Although many VIP settings in your ~/.vip are compatible with Viper,
4927 you may have to change some of them. Please refer to the documentation,
4928 which can be obtained by executing
4929
4930 :help
4931
4932 when Viper is in Vi state.
4933
4934 If you will be so lucky as to find a bug, report it via the command
4935
4936 :submitReport
4937
4938 Type any key to continue... ")
4939
4940 (read-char)
4941 (erase-buffer)))
4942
4943 (while (or (> vip-expert-level vip-max-expert-level)
4944 (< vip-expert-level 1)
4945 (null dont-change-unless))
4946 (erase-buffer)
4947 (if repeated
4948 (progn
4949 (message "Invalid user level")
4950 (beep 1))
4951 (setq repeated t))
4952 (setq dont-change-unless t
4953 level-changed t)
4954 (insert "
4955 Please specify your level of familiarity with the venomous VI PERil
4956 (and the VI Plan for Emacs Rescue).
4957 You can change it at any time by typing `M-x vip-set-expert-level RET'
4958
4959 1 -- BEGINNER: Almost all Emacs features are suppressed.
4960 Feels almost like straight Vi. File name completion and
4961 command history in the minibuffer are thrown in as a bonus.
4962 To use Emacs productively, you must reach level 3 or higher.
4963 2 -- MASTER: C-c now has its standard Emacs meaning in Vi command state,
4964 so most Emacs commands can be used when Viper is in Vi state.
4965 Good progress---you are well on the way to level 3!
4966 3 -- GRAND MASTER: Like 3, but most Emacs commands are available also
4967 in Viper's insert state.
4968 4 -- GURU: Like 3, but user settings are respected for vip-no-multiple-ESC,
4969 vip-re-search, vip-ex-style-motion, & vip-ex-style-editing-in-insert
4970 variables. Adjust these settings to your taste.
4971 5 -- WIZARD: Like 4, but user settings are also respected for vip-always,
4972 vip-want-ctl-h-help, vip-want-emacs-keys-in-vi, and
4973 vip-want-emacs-keys-in-insert. Adjust these to your taste.
4974
4975 Please, specify your level now: ")
4976
4977 (setq vip-expert-level (- (vip-read-char-exclusive) ?0))
4978 ) ; end while
4979
4980 ;; tell the user if level was changed
4981 (and level-changed
4982 (progn
4983 (insert
4984 (format "\n\n\n\n\n\t\tYou have selected user level %d"
4985 vip-expert-level))
4986 (if (y-or-n-p "Do you wish to make this change permanent? ")
4987 ;; save the setting for vip-expert-level
4988 (vip-save-setting
4989 'vip-expert-level
4990 (format "Saving user level %d ..." vip-expert-level)
4991 vip-custom-file-name))
4992 ))
4993 (bury-buffer) ; remove ask-buffer from screen
4994 (message "")
4995 )))
4996
4997
4998 (defun viper-version ()
4999 (interactive)
5000 (message "Viper version is %s" viper-version))
5001
5002 (defalias 'vip-version 'viper-version)
5003
5004 (defun vip-nil ()
5005 (interactive)
5006 (beep 1))
5007
5008
5009 ;; Returns t, if the string before point matches the regexp STR.
5010 (defsubst vip-looking-back (str)
5011 (and (save-excursion (re-search-backward str nil t))
5012 (= (point) (match-end 0))))
5013
5014
5015
5016 ;; if ENFORCE-BUFFER is not nil, error if CHAR is a marker in another buffer
5017 (defun vip-register-to-point (char &optional enforce-buffer)
5018 "Like jump-to-register, but switches to another buffer in another window."
5019 (interactive "cViper register to point: ")
5020 (let ((val (get-register char)))
5021 (cond
5022 ((and (fboundp 'frame-configuration-p)
5023 (frame-configuration-p val))
5024 (set-frame-configuration val))
5025 ((window-configuration-p val)
5026 (set-window-configuration val))
5027 ((vip-valid-marker val)
5028 (if (and enforce-buffer
5029 (not (equal (current-buffer) (marker-buffer val))))
5030 (error (concat vip-EmptyTextmarker " in this buffer")
5031 (1- (+ char ?a))))
5032 (pop-to-buffer (marker-buffer val))
5033 (goto-char val))
5034 ((and (consp val) (eq (car val) 'file))
5035 (find-file (cdr val)))
5036 (t
5037 (error vip-EmptyTextmarker (1- (+ char ?a)))))))
5038
5039
5040 (defun vip-save-kill-buffer ()
5041 "Save then kill current buffer. "
5042 (interactive)
5043 (if (< vip-expert-level 2)
5044 (save-buffers-kill-emacs)
5045 (save-buffer)
5046 (kill-buffer (current-buffer))))
5047
5048
5049 \f
5050 ;;; Bug Report
5051
5052 (defun vip-submit-report ()
5053 "Submit bug report on Viper."
5054 (interactive)
5055 (let ((reporter-prompt-for-summary-p t)
5056 color-display-p frame-parameters
5057 minibuffer-emacs-face minibuffer-vi-face minibuffer-insert-face
5058 varlist salutation window-config)
5059
5060 ;; If mode info is needed, add variable to `let' and then set it below,
5061 ;; like we did with color-display-p.
5062 (setq color-display-p (if window-system
5063 (vip-display-color-p)
5064 'non-x)
5065 minibuffer-vi-face (if window-system
5066 (vip-get-face vip-minibuffer-vi-face)
5067 'non-x)
5068 minibuffer-insert-face (if window-system
5069 (vip-get-face vip-minibuffer-insert-face)
5070 'non-x)
5071 minibuffer-emacs-face (if window-system
5072 (vip-get-face vip-minibuffer-emacs-face)
5073 'non-x)
5074 frame-parameters (if (fboundp 'vip-frame-parameters)
5075 (vip-frame-parameters (vip-selected-frame))))
5076
5077 (setq varlist (list 'vip-vi-minibuffer-minor-mode
5078 'vip-insert-minibuffer-minor-mode
5079 'vip-vi-intercept-minor-mode
5080 'vip-vi-local-user-minor-mode
5081 'vip-vi-kbd-minor-mode
5082 'vip-vi-global-user-minor-mode
5083 'vip-vi-state-modifier-minor-mode
5084 'vip-vi-diehard-minor-mode
5085 'vip-vi-basic-minor-mode
5086 'vip-replace-minor-mode
5087 'vip-insert-intercept-minor-mode
5088 'vip-insert-local-user-minor-mode
5089 'vip-insert-kbd-minor-mode
5090 'vip-insert-global-user-minor-mode
5091 'vip-insert-state-modifier-minor-mode
5092 'vip-insert-diehard-minor-mode
5093 'vip-insert-basic-minor-mode
5094 'vip-emacs-intercept-minor-mode
5095 'vip-emacs-local-user-minor-mode
5096 'vip-emacs-kbd-minor-mode
5097 'vip-emacs-global-user-minor-mode
5098 'vip-emacs-state-modifier-minor-mode
5099 'vip-automatic-iso-accents
5100 'vip-want-emacs-keys-in-insert
5101 'vip-want-emacs-keys-in-vi
5102 'vip-keep-point-on-undo
5103 'vip-no-multiple-ESC
5104 'vip-ESC-key
5105 'vip-want-ctl-h-help
5106 'vip-ex-style-editing-in-insert
5107 'vip-delete-backwards-in-replace
5108 'vip-vi-style-in-minibuffer
5109 'vip-vi-state-hooks
5110 'vip-insert-state-hooks
5111 'vip-replace-state-hooks
5112 'vip-emacs-state-hooks
5113 'ex-cycle-other-window
5114 'ex-cycle-through-non-files
5115 'vip-expert-level
5116 'major-mode
5117 'window-system
5118 'color-display-p
5119 'frame-parameters
5120 'minibuffer-vi-face
5121 'minibuffer-insert-face
5122 'minibuffer-emacs-face
5123 ))
5124 (setq salutation "
5125 Congratulations! You may have unearthed a bug in Viper!
5126 Please mail a concise, accurate summary of the problem to the address above.
5127
5128 -------------------------------------------------------------------")
5129 (setq window-config (current-window-configuration))
5130 (with-output-to-temp-buffer " *vip-info*"
5131 (switch-to-buffer " *vip-info*")
5132 (delete-other-windows)
5133 (princ "
5134 PLEASE FOLLOW THESE PROCEDURES
5135 ------------------------------
5136
5137 Before reporting a bug, please verify that it is related to Viper, and is
5138 not cause by other packages you are using.
5139
5140 Don't report compilation warnings, unless you are certain that there is a
5141 problem. These warnings are normal and unavoidable.
5142
5143 Please note that users should not modify variables and keymaps other than
5144 those advertised in the manual. Such `customization' is likely to crash
5145 Viper, as it would any other improperly customized Emacs package.
5146
5147 If you are reporting an error message received while executing one of the
5148 Viper commands, type:
5149
5150 M-x set-variable <Return> debug-on-error <Return> t <Return>
5151
5152 Then reproduce the error. The above command will cause Emacs to produce a
5153 back trace of the execution that leads to the error. Please include this
5154 trace in your bug report.
5155
5156 If you believe that one of Viper's commands goes into an infinite loop
5157 \(e.g., Emacs freezes\), type:
5158
5159 M-x set-variable <Return> debug-on-quit <Return> t <Return>
5160
5161 Then reproduce the problem. Wait for a few seconds, then type C-g to abort
5162 the current command. Include the resulting back trace in the bug report.
5163
5164 Mail anyway (y or n)? ")
5165 (if (y-or-n-p "Mail anyway? ")
5166 ()
5167 (set-window-configuration window-config)
5168 (error "Bug report aborted")))
5169
5170 (require 'reporter)
5171 (set-window-configuration window-config)
5172
5173 (reporter-submit-bug-report "kifer@cs.sunysb.edu"
5174 (vip-version)
5175 varlist
5176 nil 'delete-other-windows
5177 salutation)
5178 ))
5179
5180
5181
5182
5183 ;; Needed to smooth out the difference between Emacs' unread-command-events
5184 ;; and XEmacs unread-command-event. Arg is a character, an event, a list of
5185 ;; events or a sequence of keys.
5186 ;; The semantics of placing an event on unread-command-event in XEmacs is
5187 ;; not the same as placing (setq unread-command-event event)
5188 ;; on the event queue using enqueue-eval-event. For instance, an event
5189 ;; sitting in unread-command-event will be available to (next-event).
5190 ;; In contrast, evals placed on event queue are not evaluated until all
5191 ;; previous commands have been executed. This makes a difference when one
5192 ;; of the events placed on the event queue is bound to a function that
5193 ;; pauses for input, because these evals won't make input immediately
5194 ;; available
5195 ;;
5196 ;; Due to a bug in unread-command-events, a non-event symbol in
5197 ;; unread-command-evets list may cause Emacs to label this symbol to be an
5198 ;; event. Below, we delete nil from event lists, since nil is the most
5199 ;; common problem here. Hopefully, unread-command-evets will be fixed in
5200 ;; the next release.
5201 (defun vip-set-unread-command-events (arg)
5202 (if vip-emacs-p
5203 (setq unread-command-events
5204 (let ((new-events
5205 (cond ((eventp arg) (list arg))
5206 ((listp arg) arg)
5207 ((sequencep arg)
5208 (listify-key-sequence arg))
5209 (t (error
5210 "vip-set-unread-command-events: Invalid arg, %S"
5211 arg)))))
5212 (if (not (eventp nil))
5213 (setq new-events (delq nil new-events)))
5214 (append new-events unread-command-events)))
5215 ;; XEmacs
5216 (cond ((numberp arg)
5217 (setq unread-command-event (character-to-event arg)))
5218 ((eventp arg)
5219 (setq unread-command-event arg))
5220 ((sequencep arg)
5221 (let ((length (length arg))
5222 (count 0))
5223 (while (< count length)
5224 (enqueue-eval-event
5225 'vip-fudge-event-list-in-xemacs
5226 (if (stringp arg)
5227 (character-to-event (elt arg count))
5228 (elt arg count)))
5229 (setq count (1+ count))
5230 ) ; while
5231 (if (> length 0)
5232 (or arg unread-command-event))))
5233 (t (error "vip-set-unread-command-events: Invalid argument")))))
5234
5235 (defun vip-fudge-event-list-in-xemacs (arg)
5236 (setq unread-command-event arg))
5237
5238 \f
5239 ;;; Bring in the rest of the files
5240 (require 'viper-mous)
5241 (require 'viper-macs)
5242 (require 'viper-ex)
5243
5244
5245 \f
5246 ;; The following is provided for compatibility with older VIP's
5247
5248 (defalias 'vip-change-mode-to-vi 'vip-change-state-to-vi)
5249 (defalias 'vip-change-mode-to-insert 'vip-change-state-to-insert)
5250 (defalias 'vip-change-mode-to-emacs 'vip-change-state-to-emacs)
5251
5252 ;; This was the main Vi mode in old versions of VIP which may have been
5253 ;; extensively used by VIP users. We declare it as a global var
5254 ;; and, after .vip is loaded, we add this keymap to vip-vi-basic-map.
5255 (defvar vip-mode-map (make-sparse-keymap)
5256 "This was the main Vi-mode keymap in the old versions of VIP.
5257 Viper provides this variable for compatibility. Whatever the user defines
5258 for this map, is merged into Viper's vip-vi-basic-map after loading .vip")
5259
5260
5261 \f
5262 ;; Load .vip and setup hooks
5263 (defun vip-shell-mode-hook ()
5264 "Hook specifically designed to enable Vi-style editing in shell mode."
5265 (setq vip-add-newline-at-eob nil)
5266 ;; this is nicer in shell mode
5267 (setq vip-ex-style-editing-in-insert nil
5268 vip-ex-style-motion nil)
5269 (vip-add-local-keys 'vi-state
5270 '(("\C-m" . comint-send-input) ; return
5271 ("\C-d" . comint-delchar-or-maybe-eof))) ; \C-d
5272 (vip-add-local-keys 'insert-state
5273 '(("\C-m" . comint-send-input) ; return
5274 ("\C-d" . comint-delchar-or-maybe-eof))) ; \C-d
5275 )
5276
5277
5278 ;; This sets major mode hooks to make them come up in vip-state.
5279 (defun vip-set-hooks ()
5280
5281 ;; It is of course a misnomer to call viper-mode a `major mode'.
5282 ;; However, this has the effect that if the user didn't specify the
5283 ;; default mode, new buffers that fall back on the default will come up
5284 ;; in Fundamental Mode and Vi state.
5285 (setq default-major-mode 'viper-mode)
5286
5287 (defadvice fundamental-mode (after vip-fundamental-mode-ad activate)
5288 (vip-change-state-to-vi))
5289
5290 ;; The following major modes should come up in vi-state
5291 (defvar emacs-lisp-mode-hook nil)
5292 (add-hook 'emacs-lisp-mode-hook 'viper-mode)
5293
5294 (defvar lisp-mode-hook nil)
5295 (add-hook 'lisp-mode-hook 'viper-mode)
5296
5297 (defvar bibtex-mode-hook nil)
5298 (add-hook 'bibtex-mode-hook 'viper-mode)
5299
5300 (defvar cc-mode-hook nil)
5301 (add-hook 'cc-mode-hook 'viper-mode)
5302
5303 (defvar c-mode-hook nil)
5304 (add-hook 'c-mode-hook 'viper-mode)
5305
5306 (defvar c++-mode-hook nil)
5307 (add-hook 'c++-mode-hook 'viper-mode)
5308
5309 (defvar lisp-interaction-mode-hook nil)
5310 (add-hook 'lisp-interaction-mode-hook 'viper-mode)
5311
5312 (defvar text-mode-hook nil)
5313 (add-hook 'text-mode-hook 'viper-mode)
5314
5315 (add-hook 'completion-list-mode-hook 'viper-mode)
5316 (add-hook 'compilation-mode-hook 'viper-mode)
5317
5318 (defvar emerge-startup-hook nil)
5319 (add-hook 'emerge-startup-hook 'vip-change-state-to-emacs)
5320 ;; Run vip-change-state-to-vi after quitting emerge.
5321 (vip-eval-after-load "emerge"
5322 '(defadvice emerge-quit (after vip-emerge-advice activate)
5323 "Run vip-change-state-to-vi after quitting emerge."
5324 (vip-change-state-to-vi)))
5325 ;; In case Emerge was loaded before Viper.
5326 (defadvice emerge-quit (after vip-emerge-advice activate)
5327 "Run vip-change-state-to-vi after quitting emerge."
5328 (vip-change-state-to-vi))
5329
5330 (vip-eval-after-load "asm-mode"
5331 '(defadvice asm-mode (after vip-asm-mode-ad activate)
5332 "Run vip-change-state-to-vi on entry."
5333 (vip-change-state-to-vi)))
5334
5335 ;; passwd.el sets up its own buffer, which turns up in Vi mode,
5336 ;; overriding the local map. Noone needs Vi mode here.
5337 (vip-eval-after-load
5338 "passwd"
5339 '(defadvice read-passwd-1 (before vip-passwd-ad activate)
5340 "Vi-ism is prohibited when reading passwords, so switch to Emacs."
5341 (vip-change-state-to-emacs)))
5342
5343 ;; Emacs shell
5344 (defvar shell-mode-hook nil)
5345 (add-hook 'shell-mode-hook 'vip-change-state-to-insert)
5346 (add-hook 'shell-mode-hook 'vip-shell-mode-hook)
5347
5348 ;; Shell scripts
5349 (defvar sh-mode-hook nil)
5350 (add-hook 'sh-mode-hook 'viper-mode)
5351
5352 ;; Dired
5353 ;; This is only necessary when the user uses vip-modify-major-mode
5354 (add-hook 'dired-mode-hook 'vip-change-state-to-emacs)
5355
5356 (defvar view-hook nil
5357 "View hook. Run after view mode.")
5358 (add-hook 'view-hook 'vip-change-state-to-emacs)
5359
5360 ;; For VM users.
5361 ;; Put summary and other VM buffers in Emacs state.
5362 (defvar vm-mode-hooks nil
5363 "This hook is run after vm is started.")
5364 (defvar vm-summary-mode-hooks nil
5365 "This hook is run after vm switches to summary mode.")
5366 (add-hook 'vm-mode-hooks 'vip-change-state-to-emacs)
5367 (add-hook 'vm-summary-mode-hooks 'vip-change-state-to-emacs)
5368
5369 ;; For RMAIL users.
5370 ;; Put buf in Emacs state after edit.
5371 (vip-eval-after-load
5372 "rmailedit"
5373 '(defadvice rmail-cease-edit (after vip-rmail-advice activate)
5374 "Switch buffer to emacs-state after finishing with editing a message."
5375 (vip-change-state-to-emacs)))
5376 ;; In case RMAIL was loaded before Viper.
5377 (defadvice rmail-cease-edit (after vip-rmail-advice activate)
5378 "Switch buffer to emacs-state after finishing with editing a message."
5379 (vip-change-state-to-emacs))
5380 ) ; vip-set-hooks
5381
5382
5383 ;; ~/.vip is loaded if it exists
5384 (if (and (file-exists-p vip-custom-file-name)
5385 (not noninteractive))
5386 (load vip-custom-file-name))
5387
5388 ;; VIP compatibility: merge whatever the user has in vip-mode-map into
5389 ;; Viper's basic map.
5390 (vip-add-keymap vip-mode-map vip-vi-global-user-map)
5391
5392 \f
5393 ;; Applying Viper customization -- runs after (load .vip)
5394
5395 ;; Save user settings or Viper defaults for vars controled by vip-expert-level
5396 (setq vip-saved-user-settings
5397 (list (cons 'vip-want-ctl-h-help vip-want-ctl-h-help)
5398 (cons 'vip-always vip-always)
5399 (cons 'vip-no-multiple-ESC vip-no-multiple-ESC)
5400 (cons 'vip-ex-style-motion vip-ex-style-motion)
5401 (cons 'vip-ex-style-editing-in-insert
5402 vip-ex-style-editing-in-insert)
5403 (cons 'vip-want-emacs-keys-in-vi vip-want-emacs-keys-in-vi)
5404 (cons 'vip-want-emacs-keys-in-insert vip-want-emacs-keys-in-insert)
5405 (cons 'vip-re-search vip-re-search)))
5406
5407
5408 (vip-set-minibuffer-style)
5409 (vip-set-minibuffer-faces)
5410 (vip-set-search-face)
5411
5412 ;;; Familiarize Viper with some minor modes that have their own keymaps
5413 (vip-harness-minor-mode "compile")
5414 (vip-harness-minor-mode "outline")
5415 (vip-harness-minor-mode "allout")
5416 (vip-harness-minor-mode "xref")
5417 (vip-harness-minor-mode "lmenu")
5418 (vip-harness-minor-mode "vc")
5419 (vip-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX
5420 (vip-harness-minor-mode "latex") ; latex they moved math mode here
5421
5422
5423 ;; Intercept maps could go in viper-keym.el
5424 ;; We keep them here in case someone redefines them in ~/.vip
5425
5426 (define-key vip-vi-intercept-map vip-ESC-key 'vip-intercept-ESC-key)
5427 (define-key vip-insert-intercept-map vip-ESC-key 'vip-intercept-ESC-key)
5428
5429 ;; This is taken care of by vip-insert-global-user-map.
5430 ;;(define-key vip-replace-map vip-ESC-key 'vip-intercept-ESC-key)
5431
5432 (define-key vip-insert-intercept-map vip-toggle-key 'vip-alternate-ESC)
5433 ;; The default vip-toggle-key is \C-z; for the novice, it suspends or
5434 ;; iconifies Emacs
5435 (define-key vip-vi-intercept-map vip-toggle-key
5436 '(lambda () (interactive)
5437 (if (and (< vip-expert-level 2) (equal vip-toggle-key "\C-z"))
5438 (if window-system (vip-iconify) (suspend-emacs))
5439 (vip-change-state-to-emacs))))
5440
5441 (define-key vip-emacs-intercept-map vip-toggle-key 'vip-change-state-to-vi)
5442
5443
5444 (if (or vip-always
5445 (and (< vip-expert-level 5) (> vip-expert-level 0)))
5446 (vip-set-hooks))
5447
5448 ;; Let all minor modes take effect after loading
5449 ;; this may not be enough, so we also set default minor-mode-alist.
5450 ;; Without setting the default, new buffers that come up in emacs mode have
5451 ;; minor-mode-map-alist = nil, unless we call vip-change-state-*
5452 (if (eq vip-current-state 'emacs-state)
5453 (progn
5454 (vip-change-state-to-emacs)
5455 (setq-default minor-mode-map-alist minor-mode-map-alist)
5456 ))
5457
5458 ;; set some useful macros
5459
5460 ;; repeat the 2nd previous command without rotating the command history
5461 (vip-record-kbd-macro
5462 (vector vip-repeat-from-history-key '\1) 'vi-state
5463 [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] 't)
5464 ;; repeat the 3d previous command without rotating the command history
5465 (vip-record-kbd-macro
5466 (vector vip-repeat-from-history-key '\2) 'vi-state
5467 [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] 't)
5468
5469 ;; toggle case sensitivity in search
5470 (vip-record-kbd-macro
5471 "//" 'vi-state
5472 [1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] 't)
5473 ;; toggle regexp/vanila search
5474 (vip-record-kbd-macro
5475 "///" 'vi-state
5476 [2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] 't)
5477
5478
5479 (run-hooks 'vip-load-hooks) ; the last chance to change anything
5480
5481 (provide 'viper)
5482 (provide 'vip19)
5483 (provide 'vip)
5484
5485 ;;; viper.el ends here
5486