1 ;;; viper-cmd.el --- Vi command support for Viper
2 ;; Copyright (C) 1997 Free Software Foundation, Inc.
11 (defvar vip-minibuffer-current-face
)
12 (defvar vip-minibuffer-insert-face
)
13 (defvar vip-minibuffer-vi-face
)
14 (defvar vip-minibuffer-emacs-face
)
16 (defvar vip-mode-string
)
17 (defvar vip-custom-file-name
)
18 (defvar iso-accents-mode
)
19 (defvar zmacs-region-stays
)
20 (defvar mark-even-if-inactive
)
22 ;; loading happens only in non-interactive compilation
23 ;; in order to spare non-viperized emacs from being viperized
26 (let ((load-path (cons (expand-file-name ".") load-path
)))
27 (or (featurep 'viper-util
)
28 (load "viper-util.el" nil nil
'nosuffix
))
29 (or (featurep 'viper-keym
)
30 (load "viper-keym.el" nil nil
'nosuffix
))
31 (or (featurep 'viper-mous
)
32 (load "viper-mous.el" nil nil
'nosuffix
))
33 (or (featurep 'viper-macs
)
34 (load "viper-macs.el" nil nil
'nosuffix
))
35 (or (featurep 'viper-ex
)
36 (load "viper-ex.el" nil nil
'nosuffix
))
51 ;; These test functions are shamelessly lifted from vip 4.4.2 by Aamod Sane
53 ;; generate test functions
54 ;; given symbol foo, foo-p is the test function, foos is the set of
56 ;; (macroexpand '(vip-test-com-defun foo))
57 ;; (defun foo-p (com) (consp (memq (if (< com 0) (- com) com) foos)))
59 (defmacro vip-test-com-defun
(name)
60 (let* ((snm (symbol-name name
))
61 (nm-p (intern (concat snm
"-p")))
62 (nms (intern (concat snm
"s"))))
63 (` (defun (, nm-p
) (com)
64 (consp (memq (if (< com
0) (- com
) com
) (, nms
)))))))
66 ;; Variables for defining VI commands
68 ;; Modifying commands that can be prefixes to movement commands
69 (defconst vip-prefix-commands
'(?c ?d ?y ?
! ?
= ?
# ?
< ?
> ?
\"))
70 ;; define vip-prefix-command-p
71 (vip-test-com-defun vip-prefix-command)
73 ;; Commands that are pairs eg. dd. r and R here are a hack
74 (defconst vip-charpair-commands
'(?c ?d ?y ?
! ?
= ?
< ?
> ?r ?R
))
75 ;; define vip-charpair-command-p
76 (vip-test-com-defun vip-charpair-command)
78 (defconst vip-movement-commands
'(?b ?B ?e ?E ?f ?F ?G ?h ?H ?j ?k ?l
79 ?H ?M ?L ?n ?t ?T ?w ?W ?$ ?%
80 ?^ ?
( ?
) ?- ?
+ ?| ?
{ ?
} ?
[ ?
] ?
' ?
`
81 ?
; ?, ?0 ?? ?/ ?\C-m ?\
84 ;; define vip-movement-command-p
85 (vip-test-com-defun vip-movement-command)
88 (defconst vip-digit-commands
'(?
1 ?
2 ?
3 ?
4 ?
5 ?
6 ?
7 ?
8 ?
9))
90 ;; define vip-digit-command-p
91 (vip-test-com-defun vip-digit-command)
93 ;; Commands that can be repeated by . (dotted)
94 (defconst vip-dotable-commands
'(?c ?d ?C ?s ?S ?D ?
> ?
<))
95 ;; define vip-dotable-command-p
96 (vip-test-com-defun vip-dotable-command)
98 ;; Commands that can follow a #
99 (defconst vip-hash-commands
'(?c ?C ?g ?q ?s
))
100 ;; define vip-hash-command-p
101 (vip-test-com-defun vip-hash-command)
103 ;; Commands that may have registers as prefix
104 (defconst vip-regsuffix-commands
'(?d ?y ?Y ?D ?p ?P ?x ?X
))
105 ;; define vip-regsuffix-command-p
106 (vip-test-com-defun vip-regsuffix-command)
108 (defconst vip-vi-commands
(append vip-movement-commands
111 vip-charpair-commands
114 vip-regsuffix-commands
)
115 "The list of all commands in Vi-state.")
116 ;; define vip-vi-command-p
117 (vip-test-com-defun vip-vi-command)
124 ;; Runs vip-after-change-functions inside after-change-functions
125 (defun vip-after-change-sentinel (beg end len
)
126 (let ((list vip-after-change-functions
))
128 (funcall (car list
) beg end len
)
129 (setq list
(cdr list
)))))
131 ;; Runs vip-before-change-functions inside before-change-functions
132 (defun vip-before-change-sentinel (beg end
)
133 (let ((list vip-before-change-functions
))
135 (funcall (car list
) beg end
)
136 (setq list
(cdr list
)))))
138 (defsubst vip-post-command-sentinel
()
139 (run-hooks 'vip-post-command-hooks
))
141 (defsubst vip-pre-command-sentinel
()
142 (run-hooks 'vip-pre-command-hooks
))
144 ;; Needed so that Viper will be able to figure the last inserted
145 ;; chunk of text with reasonable accuracy.
146 (defsubst vip-insert-state-post-command-sentinel
()
147 (if (and (memq vip-current-state
'(insert-state replace-state
))
149 (>= (point) vip-insert-point
))
150 (setq vip-last-posn-while-in-insert-state
(point-marker)))
151 (if (eq vip-current-state
'insert-state
)
153 (or (stringp vip-saved-cursor-color
)
154 (string= (vip-get-cursor-color) vip-insert-state-cursor-color
)
155 (setq vip-saved-cursor-color
(vip-get-cursor-color)))
156 (if (stringp vip-saved-cursor-color
)
157 (vip-change-cursor-color vip-insert-state-cursor-color
))
159 (if (and (eq this-command
'dabbrev-expand
)
160 (integerp vip-pre-command-point
)
161 (> vip-insert-point vip-pre-command-point
))
162 (move-marker vip-insert-point vip-pre-command-point
))
165 (defsubst vip-insert-state-pre-command-sentinel
()
166 (or (memq this-command
'(self-insert-command))
167 (memq (vip-event-key last-command-event
)
168 '(up down left right
(meta f
) (meta b
)
169 (control n
) (control p
) (control f
) (control b
)))
170 (vip-restore-cursor-color-after-insert))
171 (if (and (eq this-command
'dabbrev-expand
)
172 (markerp vip-insert-point
)
173 (marker-position vip-insert-point
))
174 (setq vip-pre-command-point
(marker-position vip-insert-point
))))
176 (defsubst vip-R-state-post-command-sentinel
()
177 ;; Restoring cursor color is needed despite
178 ;; vip-replace-state-pre-command-sentinel: When you jump to another buffer in
179 ;; another frame, the pre-command hook won't change cursor color to default
180 ;; in that other frame. So, if the second frame cursor was red and we set
181 ;; the point outside the replacement region, then the cursor color will
182 ;; remain red. Restoring the default, below, prevents this.
183 (if (and (<= (vip-replace-start) (point))
184 (<= (point) (vip-replace-end)))
185 (vip-change-cursor-color vip-replace-overlay-cursor-color
)
186 (vip-restore-cursor-color-after-replace)
189 ;; to speed up, don't change cursor color before self-insert
190 ;; and common move commands
191 (defsubst vip-replace-state-pre-command-sentinel
()
192 (or (memq this-command
'(self-insert-command))
193 (memq (vip-event-key last-command-event
)
194 '(up down left right
(meta f
) (meta b
)
195 (control n
) (control p
) (control f
) (control b
)))
196 (vip-restore-cursor-color-after-replace)))
198 (defun vip-replace-state-post-command-sentinel ()
199 ;; Restoring cursor color is needed despite
200 ;; vip-replace-state-pre-command-sentinel: When one jumps to another buffer
201 ;; in another frame, the pre-command hook won't change cursor color to
202 ;; default in that other frame. So, if the second frame cursor was red and
203 ;; we set the point outside the replacement region, then the cursor color
204 ;; will remain red. Restoring the default, below, fixes this problem.
206 ;; We optimize for self-insert-command's here, since they either don't change
207 ;; cursor color or, if they terminate replace mode, the color will be changed
208 ;; in vip-finish-change
209 (or (memq this-command
'(self-insert-command))
210 (vip-restore-cursor-color-after-replace))
212 ((eq vip-current-state
'replace-state
)
213 ;; delete characters to compensate for inserted chars.
214 (let ((replace-boundary (vip-replace-end)))
216 (goto-char vip-last-posn-in-replace-region
)
217 (delete-char vip-replace-chars-to-delete
)
218 (setq vip-replace-chars-to-delete
0
219 vip-replace-chars-deleted
0)
220 ;; terminate replace mode if reached replace limit
221 (if (= vip-last-posn-in-replace-region
223 (vip-finish-change vip-last-posn-in-replace-region
)))
225 (if (and (<= (vip-replace-start) (point))
226 (<= (point) replace-boundary
))
228 ;; the state may have changed in vip-finish-change above
229 (if (eq vip-current-state
'replace-state
)
230 (vip-change-cursor-color vip-replace-overlay-cursor-color
))
231 (setq vip-last-posn-in-replace-region
(point-marker))))
234 (t ;; terminate replace mode if changed Viper states.
235 (vip-finish-change vip-last-posn-in-replace-region
))))
240 ;; Change state to NEW-STATE---either emacs-state, vi-state, or insert-state.
241 (defun vip-change-state (new-state)
242 ;; Keep vip-post/pre-command-hooks fresh.
243 ;; We remove then add vip-post/pre-command-sentinel since it is very
244 ;; desirable that vip-pre-command-sentinel is the last hook and
245 ;; vip-post-command-sentinel is the first hook.
246 (remove-hook 'post-command-hook
'vip-post-command-sentinel
)
247 (add-hook 'post-command-hook
'vip-post-command-sentinel
)
248 (remove-hook 'pre-command-hook
'vip-pre-command-sentinel
)
249 (add-hook 'pre-command-hook
'vip-pre-command-sentinel t
)
250 ;; These hooks will be added back if switching to insert/replace mode
251 (vip-remove-hook 'vip-post-command-hooks
252 'vip-insert-state-post-command-sentinel
)
253 (vip-remove-hook 'vip-pre-command-hooks
254 'vip-insert-state-pre-command-sentinel
)
255 (cond ((eq new-state
'vi-state
)
256 (cond ((member vip-current-state
'(insert-state replace-state
))
258 ;; move vip-last-posn-while-in-insert-state
259 ;; This is a normal hook that is executed in insert/replace
260 ;; states after each command. In Vi/Emacs state, it does
261 ;; nothing. We need to execute it here to make sure that
262 ;; the last posn was recorded when we hit ESC.
263 ;; It may be left unrecorded if the last thing done in
264 ;; insert/repl state was dabbrev-expansion or abbrev
265 ;; expansion caused by hitting ESC
266 (vip-insert-state-post-command-sentinel)
268 (condition-case conds
270 (vip-save-last-insertion
272 vip-last-posn-while-in-insert-state
)
273 (if vip-began-as-replace
274 (setq vip-began-as-replace nil
)
275 ;; repeat insert commands if numerical arg > 1
277 (vip-repeat-insert-command))))
279 (vip-message-conditions conds
)))
281 (if (> (length vip-last-insertion
) 0)
282 (vip-push-onto-ring vip-last-insertion
283 'vip-insertion-ring
))
285 (if vip-ex-style-editing-in-insert
286 (or (bolp) (backward-char 1))))
290 ((memq new-state
'(insert-state replace-state
))
291 (if (memq vip-current-state
'(emacs-state vi-state
))
292 (vip-move-marker-locally 'vip-insert-point
(point)))
293 (vip-move-marker-locally 'vip-last-posn-while-in-insert-state
(point))
294 (vip-add-hook 'vip-post-command-hooks
295 'vip-insert-state-post-command-sentinel t
)
296 (vip-add-hook 'vip-pre-command-hooks
297 'vip-insert-state-pre-command-sentinel t
))
300 ;; Nothing needs to be done to switch to emacs mode! Just set some
301 ;; variables, which is already done in vip-change-state-to-emacs!
303 (setq vip-current-state new-state
)
304 (vip-normalize-minor-mode-map-alist)
305 (vip-adjust-keys-for new-state
)
306 (vip-set-mode-vars-for new-state
)
307 (vip-refresh-mode-line)
312 (defun vip-adjust-keys-for (state)
313 "Make necessary adjustments to keymaps before entering STATE."
314 (cond ((memq state
'(insert-state replace-state
))
317 (define-key vip-insert-basic-map
"\C-m" 'vip-autoindent
)
318 (if vip-want-emacs-keys-in-insert
320 (define-key vip-insert-basic-map
"\C-j" nil
)
322 (define-key vip-insert-basic-map
"\C-j" 'vip-autoindent
)))
323 (define-key vip-insert-basic-map
"\C-m" nil
)
324 (define-key vip-insert-basic-map
"\C-j" nil
))
326 (setq vip-insert-diehard-minor-mode
327 (not vip-want-emacs-keys-in-insert
))
329 (if vip-want-ctl-h-help
331 (define-key vip-insert-basic-map
[(control h
)] 'help-command
)
332 (define-key vip-replace-map
[(control h
)] 'help-command
))
333 (define-key vip-insert-basic-map
334 [(control h
)] 'vip-del-backward-char-in-insert
)
335 (define-key vip-replace-map
336 [(control h
)] 'vip-del-backward-char-in-replace
)))
339 (setq vip-vi-diehard-minor-mode
(not vip-want-emacs-keys-in-vi
))
340 (if vip-want-ctl-h-help
341 (define-key vip-vi-basic-map
[(control h
)] 'help-command
)
342 (define-key vip-vi-basic-map
[(control h
)] 'vip-backward-char
)))
346 ;; Normalizes minor-mode-map-alist by putting Viper keymaps first.
347 ;; This ensures that Viper bindings are in effect, regardless of which minor
348 ;; modes were turned on by the user or by other packages.
349 (defun vip-normalize-minor-mode-map-alist ()
350 (setq minor-mode-map-alist
351 (vip-append-filter-alist
353 (cons 'vip-vi-intercept-minor-mode vip-vi-intercept-map
)
354 (cons 'vip-vi-minibuffer-minor-mode vip-minibuffer-map
)
355 (cons 'vip-vi-local-user-minor-mode vip-vi-local-user-map
)
356 (cons 'vip-vi-kbd-minor-mode vip-vi-kbd-map
)
357 (cons 'vip-vi-global-user-minor-mode vip-vi-global-user-map
)
358 (cons 'vip-vi-state-modifier-minor-mode
360 (cdr (assoc major-mode vip-vi-state-modifier-alist
)))
361 (cdr (assoc major-mode vip-vi-state-modifier-alist
))
363 (cons 'vip-vi-diehard-minor-mode vip-vi-diehard-map
)
364 (cons 'vip-vi-basic-minor-mode vip-vi-basic-map
)
365 (cons 'vip-insert-intercept-minor-mode vip-insert-intercept-map
)
366 (cons 'vip-replace-minor-mode vip-replace-map
)
367 ;; vip-insert-minibuffer-minor-mode must come after
368 ;; vip-replace-minor-mode
369 (cons 'vip-insert-minibuffer-minor-mode
371 (cons 'vip-insert-local-user-minor-mode
372 vip-insert-local-user-map
)
373 (cons 'vip-insert-kbd-minor-mode vip-insert-kbd-map
)
374 (cons 'vip-insert-global-user-minor-mode
375 vip-insert-global-user-map
)
376 (cons 'vip-insert-state-modifier-minor-mode
379 (assoc major-mode vip-insert-state-modifier-alist
)))
381 (assoc major-mode vip-insert-state-modifier-alist
))
383 (cons 'vip-insert-diehard-minor-mode vip-insert-diehard-map
)
384 (cons 'vip-insert-basic-minor-mode vip-insert-basic-map
)
385 (cons 'vip-emacs-intercept-minor-mode
386 vip-emacs-intercept-map
)
387 (cons 'vip-emacs-local-user-minor-mode
388 vip-emacs-local-user-map
)
389 (cons 'vip-emacs-kbd-minor-mode vip-emacs-kbd-map
)
390 (cons 'vip-emacs-global-user-minor-mode
391 vip-emacs-global-user-map
)
392 (cons 'vip-emacs-state-modifier-minor-mode
395 (assoc major-mode vip-emacs-state-modifier-alist
)))
397 (assoc major-mode vip-emacs-state-modifier-alist
))
400 minor-mode-map-alist
)))
406 ;; Viper mode-changing commands and utilities
408 ;; Modifies mode-line-buffer-identification.
409 (defun vip-refresh-mode-line ()
410 (setq vip-mode-string
411 (cond ((eq vip-current-state
'emacs-state
) vip-emacs-state-id
)
412 ((eq vip-current-state
'vi-state
) vip-vi-state-id
)
413 ((eq vip-current-state
'replace-state
) vip-replace-state-id
)
414 ((eq vip-current-state
'insert-state
) vip-insert-state-id
)))
416 ;; Sets Viper mode string in global-mode-string
417 (force-mode-line-update))
420 ;; Switch from Insert state to Vi state.
421 (defun vip-exit-insert-state ()
423 (vip-change-state-to-vi))
425 (defun vip-set-mode-vars-for (state)
426 "Sets Viper minor mode variables to put Viper's state STATE in effect."
429 (setq vip-vi-minibuffer-minor-mode nil
430 vip-insert-minibuffer-minor-mode nil
431 vip-vi-intercept-minor-mode nil
432 vip-insert-intercept-minor-mode nil
434 vip-vi-local-user-minor-mode nil
435 vip-vi-kbd-minor-mode nil
436 vip-vi-global-user-minor-mode nil
437 vip-vi-state-modifier-minor-mode nil
438 vip-vi-diehard-minor-mode nil
439 vip-vi-basic-minor-mode nil
441 vip-replace-minor-mode nil
443 vip-insert-local-user-minor-mode nil
444 vip-insert-kbd-minor-mode nil
445 vip-insert-global-user-minor-mode nil
446 vip-insert-state-modifier-minor-mode nil
447 vip-insert-diehard-minor-mode nil
448 vip-insert-basic-minor-mode nil
449 vip-emacs-intercept-minor-mode t
450 vip-emacs-local-user-minor-mode t
451 vip-emacs-kbd-minor-mode
(not (vip-is-in-minibuffer))
452 vip-emacs-global-user-minor-mode t
453 vip-emacs-state-modifier-minor-mode t
457 (if (eq state
'vi-state
) ; adjust for vi-state
459 vip-vi-intercept-minor-mode t
460 vip-vi-minibuffer-minor-mode
(vip-is-in-minibuffer)
461 vip-vi-local-user-minor-mode t
462 vip-vi-kbd-minor-mode
(not (vip-is-in-minibuffer))
463 vip-vi-global-user-minor-mode t
464 vip-vi-state-modifier-minor-mode t
465 ;; don't let the diehard keymap block command completion
466 ;; and other things in the minibuffer
467 vip-vi-diehard-minor-mode
(not
468 (or vip-want-emacs-keys-in-vi
469 (vip-is-in-minibuffer)))
470 vip-vi-basic-minor-mode t
471 vip-emacs-intercept-minor-mode nil
472 vip-emacs-local-user-minor-mode nil
473 vip-emacs-kbd-minor-mode nil
474 vip-emacs-global-user-minor-mode nil
475 vip-emacs-state-modifier-minor-mode nil
478 ;; Insert and Replace states
479 (if (member state
'(insert-state replace-state
))
481 vip-insert-intercept-minor-mode t
482 vip-replace-minor-mode
(eq state
'replace-state
)
483 vip-insert-minibuffer-minor-mode
(vip-is-in-minibuffer)
484 vip-insert-local-user-minor-mode t
485 vip-insert-kbd-minor-mode
(not (vip-is-in-minibuffer))
486 vip-insert-global-user-minor-mode t
487 vip-insert-state-modifier-minor-mode t
488 ;; don't let the diehard keymap block command completion
489 ;; and other things in the minibuffer
490 vip-insert-diehard-minor-mode
(not
491 (or vip-want-emacs-keys-in-insert
492 (vip-is-in-minibuffer)))
493 vip-insert-basic-minor-mode t
494 vip-emacs-intercept-minor-mode nil
495 vip-emacs-local-user-minor-mode nil
496 vip-emacs-kbd-minor-mode nil
497 vip-emacs-global-user-minor-mode nil
498 vip-emacs-state-modifier-minor-mode nil
502 (if (vip-has-face-support-p)
503 (setq vip-minibuffer-current-face
504 (cond ((eq state
'emacs-state
) vip-minibuffer-emacs-face
)
505 ((eq state
'vi-state
) vip-minibuffer-vi-face
)
506 ((memq state
'(insert-state replace-state
))
507 vip-minibuffer-insert-face
))))
509 (if (vip-is-in-minibuffer)
510 (vip-set-minibuffer-overlay))
513 ;; This also takes care of the annoying incomplete lines in files.
514 ;; Also, this fixes `undo' to work vi-style for complex commands.
515 (defun vip-change-state-to-vi ()
516 "Change Viper state to Vi."
518 (if (and vip-first-time
(not (vip-is-in-minibuffer)))
520 (if overwrite-mode
(overwrite-mode nil
))
521 (if abbrev-mode
(expand-abbrev))
522 (if (and auto-fill-function
(> (current-column) fill-column
))
523 (funcall auto-fill-function
))
524 ;; don't leave whitespace lines around
525 (if (and (memq last-command
527 vip-open-line vip-Open-line
528 vip-replace-state-exit-cmd
))
529 (vip-over-whitespace-line))
530 (indent-to-left-margin))
531 (vip-add-newline-at-eob-if-necessary)
532 (if vip-undo-needs-adjustment
(vip-adjust-undo))
533 (vip-change-state 'vi-state
)
535 ;; always turn off iso-accents-mode, or else we won't be able to use the
536 ;; keys `,',^ in Vi state, as they will do accents instead of Vi actions.
537 (if (and (boundp 'iso-accents-mode
) iso-accents-mode
)
538 (iso-accents-mode -
1))
540 (vip-restore-cursor-color-after-insert)
542 ;; Protection against user errors in hooks
543 (condition-case conds
544 (run-hooks 'vip-vi-state-hook
)
546 (vip-message-conditions conds
)))))
548 (defun vip-change-state-to-insert ()
549 "Change Viper state to Insert."
551 (vip-change-state 'insert-state
)
552 (if (and vip-automatic-iso-accents
(fboundp 'iso-accents-mode
))
553 (iso-accents-mode 1)) ; turn iso accents on
555 (or (stringp vip-saved-cursor-color
)
556 (string= (vip-get-cursor-color) vip-insert-state-cursor-color
)
557 (setq vip-saved-cursor-color
(vip-get-cursor-color)))
558 ;; Commented out, because if vip-change-state-to-insert is executed
559 ;; non-interactively then the old cursor color may get lost. Same old Emacs
560 ;; bug related to local variables?
561 ;;;(if (stringp vip-saved-cursor-color)
562 ;;; (vip-change-cursor-color vip-insert-state-cursor-color))
563 ;; Protection against user errors in hooks
564 (condition-case conds
565 (run-hooks 'vip-insert-state-hook
)
567 (vip-message-conditions conds
))))
569 (defsubst vip-downgrade-to-insert
()
570 (setq vip-current-state
'insert-state
571 vip-replace-minor-mode nil
)
576 ;; Change to replace state. When the end of replacement region is reached,
577 ;; replace state changes to insert state.
578 (defun vip-change-state-to-replace (&optional non-R-cmd
)
579 (vip-change-state 'replace-state
)
580 (if (and vip-automatic-iso-accents
(fboundp 'iso-accents-mode
))
581 (iso-accents-mode 1)) ; turn iso accents on
582 ;; Run insert-state-hook
583 (condition-case conds
584 (run-hooks 'vip-insert-state-hook
'vip-replace-state-hook
)
586 (vip-message-conditions conds
)))
590 ;; 'R' is implemented using Emacs's overwrite-mode
595 (defun vip-change-state-to-emacs ()
596 "Change Viper state to Emacs."
598 (vip-change-state 'emacs-state
)
599 (if (and vip-automatic-iso-accents
(fboundp 'iso-accents-mode
))
600 (iso-accents-mode 1)) ; turn iso accents on
602 ;; Protection agains user errors in hooks
603 (condition-case conds
604 (run-hooks 'vip-emacs-state-hook
)
606 (vip-message-conditions conds
))))
608 ;; escape to emacs mode termporarily
609 (defun vip-escape-to-emacs (arg &optional events
)
610 "Escape to Emacs state from Vi state for one Emacs command.
611 ARG is used as the prefix value for the executed command. If
612 EVENTS is a list of events, which become the beginning of the command."
614 (if (= last-command-char ?
\\)
615 (message "Switched to EMACS state for the next command..."))
616 (vip-escape-to-state arg events
'emacs-state
))
618 ;; escape to Vi mode termporarily
619 (defun vip-escape-to-vi (arg)
620 "Escape from Emacs state to Vi state for one Vi 1-character command.
621 If the Vi command that the user types has a prefix argument, e.g., `d2w', then
622 Vi's prefix argument will be used. Otherwise, the prefix argument passed to
623 `vip-escape-to-vi' is used."
625 (message "Switched to VI state for the next command...")
626 (vip-escape-to-state arg nil
'vi-state
))
628 ;; Escape to STATE mode for one Emacs command.
629 (defun vip-escape-to-state (arg events state
)
630 ;;(let (com key prefix-arg)
632 ;; this temporarily turns off Viper's minor mode keymaps
633 (vip-set-mode-vars-for state
)
634 (vip-normalize-minor-mode-map-alist)
635 (if events
(vip-set-unread-command-events events
))
637 ;; protect against keyboard quit and other errors
639 (let (vip-vi-kbd-minor-mode
640 vip-insert-kbd-minor-mode
641 vip-emacs-kbd-minor-mode
)
644 (setq com
(key-binding (setq key
646 (read-key-sequence nil
)
647 (read-key-sequence nil t
)))))
648 ;; In case of binding indirection--chase definitions.
649 ;; Have to do it here because we execute this command under
650 ;; different keymaps, so command-execute may not do the
652 (while (vectorp com
) (setq com
(key-binding com
))))
654 ;; Execute command com in the original Viper state, not in state
655 ;; `state'. Otherwise, if we switch buffers while executing the
656 ;; escaped to command, Viper's mode vars will remain those of
657 ;; `state'. When we return to the orig buffer, the bindings will be
659 (vip-set-mode-vars-for vip-current-state
)
661 ;; this-command, last-command-char, last-command-event
662 (setq this-command com
)
663 (if vip-xemacs-p
; XEmacs represents key sequences as vectors
664 (setq last-command-event
(vip-copy-event (vip-seq-last-elt key
))
665 last-command-char
(event-to-character last-command-event
))
666 ;; Emacs represents them as sequences (str or vec)
667 (setq last-command-event
(vip-copy-event (vip-seq-last-elt key
))
668 last-command-char last-command-event
))
672 (setq prefix-arg
(or prefix-arg arg
))
673 (command-execute com
)))
677 ;; set state in the new buffer
678 (vip-set-mode-vars-for vip-current-state
))
680 (defun vip-exec-form-in-vi (form)
681 "Execute FORM in Vi state, regardless of the Ccurrent Vi state."
682 (let ((buff (current-buffer))
684 (vip-set-mode-vars-for 'vi-state
)
687 (setq result
(eval form
))
691 (if (not (equal buff
(current-buffer))) ; cmd switched buffer
694 (vip-set-mode-vars-for vip-current-state
)))
695 (vip-set-mode-vars-for vip-current-state
)
698 (defun vip-exec-form-in-emacs (form)
699 "Execute FORM in Emacs, temporarily disabling Viper's minor modes.
700 Similar to vip-escape-to-emacs, but accepts forms rather than keystrokes."
701 (let ((buff (current-buffer))
703 (vip-set-mode-vars-for 'emacs-state
)
704 (setq result
(eval form
))
705 (if (not (equal buff
(current-buffer))) ; cmd switched buffer
708 (vip-set-mode-vars-for vip-current-state
)))
709 (vip-set-mode-vars-for vip-current-state
)
713 ;; This is needed because minor modes sometimes override essential Viper
714 ;; bindings. By letting Viper know which files these modes are in, it will
715 ;; arrange to reorganize minor-mode-map-alist so that things will work right.
716 (defun vip-harness-minor-mode (load-file)
717 "Familiarize Viper with a minor mode defined in LOAD_FILE.
718 Minor modes that have their own keymaps may overshadow Viper keymaps.
719 This function is designed to make Viper aware of the packages that define
722 (vip-harness-minor-mode load-file)
724 LOAD-FILE is a name of the file where the specific minor mode is defined.
725 Suffixes such as .el or .elc should be stripped."
727 (interactive "sEnter name of the load file: ")
729 (vip-eval-after-load load-file
'(vip-normalize-minor-mode-map-alist))
731 ;; Change the default for minor-mode-map-alist each time a harnessed minor
732 ;; mode adds its own keymap to the a-list.
734 load-file
'(setq-default minor-mode-map-alist minor-mode-map-alist
))
739 "Emulate ESC key in Emacs.
740 Prevents multiple escape keystrokes if vip-no-multiple-ESC is true.
741 If vip-no-multiple-ESC is 'twice double ESC would ding in vi-state.
742 Other ESC sequences are emulated via the current Emacs's major mode
743 keymap. This is more convenient on TTYs, since this won't block
744 function keys such as up,down, etc. ESC will also will also work as
745 a Meta key in this case. When vip-no-multiple-ESC is nil, ESC functions
746 as a Meta key and any number of multiple escapes is allowed."
749 (cond ((and (not vip-no-multiple-ESC
) (eq vip-current-state
'vi-state
))
750 (setq char
(vip-read-char-exclusive))
751 (vip-escape-to-emacs arg
(list ?\e char
) ))
752 ((and (eq vip-no-multiple-ESC
'twice
)
753 (eq vip-current-state
'vi-state
))
754 (setq char
(vip-read-char-exclusive))
755 (if (= char
(string-to-char vip-ESC-key
))
757 (vip-escape-to-emacs arg
(list ?\e char
) )))
761 (defun vip-alternate-Meta-key (arg)
762 "Simulate Emacs Meta key."
764 (sit-for 1) (message "ESC-")
765 (vip-escape-to-emacs arg
'(?\e
)))
767 (defun vip-toggle-key-action ()
768 "Action bound to `vip-toggle-key'."
770 (if (and (< viper-expert-level
2) (equal vip-toggle-key
"\C-z"))
771 (if (vip-window-display-p)
774 (vip-change-state-to-emacs)))
777 ;; Intercept ESC sequences on dumb terminals.
778 ;; Based on the idea contributed by Marcelino Veiga Tuimil <mveiga@dit.upm.es>
780 ;; Check if last key was ESC and if so try to reread it as a function key.
781 ;; But only if there are characters to read during a very short time.
782 ;; Returns the last event, if any.
783 (defun vip-envelop-ESC-key ()
784 (let ((event last-input-event
)
787 (if (vip-ESC-event-p event)
789 (if (vip-fast-keysequence-p)
791 (let (minor-mode-map-alist)
792 (vip-set-unread-command-events event)
795 (ad-get-orig-definition 'read-key-sequence) nil))
797 ;; If keyseq translates into something that still has ESC
798 ;; at the beginning, separate ESC from the rest of the seq.
799 ;; In XEmacs we check for events that are keypress meta-key
800 ;; and convert them into [escape key]
802 ;; This is needed for the following reason:
803 ;; If ESC is the first symbol, we interpret it as if the
804 ;; user typed ESC and then quickly some other symbols.
805 ;; If ESC is not the first one, then the key sequence
806 ;; entered was apparently translated into a function key or
807 ;; something (e.g., one may have
808 ;; (define-key function-key-map "\e[192z" [f11])
809 ;; which would translate the escape-sequence generated by
810 ;; f11 in an xterm window into the symbolic key f11.
812 ;; If `first-key' is not an ESC event, we make it into the
813 ;; last-command-event in order to pretend that this key was
814 ;; pressed. This is needed to allow arrow keys to be bound to
815 ;; macros. Otherwise, vip-exec-mapped-kbd-macro will think that
816 ;; the last event was ESC and so it'll execute whatever is
817 ;; bound to ESC. (Viper macros can't be bound to
819 (let* ((first-key (elt keyseq 0))
820 (key-mod (event-modifiers first-key)))
821 (cond ((vip-ESC-event-p first-key)
822 ;; put keys following ESC on the unread list
823 ;; and return ESC as the key-sequence
824 (vip-set-unread-command-events (subseq keyseq 1))
825 (setq last-input-event event
826 keyseq (if vip-emacs-p
828 (vector (character-to-event ?\e)))))
830 (key-press-event-p first-key)
831 (equal '(meta) key-mod))
832 (vip-set-unread-command-events
834 (character-to-event (event-key first-key)))
836 (setq last-input-event event
837 keyseq (vector (character-to-event ?\e))))
839 (setq last-command-event (vip-copy-event first-key)))
843 ;; this is escape event with nothing after it
844 ;; put in unread-command-event and then re-read
845 (vip-set-unread-command-events event)
847 (funcall (ad-get-orig-definition 'read-key-sequence) nil))
849 ;; not an escape event
850 (setq keyseq (vector event)))
855 ;; Listen to ESC key.
856 ;; If a sequence of keys starting with ESC is issued with very short delays,
857 ;; interpret these keys in Emacs mode, so ESC won't be interpreted as a Vi key.
858 (defun vip-intercept-ESC-key ()
859 "Function that implements ESC key in Viper emulation of Vi."
861 (let ((cmd (or (key-binding (vip-envelop-ESC-key))
862 '(lambda () (interactive) (error "")))))
864 ;; call the actual function to execute ESC (if no other symbols followed)
865 ;; or the key bound to the ESC sequence (if the sequence was issued
866 ;; with very short delay between characters.
867 (if (eq cmd 'vip-intercept-ESC-key)
869 (cond ((eq vip-current-state 'vi-state)
871 ((eq vip-current-state 'insert-state)
872 'vip-exit-insert-state)
873 ((eq vip-current-state 'replace-state)
874 'vip-replace-state-exit-cmd)
875 (t 'vip-change-state-to-vi)
877 (call-interactively cmd)))
882 ;; prefix argument for Vi mode
884 ;; In Vi mode, prefix argument is a dotted pair (NUM . COM) where NUM
885 ;; represents the numeric value of the prefix argument and COM represents
886 ;; command prefix such as "c", "d", "m" and "y".
888 ;; Get value part of prefix-argument ARG.
889 (defsubst vip-p-val (arg)
892 (if (or (null (car arg)) (equal (car arg) '(nil)))
896 ;; Get raw value part of prefix-argument ARG.
897 (defsubst vip-P-val (arg)
898 (cond ((consp arg) (car arg))
901 ;; Get com part of prefix-argument ARG.
902 (defsubst vip-getcom (arg)
903 (cond ((null arg) nil)
904 ((consp arg) (cdr arg))
907 ;; Get com part of prefix-argument ARG and modify it.
908 (defun vip-getCom (arg)
909 (let ((com (vip-getcom arg)))
910 (cond ((equal com ?c) ?C)
916 ;; Compute numeric prefix arg value.
917 ;; Invoked by EVENT. COM is the command part obtained so far.
918 (defun vip-prefix-arg-value (event com)
921 (while (and (vip-characterp event) (>= event ?0) (<= event ?9))
922 (setq value (+ (* (if (integerp value) value 0) 10) (- event ?0)))
923 (setq event (vip-read-event-convert-to-char)))
925 (setq prefix-arg value)
926 (if com (setq prefix-arg (cons prefix-arg com)))
928 (vip-describe-arg prefix-arg)
929 (setq event (vip-read-event-convert-to-char)))
931 (if (or com (and (not (eq vip-current-state 'vi-state))
932 ;; make sure it is a Vi command
933 (vip-characterp event) (vip-vi-command-p event)
935 ;; If appears to be one of the vi commands,
936 ;; then execute it with funcall and clear prefix-arg in order to not
937 ;; confuse subsequent commands
939 ;; last-command-char is the char we want emacs to think was typed
940 ;; last. If com is not nil, the vip-digit-argument command was called
941 ;; from within vip-prefix-arg command, such as `d', `w', etc., i.e.,
942 ;; the user typed, say, d2. In this case, `com' would be `d', `w',
944 ;; If vip-digit-argument was invoked by vip-escape-to-vi (which is
945 ;; indicated by the fact that the current state is not vi-state),
946 ;; then `event' represents the vi command to be executed (e.g., `d',
947 ;; `w', etc). Again, last-command-char must make emacs believe that
948 ;; this is the command we typed.
949 (setq last-command-char (or com event))
950 (setq func (vip-exec-form-in-vi
951 (` (key-binding (char-to-string (, event))))))
952 (funcall func prefix-arg)
953 (setq prefix-arg nil))
954 ;; some other command -- let emacs do it in its own way
955 (vip-set-unread-command-events event))
959 ;; Vi operator as prefix argument."
960 (defun vip-prefix-arg-com (char value com)
966 (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\"
967 vip-buffer-search-char)))
969 ;; this means that we already have a command character, so we
970 ;; construct a com list and exit while. however, if char is "
973 ;; new com is (CHAR . OLDCOM)
974 (if (memq char '(?# ?\")) (error ""))
975 (setq com (cons char com))
977 ;; If com is nil we set com as char, and read more. Again, if char
978 ;; is ", we read the name of register and store it in vip-use-register.
979 ;; if char is !, =, or #, a complete com is formed so we exit the
981 (cond ((memq char '(?! ?=))
983 (setq char (read-char))
986 ;; read a char and encode it as com
987 (setq com (+ 128 (read-char)))
988 (setq char (read-char)))
990 (let ((reg (read-char)))
991 (if (vip-valid-register reg)
992 (setq vip-use-register reg)
994 (setq char (read-char))))
997 (setq char (read-char))))))
1000 ;; `com' is a single char, so we construct the command argument
1001 ;; and if `char' is `?', we describe the arg; otherwise
1002 ;; we prepare the command that will be executed at the end.
1004 (setq cmd-info (cons value com))
1006 (vip-describe-arg cmd-info)
1007 (setq char (read-char)))
1008 ;; `char' is a movement cmd, a digit arg cmd, or a register cmd---so we
1009 ;; execute it at the very end
1010 (or (vip-movement-command-p char)
1011 (vip-digit-command-p char)
1012 (vip-regsuffix-command-p char)
1013 (= char ?!) ; bang command
1015 (setq cmd-to-exec-at-end
1016 (vip-exec-form-in-vi
1017 (` (key-binding (char-to-string (, char)))))))
1019 ;; as com is non-nil, this means that we have a command to execute
1020 (if (memq (car com) '(?r ?R))
1021 ;; execute apropriate region command.
1022 (let ((char (car com)) (com (cdr com)))
1023 (setq prefix-arg (cons value com))
1024 (if (= char ?r) (vip-region prefix-arg)
1025 (vip-Region prefix-arg))
1027 (setq prefix-arg nil))
1028 ;; otherwise, reset prefix arg and call appropriate command
1029 (setq value (if (null value) 1 value))
1030 (setq prefix-arg nil)
1031 (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C)))
1032 ((equal com '(?d . ?d)) (vip-line (cons value ?D)))
1033 ((equal com '(?d . ?y)) (vip-yank-defun))
1034 ((equal com '(?y . ?y)) (vip-line (cons value ?Y)))
1035 ((equal com '(?< . ?<)) (vip-line (cons value ?<)))
1036 ((equal com '(?> . ?>)) (vip-line (cons value ?>)))
1037 ((equal com '(?! . ?!)) (vip-line (cons value ?!)))
1038 ((equal com '(?= . ?=)) (vip-line (cons value ?=)))
1041 (if cmd-to-exec-at-end
1043 (setq last-command-char char)
1044 (setq last-command-event
1046 (if vip-xemacs-p (character-to-event char) char)))
1048 (funcall cmd-to-exec-at-end cmd-info)
1053 (defun vip-describe-arg (arg)
1055 (setq val (vip-P-val arg)
1056 com (vip-getcom arg))
1059 (message "Value is nil, and command is nil")
1060 (message "Value is nil, and command is `%c'" com))
1062 (message "Value is `%d', and command is nil" val)
1063 (message "Value is `%d', and command is `%c'" val com)))))
1065 (defun vip-digit-argument (arg)
1066 "Begin numeric argument for the next command."
1068 (vip-leave-region-active)
1069 (vip-prefix-arg-value
1070 last-command-char (if (consp arg) (cdr arg) nil)))
1072 (defun vip-command-argument (arg)
1073 "Accept a motion command as an argument."
1075 (let ((vip-inside-command-argument-action t))
1079 (cond ((null arg) nil)
1080 ((consp arg) (car arg))
1081 ((integerp arg) arg)
1082 (t (error vip-InvalidCommandArgument)))
1083 (cond ((null arg) nil)
1084 ((consp arg) (cdr arg))
1085 ((integerp arg) nil)
1086 (t (error vip-InvalidCommandArgument))))
1087 (quit (setq vip-use-register nil)
1088 (signal 'quit nil)))
1089 (vip-deactivate-mark)))
1092 ;; repeat last destructive command
1094 ;; Append region to text in register REG.
1095 ;; START and END are buffer positions indicating what to append.
1096 (defsubst vip-append-to-register (reg start end)
1097 (set-register reg (concat (if (stringp (get-register reg))
1098 (get-register reg) "")
1099 (buffer-substring start end))))
1101 ;; Saves last inserted text for possible use by vip-repeat command.
1102 (defun vip-save-last-insertion (beg end)
1103 (setq vip-last-insertion (buffer-substring beg end))
1104 (or (< (length vip-d-com) 5)
1105 (setcar (nthcdr 4 vip-d-com) vip-last-insertion))
1106 (or (null vip-command-ring)
1107 (ring-empty-p vip-command-ring)
1109 (setcar (nthcdr 4 (vip-current-ring-item vip-command-ring))
1111 ;; del most recent elt, if identical to the second most-recent
1112 (vip-cleanup-ring vip-command-ring)))
1115 (defsubst vip-yank-last-insertion ()
1116 "Inserts the text saved by the previous vip-save-last-insertion command."
1118 (insert vip-last-insertion)
1122 ;; define functions to be executed
1124 ;; invoked by the `C' command
1125 (defun vip-exec-change (m-com com)
1126 (or (and (markerp vip-com-point) (marker-position vip-com-point))
1127 (set-marker vip-com-point (point) (current-buffer)))
1128 ;; handle C cmd at the eol and at eob.
1129 (if (or (and (eolp) (= vip-com-point (point)))
1130 (= vip-com-point (point-max)))
1132 (insert " ")(backward-char 1)))
1133 (if (= vip-com-point (point))
1134 (vip-forward-char-carefully))
1136 (vip-change vip-com-point (point))
1137 (vip-change-subr vip-com-point (point))))
1139 ;; this is invoked by vip-substitute-line
1140 (defun vip-exec-Change (m-com com)
1142 (set-mark vip-com-point)
1143 (vip-enlarge-region (mark t) (point))
1144 (if vip-use-register
1146 (cond ((vip-valid-register vip-use-register '(letter digit))
1147 ;;(vip-valid-register vip-use-register '(letter)
1149 vip-use-register (mark t) (point) nil))
1150 ((vip-valid-register vip-use-register '(Letter))
1151 (vip-append-to-register
1152 (downcase vip-use-register) (mark t) (point)))
1153 (t (setq vip-use-register nil)
1154 (error vip-InvalidRegister vip-use-register)))
1155 (setq vip-use-register nil)))
1156 (delete-region (mark t) (point)))
1158 (if (= com ?C) (vip-change-mode-to-insert) (vip-yank-last-insertion)))
1160 (defun vip-exec-delete (m-com com)
1161 (or (and (markerp vip-com-point) (marker-position vip-com-point))
1162 (set-marker vip-com-point (point) (current-buffer)))
1163 (if vip-use-register
1165 (cond ((vip-valid-register vip-use-register '(letter digit))
1166 ;;(vip-valid-register vip-use-register '(letter))
1168 vip-use-register vip-com-point (point) nil))
1169 ((vip-valid-register vip-use-register '(Letter))
1170 (vip-append-to-register
1171 (downcase vip-use-register) vip-com-point (point)))
1172 (t (setq vip-use-register nil)
1173 (error vip-InvalidRegister vip-use-register)))
1174 (setq vip-use-register nil)))
1176 (if (eq last-command 'd-command) 'kill-region nil))
1177 (kill-region vip-com-point (point))
1178 (setq this-command 'd-command)
1179 (if vip-ex-style-motion
1180 (if (and (eolp) (not (bolp))) (backward-char 1))))
1182 (defun vip-exec-Delete (m-com com)
1184 (set-mark vip-com-point)
1185 (vip-enlarge-region (mark t) (point))
1186 (if vip-use-register
1188 (cond ((vip-valid-register vip-use-register '(letter digit))
1189 ;;(vip-valid-register vip-use-register '(letter))
1191 vip-use-register (mark t) (point) nil))
1192 ((vip-valid-register vip-use-register '(Letter))
1193 (vip-append-to-register
1194 (downcase vip-use-register) (mark t) (point)))
1195 (t (setq vip-use-register nil)
1196 (error vip-InvalidRegister vip-use-register)))
1197 (setq vip-use-register nil)))
1199 (if (eq last-command 'D-command) 'kill-region nil))
1200 (kill-region (mark t) (point))
1201 (if (eq m-com 'vip-line) (setq this-command 'D-command)))
1202 (back-to-indentation))
1204 (defun vip-exec-yank (m-com com)
1205 (or (and (markerp vip-com-point) (marker-position vip-com-point))
1206 (set-marker vip-com-point (point) (current-buffer)))
1207 (if vip-use-register
1209 (cond ((vip-valid-register vip-use-register '(letter digit))
1210 ;; (vip-valid-register vip-use-register '(letter))
1212 vip-use-register vip-com-point (point) nil))
1213 ((vip-valid-register vip-use-register '(Letter))
1214 (vip-append-to-register
1215 (downcase vip-use-register) vip-com-point (point)))
1216 (t (setq vip-use-register nil)
1217 (error vip-InvalidRegister vip-use-register)))
1218 (setq vip-use-register nil)))
1219 (setq last-command nil)
1220 (copy-region-as-kill vip-com-point (point))
1221 (goto-char vip-com-point))
1223 (defun vip-exec-Yank (m-com com)
1225 (set-mark vip-com-point)
1226 (vip-enlarge-region (mark t) (point))
1227 (if vip-use-register
1229 (cond ((vip-valid-register vip-use-register '(letter digit))
1231 vip-use-register (mark t) (point) nil))
1232 ((vip-valid-register vip-use-register '(Letter))
1233 (vip-append-to-register
1234 (downcase vip-use-register) (mark t) (point)))
1235 (t (setq vip-use-register nil)
1236 (error vip-InvalidRegister vip-use-register)))
1237 (setq vip-use-register nil)))
1238 (setq last-command nil)
1239 (copy-region-as-kill (mark t) (point)))
1240 (vip-deactivate-mark)
1241 (goto-char vip-com-point))
1243 (defun vip-exec-bang (m-com com)
1245 (set-mark vip-com-point)
1246 (vip-enlarge-region (mark t) (point))
1247 (exchange-point-and-mark)
1248 (shell-command-on-region
1251 (setq vip-last-shell-com
1252 (vip-read-string-with-history
1256 (car vip-shell-history)
1261 (defun vip-exec-equals (m-com com)
1263 (set-mark vip-com-point)
1264 (vip-enlarge-region (mark t) (point))
1265 (if (> (mark t) (point)) (exchange-point-and-mark))
1266 (indent-region (mark t) (point) nil)))
1268 (defun vip-exec-shift (m-com com)
1270 (set-mark vip-com-point)
1271 (vip-enlarge-region (mark t) (point))
1272 (if (> (mark t) (point)) (exchange-point-and-mark))
1273 (indent-rigidly (mark t) (point)
1276 (- vip-shift-width))))
1277 ;; return point to where it was before shift
1278 (goto-char vip-com-point))
1280 ;; this is needed because some commands fake com by setting it to ?r, which
1281 ;; denotes repeated insert command.
1282 (defsubst vip-exec-dummy (m-com com)
1285 (defun vip-exec-buffer-search (m-com com)
1286 (setq vip-s-string (buffer-substring (point) vip-com-point))
1287 (setq vip-s-forward t)
1288 (setq vip-search-history (cons vip-s-string vip-search-history))
1289 (vip-search vip-s-string vip-s-forward 1))
1291 (defvar vip-exec-array (make-vector 128 nil))
1293 ;; Using a dispatch array allows adding functions like buffer search
1294 ;; without affecting other functions. Buffer search can now be bound
1295 ;; to any character.
1297 (aset vip-exec-array ?c 'vip-exec-change)
1298 (aset vip-exec-array ?C 'vip-exec-Change)
1299 (aset vip-exec-array ?d 'vip-exec-delete)
1300 (aset vip-exec-array ?D 'vip-exec-Delete)
1301 (aset vip-exec-array ?y 'vip-exec-yank)
1302 (aset vip-exec-array ?Y 'vip-exec-Yank)
1303 (aset vip-exec-array ?r 'vip-exec-dummy)
1304 (aset vip-exec-array ?! 'vip-exec-bang)
1305 (aset vip-exec-array ?< 'vip-exec-shift)
1306 (aset vip-exec-array ?> 'vip-exec-shift)
1307 (aset vip-exec-array ?= 'vip-exec-equals)
1311 ;; This function is called by various movement commands to execute a
1312 ;; destructive command on the region specified by the movement command. For
1313 ;; instance, if the user types cw, then the command vip-forward-word will
1314 ;; call vip-execute-com to execute vip-exec-change, which eventually will
1315 ;; call vip-change to invoke the replace mode on the region.
1317 ;; The list (M-COM VAL COM REG INSETED-TEXT COMMAND-KEYS) is set to
1318 ;; vip-d-com for later use by vip-repeat.
1319 (defun vip-execute-com (m-com val com)
1320 (let ((reg vip-use-register))
1321 ;; this is the special command `#'
1323 (vip-special-prefix-com (- com 128))
1324 (let ((fn (aref vip-exec-array (if (< com 0) (- com) com))))
1326 (error "%c: %s" com vip-InvalidViCommand)
1327 (funcall fn m-com com))))
1328 (if (vip-dotable-command-p com)
1329 (vip-set-destructive-command
1331 (if (memq com (list ?c ?C ?!)) (- com) com)
1336 (defun vip-repeat (arg)
1337 "Re-execute last destructive command.
1338 Use the info in vip-d-com, which has the form
1339 \(com val ch reg inserted-text command-keys\),
1340 where `com' is the command to be re-executed, `val' is the
1341 argument to `com', `ch' is a flag for repeat, and `reg' is optional;
1342 if it exists, it is the name of the register for `com'.
1343 If the prefix argument, ARG, is non-nil, it is used instead of `val'."
1345 (let ((save-point (point)) ; save point before repeating prev cmd
1346 ;; Pass along that we are repeating a destructive command
1347 ;; This tells vip-set-destructive-command not to update
1349 (vip-intermediate-command 'vip-repeat))
1350 (if (eq last-command 'vip-undo)
1351 ;; if the last command was vip-undo, then undo-more
1353 ;; otherwise execute the command stored in vip-d-com. if arg is non-nil
1354 ;; its prefix value is used as new prefix value for the command.
1355 (let ((m-com (car vip-d-com))
1356 (val (vip-P-val arg))
1357 (com (nth 2 vip-d-com))
1358 (reg (nth 3 vip-d-com)))
1359 (if (null val) (setq val (nth 1 vip-d-com)))
1360 (if (null m-com) (error "No previous command to repeat."))
1361 (setq vip-use-register reg)
1362 (if (nth 4 vip-d-com) ; text inserted by command
1363 (setq vip-last-insertion (nth 4 vip-d-com)
1364 vip-d-char (nth 4 vip-d-com)))
1365 (funcall m-com (cons val com))
1366 (cond ((and (< save-point (point)) vip-keep-point-on-repeat)
1367 (goto-char save-point)) ; go back to before repeat.
1368 ((and (< save-point (point)) vip-ex-style-editing-in-insert)
1369 (or (bolp) (backward-char 1))))
1370 (if (and (eolp) (not (bolp)))
1373 (if vip-undo-needs-adjustment (vip-adjust-undo)) ; take care of undo
1374 ;; If the prev cmd was rotating the command ring, this means that `.' has
1375 ;; just executed a command from that ring. So, push it on the ring again.
1376 ;; If we are just executing previous command , then don't push vip-d-com
1377 ;; because vip-d-com is not fully constructed in this case (its keys and
1378 ;; the inserted text may be nil). Besides, in this case, the command
1379 ;; executed by `.' is already on the ring.
1380 (if (eq last-command 'vip-display-current-destructive-command)
1381 (vip-push-onto-ring vip-d-com 'vip-command-ring))
1382 (vip-deactivate-mark)
1385 (defun vip-repeat-from-history ()
1386 "Repeat a destructive command from history.
1387 Doesn't change vip-command-ring in any way, so `.' will work as before
1388 executing this command.
1389 This command is supposed to be bound to a two-character Vi macro where
1390 the second character is a digit 0 to 9. The digit indicates which
1391 history command to execute. `<char>0' is equivalent to `.', `<char>1'
1392 invokes the command before that, etc."
1394 (let* ((vip-intermediate-command 'repeating-display-destructive-command)
1395 (idx (cond (vip-this-kbd-macro
1397 (symbol-name (elt vip-this-kbd-macro 1))))
1400 (vip-d-com vip-d-com))
1402 (or (and (numberp num) (<= 0 num) (<= num 9))
1407 "`vip-repeat-from-history' must be invoked as a Vi macro bound to `<key><digit>'")))
1409 (setq vip-d-com (vip-special-ring-rotate1 vip-command-ring -1))
1410 (setq num (1- num)))
1413 (vip-special-ring-rotate1 vip-command-ring 1)
1414 (setq num (1+ num)))
1418 ;; The hash-command. It is invoked interactively by the key sequence #<char>.
1419 ;; The chars that can follow `#' are determined by vip-hash-command-p
1420 (defun vip-special-prefix-com (char)
1422 (downcase-region (min vip-com-point (point))
1423 (max vip-com-point (point))))
1425 (upcase-region (min vip-com-point (point))
1426 (max vip-com-point (point))))
1428 (push-mark vip-com-point t)
1429 (vip-global-execute))
1431 (push-mark vip-com-point t)
1433 ((= char ?s) (funcall vip-spell-function vip-com-point (point)))
1434 (t (error "#%c: %s" char vip-InvalidViCommand))))
1440 "Undo previous change."
1443 (let ((modified (buffer-modified-p))
1444 (before-undo-pt (point-marker))
1445 (after-change-functions after-change-functions)
1446 undo-beg-posn undo-end-posn)
1448 ;; no need to remove this hook, since this var has scope inside a let.
1449 (add-hook 'after-change-functions
1450 '(lambda (beg end len)
1451 (setq undo-beg-posn beg
1452 undo-end-posn (or end beg))))
1456 (setq undo-beg-posn (or undo-beg-posn before-undo-pt)
1457 undo-end-posn (or undo-end-posn undo-beg-posn))
1459 (goto-char undo-beg-posn)
1461 (if (and vip-keep-point-on-undo
1462 (pos-visible-in-window-p before-undo-pt))
1464 (push-mark (point-marker) t)
1465 (vip-sit-for-short 300)
1466 (goto-char undo-end-posn)
1467 (vip-sit-for-short 300)
1468 (if (and (> (abs (- undo-beg-posn before-undo-pt)) 1)
1469 (> (abs (- undo-end-posn before-undo-pt)) 1))
1470 (goto-char before-undo-pt)
1471 (goto-char undo-beg-posn)))
1472 (push-mark before-undo-pt t))
1473 (if (and (eolp) (not (bolp))) (backward-char 1))
1474 (if (not modified) (set-buffer-modified-p t)))
1475 (setq this-command 'vip-undo))
1477 ;; Continue undoing previous changes.
1478 (defun vip-undo-more ()
1479 (message "undo more!")
1483 (message "No further undo information in this buffer")))
1484 (if (and (eolp) (not (bolp))) (backward-char 1))
1485 (setq this-command 'vip-undo))
1487 ;; The following two functions are used to set up undo properly.
1488 ;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines,
1489 ;; they are undone all at once.
1490 (defun vip-adjust-undo ()
1491 (let ((inhibit-quit t)
1493 (setq vip-undo-needs-adjustment nil)
1494 (if (listp buffer-undo-list)
1495 (if (setq tmp (memq vip-buffer-undo-list-mark buffer-undo-list))
1497 (setq tmp2 (cdr tmp)) ; the part after mark
1499 ;; cut tail from buffer-undo-list temporarily by direct
1500 ;; manipulation with pointers in buffer-undo-list
1503 (setq buffer-undo-list (delq nil buffer-undo-list))
1504 (setq buffer-undo-list
1505 (delq vip-buffer-undo-list-mark buffer-undo-list))
1506 ;; restore tail of buffer-undo-list
1507 (setq buffer-undo-list (nconc buffer-undo-list tmp2)))
1508 (setq buffer-undo-list (delq nil buffer-undo-list))))))
1511 (defun vip-set-complex-command-for-undo ()
1512 (if (listp buffer-undo-list)
1513 (if (not vip-undo-needs-adjustment)
1514 (let ((inhibit-quit t))
1515 (setq buffer-undo-list
1516 (cons vip-buffer-undo-list-mark buffer-undo-list))
1517 (setq vip-undo-needs-adjustment t)))))
1522 (defun vip-display-current-destructive-command ()
1523 (let ((text (nth 4 vip-d-com))
1524 (keys (nth 5 vip-d-com))
1527 (setq this-command 'vip-display-current-destructive-command)
1529 (message " `.' runs %s%s"
1530 (concat "`" (vip-array-to-string keys) "'")
1531 (vip-abbreviate-string text max-text-len
1532 " inserting `" "'" " ......."))
1536 ;; don't change vip-d-com if it was vip-repeat command invoked with `.'
1537 ;; or in some other way (non-interactively).
1538 (defun vip-set-destructive-command (list)
1539 (or (eq vip-intermediate-command 'vip-repeat)
1541 (setq vip-d-com list)
1542 (setcar (nthcdr 5 vip-d-com)
1543 (vip-array-to-string (this-command-keys)))
1544 (vip-push-onto-ring vip-d-com 'vip-command-ring))))
1546 (defun vip-prev-destructive-command (next)
1547 "Find previous destructive command in the history of destructive commands.
1548 With prefix argument, find next destructive command."
1550 (let (cmd vip-intermediate-command)
1551 (if (eq last-command 'vip-display-current-destructive-command)
1552 ;; repeated search through command history
1553 (setq vip-intermediate-command 'repeating-display-destructive-command)
1554 ;; first search through command history--set temp ring
1555 (setq vip-temp-command-ring (copy-list vip-command-ring)))
1557 (vip-special-ring-rotate1 vip-temp-command-ring 1)
1558 (vip-special-ring-rotate1 vip-temp-command-ring -1)))
1561 (setq vip-d-com cmd))
1562 (vip-display-current-destructive-command)))
1564 (defun vip-next-destructive-command ()
1565 "Find next destructive command in the history of destructive commands."
1567 (vip-prev-destructive-command 'next))
1569 (defun vip-insert-prev-from-insertion-ring (arg)
1570 "Cycle through insertion ring in the direction of older insertions.
1571 Undoes previous insertion and inserts new.
1572 With prefix argument, cycles in the direction of newer elements.
1573 In minibuffer, this command executes whatever the invocation key is bound
1574 to in the global map, instead of cycling through the insertion ring."
1576 (let (vip-intermediate-command)
1577 (if (eq last-command 'vip-insert-from-insertion-ring)
1578 (progn ; repeated search through insertion history
1579 (setq vip-intermediate-command 'repeating-insertion-from-ring)
1580 (if (eq vip-current-state 'replace-state)
1582 (if vip-last-inserted-string-from-insertion-ring
1583 (backward-delete-char
1584 (length vip-last-inserted-string-from-insertion-ring))))
1586 ;;first search through insertion history
1587 (setq vip-temp-insertion-ring (copy-list vip-insertion-ring)))
1588 (setq this-command 'vip-insert-from-insertion-ring)
1589 ;; so that things will be undone properly
1590 (setq buffer-undo-list (cons nil buffer-undo-list))
1591 (setq vip-last-inserted-string-from-insertion-ring
1592 (vip-special-ring-rotate1 vip-temp-insertion-ring (if arg 1 -1)))
1594 ;; this change of vip-intermediate-command must come after
1595 ;; vip-special-ring-rotate1, so that the ring will rotate, but before the
1597 (setq vip-intermediate-command nil)
1598 (if vip-last-inserted-string-from-insertion-ring
1599 (insert vip-last-inserted-string-from-insertion-ring))
1602 (defun vip-insert-next-from-insertion-ring ()
1603 "Cycle through insertion ring in the direction of older insertions.
1604 Undo previous insertion and inserts new."
1606 (vip-insert-prev-from-insertion-ring 'next))
1609 ;; some region utilities
1611 ;; If at the last line of buffer, add \\n before eob, if newline is missing.
1612 (defun vip-add-newline-at-eob-if-necessary ()
1615 ;; make sure all lines end with newline, unless in the minibuffer or
1616 ;; when requested otherwise (require-final-newline is nil)
1619 require-final-newline
1620 (not (vip-is-in-minibuffer))
1621 (not buffer-read-only))
1624 (defun vip-yank-defun ()
1626 (copy-region-as-kill (point) (mark t)))
1628 ;; Enlarge region between BEG and END.
1629 (defun vip-enlarge-region (beg end)
1630 (or beg (setq beg end)) ; if beg is nil, set to end
1631 (or end (setq end beg)) ; if end is nil, set to beg
1634 (progn (goto-char beg) (set-mark end))
1638 (exchange-point-and-mark)
1639 (if (or (not (eobp)) (not (bolp))) (forward-line 1))
1640 (if (not (eobp)) (beginning-of-line))
1641 (if (> beg end) (exchange-point-and-mark)))
1644 ;; Quote region by each line with a user supplied string.
1645 (defun vip-quote-region ()
1646 (setq vip-quote-string
1647 (vip-read-string-with-history
1650 'vip-quote-region-history
1652 (vip-enlarge-region (point) (mark t))
1653 (if (> (point) (mark t)) (exchange-point-and-mark))
1654 (insert vip-quote-string)
1657 (while (and (< (point) (mark t)) (bolp))
1658 (insert vip-quote-string)
1662 ;; Tells whether BEG is on the same line as END.
1663 ;; If one of the args is nil, it'll return nil.
1664 (defun vip-same-line (beg end)
1665 (let ((selective-display nil)
1668 (if (and beg end (> beg end))
1673 (cond ((or (> beg (point-max)) (> end (point-max))) ; out of range
1676 ;; This 'if' is needed because Emacs treats the next empty line
1677 ;; as part of the previous line.
1678 (if (= (vip-line-pos 'start) end)
1680 (<= (+ incr (count-lines beg end)) 1))))
1684 ;; Check if the string ends with a newline.
1685 (defun vip-end-with-a-newline-p (string)
1686 (or (string= string "")
1687 (= (vip-seq-last-elt string) ?\n)))
1689 (defun vip-tmp-insert-at-eob (msg)
1690 (let ((savemax (point-max)))
1694 (goto-char savemax) (delete-region (point) (point-max))
1699 ;;; Minibuffer business
1701 (defsubst vip-set-minibuffer-style ()
1702 (add-hook 'minibuffer-setup-hook 'vip-minibuffer-setup-sentinel))
1705 (defun vip-minibuffer-setup-sentinel ()
1706 (let ((hook (if vip-vi-style-in-minibuffer
1707 'vip-change-state-to-insert
1708 'vip-change-state-to-emacs)))
1712 ;; Interpret last event in the local map
1713 (defun vip-exit-minibuffer ()
1716 (setq command (local-key-binding (char-to-string last-command-char)))
1718 (command-execute command)
1719 (exit-minibuffer))))
1722 ;;; Reading string with history
1724 (defun vip-read-string-with-history (prompt &optional initial
1725 history-var default keymap)
1726 ;; Read string, prompting with PROMPT and inserting the INITIAL
1727 ;; value. Uses HISTORY-VAR. DEFAULT is the default value to accept if the
1728 ;; input is an empty string. Use KEYMAP, if given, or the
1729 ;; minibuffer-local-map.
1730 ;; Default value is displayed until the user types something in the
1732 (let ((minibuffer-setup-hook
1734 (if (stringp initial)
1736 ;; don't wait if we have unread events or in kbd macro
1737 (or unread-command-events
1742 (vip-minibuffer-setup-sentinel)))
1747 (setq keymap (or keymap minibuffer-local-map)
1748 initial (or initial "")
1749 temp-msg (if default
1750 (format "(default: %s) " default)
1753 (setq vip-incomplete-ex-cmd nil)
1754 (setq val (read-from-minibuffer prompt
1755 (concat temp-msg initial val padding)
1756 keymap nil history-var))
1757 (setq minibuffer-setup-hook nil
1758 padding (vip-array-to-string (this-command-keys))
1760 ;; the following tries to be smart about what to put in history
1761 (if (not (string= val (car (eval history-var))))
1762 (set history-var (cons val (eval history-var))))
1763 (if (or (string= (nth 0 (eval history-var)) (nth 1 (eval history-var)))
1764 (string= (nth 0 (eval history-var)) ""))
1765 (set history-var (cdr (eval history-var))))
1766 ;; If the user enters nothing but the prev cmd wasn't vip-ex,
1767 ;; vip-command-argument, or `! shell-command', this probably means
1768 ;; that the user typed something then erased. Return "" in this case, not
1769 ;; the default---the default is too confusing in this case.
1770 (cond ((and (string= val "")
1771 (not (string= prompt "!")) ; was a `! shell-command'
1772 (not (memq last-command
1774 vip-command-argument
1778 ((string= val "") (or default ""))
1784 ;; insertion commands
1786 ;; Called when state changes from Insert Vi command mode.
1787 ;; Repeats the insertion command if Insert state was entered with prefix
1789 (defun vip-repeat-insert-command ()
1790 (let ((i-com (car vip-d-com))
1791 (val (nth 1 vip-d-com))
1792 (char (nth 2 vip-d-com)))
1793 (if (and val (> val 1)) ; first check that val is non-nil
1795 (setq vip-d-com (list i-com (1- val) ?r nil nil nil))
1797 (setq vip-d-com (list i-com val char nil nil nil))
1800 (defun vip-insert (arg)
1801 "Insert before point."
1803 (vip-set-complex-command-for-undo)
1804 (let ((val (vip-p-val arg))
1805 (com (vip-getcom arg)))
1806 (vip-set-destructive-command (list 'vip-insert val ?r nil nil nil))
1808 (vip-loop val (vip-yank-last-insertion))
1809 (vip-change-state-to-insert))))
1811 (defun vip-append (arg)
1812 "Append after point."
1814 (vip-set-complex-command-for-undo)
1815 (let ((val (vip-p-val arg))
1816 (com (vip-getcom arg)))
1817 (vip-set-destructive-command (list 'vip-append val ?r nil nil nil))
1818 (if (not (eolp)) (forward-char))
1820 (vip-loop val (vip-yank-last-insertion))
1821 (vip-change-state-to-insert))))
1823 (defun vip-Append (arg)
1824 "Append at end of line."
1826 (vip-set-complex-command-for-undo)
1827 (let ((val (vip-p-val arg))
1828 (com (vip-getcom arg)))
1829 (vip-set-destructive-command (list 'vip-Append val ?r nil nil nil))
1832 (vip-loop val (vip-yank-last-insertion))
1833 (vip-change-state-to-insert))))
1835 (defun vip-Insert (arg)
1836 "Insert before first non-white."
1838 (vip-set-complex-command-for-undo)
1839 (let ((val (vip-p-val arg))
1840 (com (vip-getcom arg)))
1841 (vip-set-destructive-command (list 'vip-Insert val ?r nil nil nil))
1842 (back-to-indentation)
1844 (vip-loop val (vip-yank-last-insertion))
1845 (vip-change-state-to-insert))))
1847 (defun vip-open-line (arg)
1850 (vip-set-complex-command-for-undo)
1851 (let ((val (vip-p-val arg))
1852 (com (vip-getcom arg)))
1853 (vip-set-destructive-command (list 'vip-open-line val ?r nil nil nil))
1854 (let ((col (current-indentation)))
1863 (if vip-electric-mode
1864 (indent-according-to-mode)
1867 (vip-yank-last-insertion)))
1873 (if vip-electric-mode
1874 (indent-according-to-mode)
1876 (vip-change-state-to-insert)))))
1878 (defun vip-Open-line (arg)
1881 (vip-set-complex-command-for-undo)
1882 (let ((val (vip-p-val arg))
1883 (com (vip-getcom arg)))
1884 (vip-set-destructive-command (list 'vip-Open-line val ?r nil nil nil))
1885 (let ((col (current-indentation)))
1894 (if vip-electric-mode
1895 (indent-according-to-mode)
1898 (vip-yank-last-insertion)))
1904 (if vip-electric-mode
1905 (indent-according-to-mode)
1908 (vip-change-state-to-insert)))))
1910 (defun vip-open-line-at-point (arg)
1911 "Open line at point."
1913 (vip-set-complex-command-for-undo)
1914 (let ((val (vip-p-val arg))
1915 (com (vip-getcom arg)))
1916 (vip-set-destructive-command
1917 (list 'vip-open-line-at-point val ?r nil nil nil))
1922 (vip-yank-last-insertion)))
1924 (vip-change-state-to-insert))))
1926 (defun vip-substitute (arg)
1927 "Substitute characters."
1929 (let ((val (vip-p-val arg))
1930 (com (vip-getcom arg)))
1934 (vip-change-subr (mark t) (point))
1935 (vip-change (mark t) (point)))
1936 (vip-set-destructive-command (list 'vip-substitute val ?r nil nil nil))
1939 (defun vip-substitute-line (arg)
1942 (vip-set-complex-command-for-undo)
1943 (vip-line (cons arg ?C)))
1945 ;; Prepare for replace
1946 (defun vip-start-replace ()
1947 (setq vip-began-as-replace t
1948 vip-sitting-in-replace t
1949 vip-replace-chars-to-delete 0
1950 vip-replace-chars-deleted 0)
1951 (vip-add-hook 'vip-after-change-functions 'vip-replace-mode-spy-after t)
1952 (vip-add-hook 'vip-before-change-functions 'vip-replace-mode-spy-before t)
1953 ;; this will get added repeatedly, but no harm
1954 (add-hook 'after-change-functions 'vip-after-change-sentinel t)
1955 (add-hook 'before-change-functions 'vip-before-change-sentinel t)
1956 (vip-move-marker-locally 'vip-last-posn-in-replace-region
1957 (vip-replace-start))
1959 'vip-post-command-hooks 'vip-replace-state-post-command-sentinel t)
1961 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t)
1962 ;; guard against a smartie who switched from R-replace to normal replace
1964 'vip-post-command-hooks 'vip-R-state-post-command-sentinel)
1965 (if overwrite-mode (overwrite-mode nil))
1969 ;; checks how many chars were deleted by the last change
1970 (defun vip-replace-mode-spy-before (beg end)
1971 (setq vip-replace-chars-deleted
1973 (max 0 (- end (vip-replace-end)))
1974 (max 0 (- (vip-replace-start) beg))
1977 ;; Invoked as an after-change-function to set up parameters of the last change
1978 (defun vip-replace-mode-spy-after (beg end length)
1979 (if (memq vip-intermediate-command '(repeating-insertion-from-ring))
1981 (setq vip-replace-chars-to-delete 0)
1982 (vip-move-marker-locally
1983 'vip-last-posn-in-replace-region (point)))
1985 (let (beg-col end-col real-end chars-to-delete)
1986 (setq real-end (min end (vip-replace-end)))
1989 (setq beg-col (current-column))
1990 (goto-char real-end)
1991 (setq end-col (current-column)))
1993 ;; If beg of change is outside the replacement region, then don't
1994 ;; delete anything in the repl region (set chars-to-delete to 0).
1996 ;; This works fine except that we have to take special care of
1997 ;; dabbrev-expand. The problem stems from new-dabbrev.el, which
1998 ;; sometimes simply shifts the repl region rightwards, without
1999 ;; deleting an equal amount of characters.
2001 ;; The reason why new-dabbrev.el causes this are this:
2002 ;; if one dinamically completes a partial word that starts before the
2003 ;; replacement region (but ends inside) then new-dabbrev.el first
2004 ;; moves cursor backwards, to the beginning of the word to be
2005 ;; completed (say, pt A). Then it inserts the
2006 ;; completed word and then deletes the old, incomplete part.
2007 ;; Since the complete word is inserted at position before the repl
2008 ;; region, the next If-statement would have set chars-to-delete to 0
2009 ;; unless we check for the current command, which must be
2012 ;; In fact, it might be also useful to have overlays for insert
2013 ;; regions as well, since this will let us capture the situation when
2014 ;; dabbrev-expand goes back past the insertion point to find the
2015 ;; beginning of the word to be expanded.
2016 (if (or (and (<= (vip-replace-start) beg)
2017 (<= beg (vip-replace-end)))
2018 (and (= length 0) (eq this-command 'dabbrev-expand)))
2019 (setq chars-to-delete
2020 (max (- end-col beg-col) (- real-end beg) 0))
2021 (setq chars-to-delete 0))
2023 ;; if beg = last change position, it means that we are within the
2024 ;; same command that does multiple changes. Moreover, it means
2025 ;; that we have two subsequent changes (insert/delete) that
2026 ;; complement each other.
2027 (if (= beg (marker-position vip-last-posn-in-replace-region))
2028 (setq vip-replace-chars-to-delete
2029 (- (+ chars-to-delete vip-replace-chars-to-delete)
2030 vip-replace-chars-deleted))
2031 (setq vip-replace-chars-to-delete chars-to-delete))
2033 (vip-move-marker-locally
2034 'vip-last-posn-in-replace-region
2035 (max (if (> end (vip-replace-end)) (vip-replace-start) end)
2036 (or (marker-position vip-last-posn-in-replace-region)
2037 (vip-replace-start))
2040 (setq vip-replace-chars-to-delete
2042 (min vip-replace-chars-to-delete
2043 (- (vip-replace-end) vip-last-posn-in-replace-region)
2044 (- (vip-line-pos 'end) vip-last-posn-in-replace-region)
2049 ;; Delete stuff between posn and the end of vip-replace-overlay-marker, if
2050 ;; posn is within the overlay.
2051 (defun vip-finish-change (posn)
2052 (vip-remove-hook 'vip-after-change-functions 'vip-replace-mode-spy-after)
2053 (vip-remove-hook 'vip-before-change-functions 'vip-replace-mode-spy-before)
2054 (vip-remove-hook 'vip-post-command-hooks
2055 'vip-replace-state-post-command-sentinel)
2057 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel)
2058 (vip-restore-cursor-color-after-replace)
2059 (setq vip-sitting-in-replace nil) ; just in case we'll need to know it
2063 (>= posn (vip-replace-start))
2064 (< posn (vip-replace-end)))
2065 (delete-region posn (vip-replace-end)))
2068 (if (eq vip-current-state 'replace-state)
2069 (vip-downgrade-to-insert))
2070 ;; replace mode ended => nullify vip-last-posn-in-replace-region
2071 (vip-move-marker-locally 'vip-last-posn-in-replace-region nil)
2072 (vip-hide-replace-overlay)
2073 (vip-refresh-mode-line)
2074 (vip-put-string-on-kill-ring vip-last-replace-region)
2077 ;; Make STRING be the first element of the kill ring.
2078 (defun vip-put-string-on-kill-ring (string)
2079 (setq kill-ring (cons string kill-ring))
2080 (if (> (length kill-ring) kill-ring-max)
2081 (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
2082 (setq kill-ring-yank-pointer kill-ring))
2084 (defun vip-finish-R-mode ()
2085 (vip-remove-hook 'vip-post-command-hooks 'vip-R-state-post-command-sentinel)
2087 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel)
2088 (vip-downgrade-to-insert))
2090 (defun vip-start-R-mode ()
2091 ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number
2094 'vip-post-command-hooks 'vip-R-state-post-command-sentinel t)
2096 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t)
2097 ;; guard against a smartie who switched from R-replace to normal replace
2099 'vip-post-command-hooks 'vip-replace-state-post-command-sentinel)
2104 (defun vip-replace-state-exit-cmd ()
2105 "Binding for keys that cause Replace state to switch to Vi or to Insert.
2106 These keys are ESC, RET, and LineFeed"
2108 (if overwrite-mode ;; If you are in replace mode invoked via 'R'
2110 (vip-finish-change vip-last-posn-in-replace-region))
2112 (if (eq this-command 'vip-intercept-ESC-key)
2113 (setq com 'vip-exit-insert-state)
2114 (vip-set-unread-command-events last-input-char)
2115 (setq com (key-binding (read-key-sequence nil))))
2117 (condition-case conds
2118 (command-execute com)
2120 (vip-message-conditions conds)))
2122 (vip-hide-replace-overlay))
2124 (defun vip-replace-state-carriage-return ()
2125 "Implements carriage return in Viper replace state."
2127 ;; If Emacs start supporting overlay maps, as it currently supports
2128 ;; text-property maps, we could do away with vip-replace-minor-mode and
2129 ;; just have keymap attached to replace overlay. Then the "if part" of this
2130 ;; statement can be deleted.
2131 (if (or (< (point) (vip-replace-start))
2132 (> (point) (vip-replace-end)))
2133 (let (vip-replace-minor-mode com)
2134 (vip-set-unread-command-events last-input-char)
2135 (setq com (key-binding (read-key-sequence nil)))
2136 (condition-case conds
2137 (command-execute com)
2139 (vip-message-conditions conds))))
2140 (if (not vip-allow-multiline-replace-regions)
2141 (vip-replace-state-exit-cmd)
2142 (if (vip-same-line (point) (vip-replace-end))
2143 (vip-replace-state-exit-cmd)
2145 (vip-next-line-at-bol nil)))))
2148 ;; This is the function bound to 'R'---unlimited replace.
2149 ;; Similar to Emacs's own overwrite-mode.
2150 (defun vip-overwrite (arg)
2151 "Begin overwrite mode."
2153 (let ((val (vip-p-val arg))
2154 (com (vip-getcom arg)) (len))
2155 (vip-set-destructive-command (list 'vip-overwrite val ?r nil nil nil))
2158 ;; Viper saves inserted text in vip-last-insertion
2159 (setq len (length vip-last-insertion))
2161 (vip-loop val (vip-yank-last-insertion)))
2162 (setq last-command 'vip-overwrite)
2163 (vip-set-complex-command-for-undo)
2164 (vip-set-replace-overlay (point) (vip-line-pos 'end))
2165 (vip-change-state-to-replace)
2171 (defun vip-line (arg)
2172 (let ((val (car arg))
2174 (vip-move-marker-locally 'vip-com-point (point))
2176 (vip-next-line-carefully (1- val)))
2177 ;; this ensures that dd, cc, D, yy will do the right thing on the last
2178 ;; line of buffer when this line has no \n.
2179 (vip-add-newline-at-eob-if-necessary)
2180 (vip-execute-com 'vip-line val com))
2181 (if (and (eobp) (not (bobp))) (forward-line -1))
2184 (defun vip-yank-line (arg)
2185 "Yank ARG lines (in Vi's sense)."
2187 (let ((val (vip-p-val arg)))
2188 (vip-line (cons val ?Y))))
2193 (defun vip-region (arg)
2194 "Execute command on a region."
2196 (let ((val (vip-P-val arg))
2197 (com (vip-getcom arg)))
2198 (vip-move-marker-locally 'vip-com-point (point))
2199 (exchange-point-and-mark)
2200 (vip-execute-com 'vip-region val com)))
2202 (defun vip-Region (arg)
2203 "Execute command on a Region."
2205 (let ((val (vip-P-val arg))
2206 (com (vip-getCom arg)))
2207 (vip-move-marker-locally 'vip-com-point (point))
2208 (exchange-point-and-mark)
2209 (vip-execute-com 'vip-Region val com)))
2211 (defun vip-replace-char (arg)
2212 "Replace the following ARG chars by the character read."
2214 (if (and (eolp) (bolp)) (error "No character to replace here"))
2215 (let ((val (vip-p-val arg))
2216 (com (vip-getcom arg)))
2217 (vip-replace-char-subr com val)
2218 (if (and (eolp) (not (bolp))) (forward-char 1))
2219 (vip-set-destructive-command
2220 (list 'vip-replace-char val ?r nil vip-d-char nil))
2223 (defun vip-replace-char-subr (com arg)
2224 (let ((take-care-of-iso-accents
2225 (and (boundp 'iso-accents-mode) vip-automatic-iso-accents))
2227 (setq char (if (equal com ?r)
2230 (if (and take-care-of-iso-accents (memq char '(?' ?\" ?^ ?~)))
2231 ;; get European characters
2233 (iso-accents-mode 1)
2234 (vip-set-unread-command-events char)
2235 (setq char (aref (read-key-sequence nil) 0))
2236 (iso-accents-mode -1)))
2238 (setq vip-d-char char)
2239 (vip-loop (if (> arg 0) arg (- arg))
2240 (if (eq char ?\C-m) (insert "\n") (insert char)))
2241 (backward-char arg)))
2244 ;; basic cursor movement. j, k, l, h commands.
2246 (defun vip-forward-char (arg)
2247 "Move point right ARG characters (left if ARG negative).
2248 On reaching end of line, stop and signal error."
2250 (vip-leave-region-active)
2251 (let ((val (vip-p-val arg))
2252 (com (vip-getcom arg)))
2253 (if com (vip-move-marker-locally 'vip-com-point (point)))
2254 (if vip-ex-style-motion
2256 ;; the boundary condition check gets weird here because
2257 ;; forward-char may be the parameter of a delete, and 'dl' works
2258 ;; just like 'x' for the last char on a line, so we have to allow
2259 ;; the forward motion before the 'vip-execute-com', but, of
2260 ;; course, 'dl' doesn't work on an empty line, so we have to
2261 ;; catch that condition before 'vip-execute-com'
2262 (if (and (eolp) (bolp)) (error "") (forward-char val))
2263 (if com (vip-execute-com 'vip-forward-char val com))
2264 (if (eolp) (progn (backward-char 1) (error ""))))
2266 (if com (vip-execute-com 'vip-forward-char val com)))))
2268 (defun vip-backward-char (arg)
2269 "Move point left ARG characters (right if ARG negative).
2270 On reaching beginning of line, stop and signal error."
2272 (vip-leave-region-active)
2273 (let ((val (vip-p-val arg))
2274 (com (vip-getcom arg)))
2275 (if com (vip-move-marker-locally 'vip-com-point (point)))
2276 (if vip-ex-style-motion
2278 (if (bolp) (error "") (backward-char val))
2279 (if com (vip-execute-com 'vip-backward-char val com)))
2281 (if com (vip-execute-com 'vip-backward-char val com)))))
2283 ;; Like forward-char, but doesn't move at end of buffer.
2284 (defun vip-forward-char-carefully (&optional arg)
2285 (setq arg (or arg 1))
2286 (if (>= (point-max) (+ (point) arg))
2288 (goto-char (point-max))))
2290 ;; Like backward-char, but doesn't move at end of buffer.
2291 (defun vip-backward-char-carefully (&optional arg)
2292 (setq arg (or arg 1))
2293 (if (<= (point-min) (- (point) arg))
2295 (goto-char (point-min))))
2297 (defun vip-next-line-carefully (arg)
2306 ;; Words are formed from alpha's and nonalphas - <sp>,\t\n are separators
2307 ;; for word movement. When executed with a destructive command, \n is
2308 ;; usually left untouched for the last word.
2309 ;; Viper uses syntax table to determine what is a word and what is a
2310 ;; separator. However, \n is always a separator. Also, if vip-syntax-preference
2311 ;; is 'vi, then `_' is part of the word.
2314 (defun vip-skip-separators (forward)
2317 (vip-skip-all-separators-forward 'within-line)
2318 (if (looking-at "\n")
2321 (vip-skip-all-separators-forward 'within-line))))
2322 (vip-skip-all-separators-backward 'within-line)
2324 (if (looking-at "\n")
2325 (vip-skip-all-separators-backward 'within-line)
2328 (defun vip-forward-word-kernel (val)
2330 (cond ((vip-looking-at-alpha)
2331 (vip-skip-alpha-forward "_")
2332 (vip-skip-separators t))
2333 ((vip-looking-at-separator)
2334 (vip-skip-separators t))
2335 ((not (vip-looking-at-alphasep))
2336 (vip-skip-nonalphasep-forward)
2337 (vip-skip-separators t)))
2338 (setq val (1- val))))
2340 ;; first search backward for pat. Then skip chars backwards using aux-pat
2341 (defun vip-fwd-skip (pat aux-pat lim)
2342 (if (and (save-excursion
2343 (re-search-backward pat lim t))
2344 (= (point) (match-end 0)))
2345 (goto-char (match-beginning 0)))
2346 (skip-chars-backward aux-pat lim)
2348 (vip-forward-char-carefully))
2352 (defun vip-forward-word (arg)
2355 (vip-leave-region-active)
2356 (let ((val (vip-p-val arg))
2357 (com (vip-getcom arg)))
2358 (if com (vip-move-marker-locally 'vip-com-point (point)))
2359 (vip-forward-word-kernel val)
2361 (cond ((memq com (list ?c (- ?c)))
2362 (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point))
2363 ;; Yank words including the whitespace, but not newline
2364 ((memq com (list ?y (- ?y)))
2365 (vip-fwd-skip "\n[ \t]*" "" vip-com-point))
2366 ((vip-dotable-command-p com)
2367 (vip-fwd-skip "\n[ \t]*" "" vip-com-point)))
2368 (vip-execute-com 'vip-forward-word val com)))))
2371 (defun vip-forward-Word (arg)
2372 "Forward word delimited by white characters."
2374 (vip-leave-region-active)
2375 (let ((val (vip-p-val arg))
2376 (com (vip-getcom arg)))
2377 (if com (vip-move-marker-locally 'vip-com-point (point)))
2380 (vip-skip-nonseparators 'forward)
2381 (vip-skip-separators t)))
2383 (cond ((memq com (list ?c (- ?c)))
2384 (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point))
2385 ;; Yank words including the whitespace, but not newline
2386 ((memq com (list ?y (- ?y)))
2387 (vip-fwd-skip "\n[ \t]*" "" vip-com-point))
2388 ((vip-dotable-command-p com)
2389 (vip-fwd-skip "\n[ \t]*" "" vip-com-point)))
2390 (vip-execute-com 'vip-forward-Word val com)))))
2393 ;; this is a bit different from Vi, but Vi's end of word
2394 ;; makes no sense whatsoever
2395 (defun vip-end-of-word-kernel ()
2396 (if (vip-end-of-word-p) (forward-char))
2397 (if (vip-looking-at-separator)
2398 (vip-skip-all-separators-forward))
2400 (cond ((vip-looking-at-alpha) (vip-skip-alpha-forward "_"))
2401 ((not (vip-looking-at-alphasep)) (vip-skip-nonalphasep-forward)))
2402 (vip-backward-char-carefully))
2404 (defun vip-end-of-word-p ()
2407 (cond ((vip-looking-at-alpha)
2409 (not (vip-looking-at-alpha)))
2410 ((not (vip-looking-at-alphasep))
2412 (vip-looking-at-alphasep))))))
2415 (defun vip-end-of-word (arg &optional careful)
2416 "Move point to end of current word."
2418 (vip-leave-region-active)
2419 (let ((val (vip-p-val arg))
2420 (com (vip-getcom arg)))
2421 (if com (vip-move-marker-locally 'vip-com-point (point)))
2422 (vip-loop val (vip-end-of-word-kernel))
2426 (vip-execute-com 'vip-end-of-word val com)))))
2428 (defun vip-end-of-Word (arg)
2429 "Forward to end of word delimited by white character."
2431 (vip-leave-region-active)
2432 (let ((val (vip-p-val arg))
2433 (com (vip-getcom arg)))
2434 (if com (vip-move-marker-locally 'vip-com-point (point)))
2437 (vip-end-of-word-kernel)
2438 (vip-skip-nonseparators 'forward)
2443 (vip-execute-com 'vip-end-of-Word val com)))))
2445 (defun vip-backward-word-kernel (val)
2448 (cond ((vip-looking-at-alpha)
2449 (vip-skip-alpha-backward "_"))
2450 ((vip-looking-at-separator)
2452 (vip-skip-separators nil)
2454 (cond ((vip-looking-at-alpha)
2455 (vip-skip-alpha-backward "_"))
2456 ((not (vip-looking-at-alphasep))
2457 (vip-skip-nonalphasep-backward))
2458 (t (forward-char))))
2459 ((not (vip-looking-at-alphasep))
2460 (vip-skip-nonalphasep-backward)))
2461 (setq val (1- val))))
2463 (defun vip-backward-word (arg)
2466 (vip-leave-region-active)
2467 (let ((val (vip-p-val arg))
2468 (com (vip-getcom arg)))
2471 (if (setq i (save-excursion (backward-char) (looking-at "\n")))
2473 (vip-move-marker-locally 'vip-com-point (point))
2474 (if i (forward-char))))
2475 (vip-backward-word-kernel val)
2476 (if com (vip-execute-com 'vip-backward-word val com))))
2478 (defun vip-backward-Word (arg)
2479 "Backward word delimited by white character."
2481 (vip-leave-region-active)
2482 (let ((val (vip-p-val arg))
2483 (com (vip-getcom arg)))
2486 (if (setq i (save-excursion (backward-char) (looking-at "\n")))
2488 (vip-move-marker-locally 'vip-com-point (point))
2489 (if i (forward-char))))
2492 (vip-skip-separators nil)
2493 (vip-skip-nonseparators 'backward)))
2494 (if com (vip-execute-com 'vip-backward-Word val com))))
2500 (defun vip-beginning-of-line (arg)
2501 "Go to beginning of line."
2503 (vip-leave-region-active)
2504 (let ((val (vip-p-val arg))
2505 (com (vip-getcom arg)))
2506 (if com (vip-move-marker-locally 'vip-com-point (point)))
2507 (beginning-of-line val)
2508 (if com (vip-execute-com 'vip-beginning-of-line val com))))
2510 (defun vip-bol-and-skip-white (arg)
2511 "Beginning of line at first non-white character."
2513 (vip-leave-region-active)
2514 (let ((val (vip-p-val arg))
2515 (com (vip-getcom arg)))
2516 (if com (vip-move-marker-locally 'vip-com-point (point)))
2517 (forward-to-indentation (1- val))
2518 (if com (vip-execute-com 'vip-bol-and-skip-white val com))))
2520 (defun vip-goto-eol (arg)
2521 "Go to end of line."
2523 (vip-leave-region-active)
2524 (let ((val (vip-p-val arg))
2525 (com (vip-getcom arg)))
2526 (if com (vip-move-marker-locally 'vip-com-point (point)))
2528 (if com (vip-execute-com 'vip-goto-eol val com))
2529 (if vip-ex-style-motion
2530 (if (and (eolp) (not (bolp))
2531 ;; a fix for vip-change-to-eol
2532 (not (equal vip-current-state 'insert-state)))
2537 (defun vip-goto-col (arg)
2538 "Go to ARG's column."
2540 (vip-leave-region-active)
2541 (let ((val (vip-p-val arg))
2542 (com (vip-getcom arg))
2544 (setq line-len (- (vip-line-pos 'end) (vip-line-pos 'start)))
2545 (if com (vip-move-marker-locally 'vip-com-point (point)))
2547 (forward-char (1- (min line-len val)))
2548 (while (> (current-column) (1- val))
2550 (if com (vip-execute-com 'vip-goto-col val com))
2553 (if (> val (current-column)) (error "")))
2557 (defun vip-next-line (arg)
2560 (vip-leave-region-active)
2561 (let ((val (vip-p-val arg))
2562 (com (vip-getCom arg)))
2563 (if com (vip-move-marker-locally 'vip-com-point (point)))
2565 (if vip-ex-style-motion
2566 (if (and (eolp) (not (bolp))) (backward-char 1)))
2567 (setq this-command 'next-line)
2568 (if com (vip-execute-com 'vip-next-line val com))))
2570 (defun vip-next-line-at-bol (arg)
2571 "Next line at beginning of line."
2573 (vip-leave-region-active)
2576 (if (eobp) (error "Last line in buffer")))
2577 (let ((val (vip-p-val arg))
2578 (com (vip-getCom arg)))
2579 (if com (vip-move-marker-locally 'vip-com-point (point)))
2581 (back-to-indentation)
2582 (if com (vip-execute-com 'vip-next-line-at-bol val com))))
2584 (defun vip-previous-line (arg)
2585 "Go to previous line."
2587 (vip-leave-region-active)
2588 (let ((val (vip-p-val arg))
2589 (com (vip-getCom arg)))
2590 (if com (vip-move-marker-locally 'vip-com-point (point)))
2592 (if vip-ex-style-motion
2593 (if (and (eolp) (not (bolp))) (backward-char 1)))
2594 (setq this-command 'previous-line)
2595 (if com (vip-execute-com 'vip-previous-line val com))))
2598 (defun vip-previous-line-at-bol (arg)
2599 "Previous line at beginning of line."
2601 (vip-leave-region-active)
2604 (if (bobp) (error "First line in buffer")))
2605 (let ((val (vip-p-val arg))
2606 (com (vip-getCom arg)))
2607 (if com (vip-move-marker-locally 'vip-com-point (point)))
2608 (forward-line (- val))
2609 (back-to-indentation)
2610 (if com (vip-execute-com 'vip-previous-line val com))))
2612 (defun vip-change-to-eol (arg)
2613 "Change to end of line."
2615 (vip-goto-eol (cons arg ?c)))
2617 (defun vip-kill-line (arg)
2620 (vip-goto-eol (cons arg ?d)))
2622 (defun vip-erase-line (arg)
2625 (vip-beginning-of-line (cons arg ?d)))
2630 (defun vip-goto-line (arg)
2631 "Go to ARG's line. Without ARG go to end of buffer."
2633 (let ((val (vip-P-val arg))
2634 (com (vip-getCom arg)))
2635 (vip-move-marker-locally 'vip-com-point (point))
2636 (vip-deactivate-mark)
2639 (goto-char (point-max))
2640 (goto-char (point-min))
2641 (forward-line (1- val)))
2643 ;; positioning is done twice: before and after command execution
2644 (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
2645 (back-to-indentation)
2647 (if com (vip-execute-com 'vip-goto-line val com))
2649 (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
2650 (back-to-indentation)
2653 ;; Find ARG's occurrence of CHAR on the current line.
2654 ;; If FORWARD then search is forward, otherwise backward. OFFSET is used to
2655 ;; adjust point after search.
2656 (defun vip-find-char (arg char forward offset)
2657 (or (char-or-string-p char) (error ""))
2658 (let ((arg (if forward arg (- arg)))
2659 (cmd (if (eq vip-intermediate-command 'vip-repeat)
2661 (vip-array-to-string (this-command-keys))))
2667 ;; forward search begins here
2668 (if (eolp) (error "Command `%s': At end of line" cmd) (point))
2669 ;; forward search ends here
2670 (progn (end-of-line) (point)))
2672 ;; backward search begins from here
2674 (error "Command `%s': At beginning of line" cmd) (point))
2675 ;; backward search ends here
2676 (progn (beginning-of-line) (point))))
2677 ;; if arg > 0, point is forwarded before search.
2678 (if (> arg 0) (goto-char (1+ (point-min)))
2679 (goto-char (point-max)))
2680 (if (let ((case-fold-search nil))
2681 (search-forward (char-to-string char) nil 0 arg))
2682 (setq point (point))
2683 (error "Command `%s': `%c' not found" cmd char))))
2684 (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0))))))
2686 (defun vip-find-char-forward (arg)
2687 "Find char on the line.
2688 If called interactively read the char to find from the terminal, and if
2689 called from vip-repeat, the char last used is used. This behaviour is
2690 controlled by the sign of prefix numeric value."
2692 (let ((val (vip-p-val arg))
2693 (com (vip-getcom arg))
2694 (cmd-representation (nth 5 vip-d-com)))
2696 ;; this means that the function was called interactively
2697 (setq vip-f-char (read-char)
2700 ;; vip-repeat --- set vip-F-char from command-keys
2701 (setq vip-F-char (if (stringp cmd-representation)
2702 (vip-seq-last-elt cmd-representation)
2704 vip-f-char vip-F-char)
2706 (if com (vip-move-marker-locally 'vip-com-point (point)))
2707 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil)
2711 (setq vip-F-char vip-f-char) ; set new vip-F-char
2713 (vip-execute-com 'vip-find-char-forward val com)))))
2715 (defun vip-goto-char-forward (arg)
2716 "Go up to char ARG forward on line."
2718 (let ((val (vip-p-val arg))
2719 (com (vip-getcom arg))
2720 (cmd-representation (nth 5 vip-d-com)))
2722 ;; this means that the function was called interactively
2723 (setq vip-f-char (read-char)
2726 ;; vip-repeat --- set vip-F-char from command-keys
2727 (setq vip-F-char (if (stringp cmd-representation)
2728 (vip-seq-last-elt cmd-representation)
2730 vip-f-char vip-F-char)
2732 (if com (vip-move-marker-locally 'vip-com-point (point)))
2733 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t)
2737 (setq vip-F-char vip-f-char) ; set new vip-F-char
2739 (vip-execute-com 'vip-goto-char-forward val com)))))
2741 (defun vip-find-char-backward (arg)
2742 "Find char ARG on line backward."
2744 (let ((val (vip-p-val arg))
2745 (com (vip-getcom arg))
2746 (cmd-representation (nth 5 vip-d-com)))
2748 ;; this means that the function was called interactively
2749 (setq vip-f-char (read-char)
2752 ;; vip-repeat --- set vip-F-char from command-keys
2753 (setq vip-F-char (if (stringp cmd-representation)
2754 (vip-seq-last-elt cmd-representation)
2756 vip-f-char vip-F-char)
2758 (if com (vip-move-marker-locally 'vip-com-point (point)))
2760 val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil)
2764 (setq vip-F-char vip-f-char) ; set new vip-F-char
2765 (vip-execute-com 'vip-find-char-backward val com)))))
2767 (defun vip-goto-char-backward (arg)
2768 "Go up to char ARG backward on line."
2770 (let ((val (vip-p-val arg))
2771 (com (vip-getcom arg))
2772 (cmd-representation (nth 5 vip-d-com)))
2774 ;; this means that the function was called interactively
2775 (setq vip-f-char (read-char)
2778 ;; vip-repeat --- set vip-F-char from command-keys
2779 (setq vip-F-char (if (stringp cmd-representation)
2780 (vip-seq-last-elt cmd-representation)
2782 vip-f-char vip-F-char)
2784 (if com (vip-move-marker-locally 'vip-com-point (point)))
2785 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t)
2789 (setq vip-F-char vip-f-char) ; set new vip-F-char
2790 (vip-execute-com 'vip-goto-char-backward val com)))))
2792 (defun vip-repeat-find (arg)
2793 "Repeat previous find command."
2795 (let ((val (vip-p-val arg))
2796 (com (vip-getcom arg)))
2797 (vip-deactivate-mark)
2798 (if com (vip-move-marker-locally 'vip-com-point (point)))
2799 (vip-find-char val vip-f-char vip-f-forward vip-f-offset)
2802 (if vip-f-forward (forward-char))
2803 (vip-execute-com 'vip-repeat-find val com)))))
2805 (defun vip-repeat-find-opposite (arg)
2806 "Repeat previous find command in the opposite direction."
2808 (let ((val (vip-p-val arg))
2809 (com (vip-getcom arg)))
2810 (vip-deactivate-mark)
2811 (if com (vip-move-marker-locally 'vip-com-point (point)))
2812 (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset)
2815 (if vip-f-forward (forward-char))
2816 (vip-execute-com 'vip-repeat-find-opposite val com)))))
2819 ;; window scrolling etc.
2821 (defun vip-other-window (arg)
2822 "Switch to other window."
2825 (or (not (eq vip-current-state 'emacs-state))
2826 (string= (buffer-name (current-buffer)) " *Minibuf-1*")
2827 (vip-change-state-to-vi)))
2829 (defun vip-window-top (arg)
2830 "Go to home window line."
2832 (let ((val (vip-p-val arg))
2833 (com (vip-getCom arg)))
2834 (if com (vip-move-marker-locally 'vip-com-point (point)))
2836 (move-to-window-line (1- val))
2838 ;; positioning is done twice: before and after command execution
2839 (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
2840 (back-to-indentation)
2842 (if com (vip-execute-com 'vip-window-top val com))
2844 (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
2845 (back-to-indentation)
2848 (defun vip-window-middle (arg)
2849 "Go to middle window line."
2851 (let ((val (vip-p-val arg))
2852 (com (vip-getCom arg))
2854 (if com (vip-move-marker-locally 'vip-com-point (point)))
2856 (if (not (pos-visible-in-window-p (point-max)))
2857 (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
2858 (setq lines (count-lines (window-start) (point-max)))
2859 (move-to-window-line (+ (/ lines 2) (1- val))))
2861 ;; positioning is done twice: before and after command execution
2862 (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
2863 (back-to-indentation)
2865 (if com (vip-execute-com 'vip-window-middle val com))
2867 (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
2868 (back-to-indentation)
2871 (defun vip-window-bottom (arg)
2872 "Go to last window line."
2874 (let ((val (vip-p-val arg))
2875 (com (vip-getCom arg)))
2876 (if com (vip-move-marker-locally 'vip-com-point (point)))
2878 (move-to-window-line (- val))
2880 ;; positioning is done twice: before and after command execution
2881 (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
2882 (back-to-indentation)
2884 (if com (vip-execute-com 'vip-window-bottom val com))
2886 (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
2887 (back-to-indentation)
2890 (defun vip-line-to-top (arg)
2891 "Put current line on the home line."
2893 (recenter (1- arg)))
2895 (defun vip-line-to-middle (arg)
2896 "Put current line on the middle line."
2898 (recenter (+ (1- arg) (/ (1- (window-height)) 2))))
2900 (defun vip-line-to-bottom (arg)
2901 "Put current line on the last line."
2903 (recenter (- (window-height) (1+ arg))))
2905 ;; If point is within vip-search-scroll-threshold of window top or bottom,
2906 ;; scroll up or down 1/7 of window height, depending on whether we are at the
2907 ;; bottom or at the top of the window. This function is called by vip-search
2908 ;; (which is called from vip-search-forward/backward/next). If the value of
2909 ;; vip-search-scroll-threshold is negative - don't scroll.
2910 (defun vip-adjust-window ()
2911 (let ((win-height (if vip-emacs-p
2912 (1- (window-height)) ; adjust for modeline
2913 (window-displayed-height)))
2915 at-top-p at-bottom-p
2916 min-scroll direction)
2918 (move-to-window-line 0) ; top
2920 (<= (count-lines pt (point))
2921 vip-search-scroll-threshold))
2922 (move-to-window-line -1) ; bottom
2924 (<= (count-lines pt (point)) vip-search-scroll-threshold))
2926 (cond (at-top-p (setq min-scroll (1- vip-search-scroll-threshold)
2928 (at-bottom-p (setq min-scroll (1+ vip-search-scroll-threshold)
2932 (* (max min-scroll (/ win-height 7)) direction)))
2937 ;; must correct this to only match ( to ) etc. On the other hand
2938 ;; it is good that paren match gets confused, because that way you
2939 ;; catch _all_ imbalances.
2941 (defun vip-paren-match (arg)
2942 "Go to the matching parenthesis."
2944 (vip-leave-region-active)
2945 (let ((com (vip-getcom arg))
2946 (parse-sexp-ignore-comments vip-parse-sexp-ignore-comments)
2949 (if (or (> arg 99) (< arg 1))
2950 (error "Prefix must be between 1 and 99")
2952 (if (> (point-max) 80000)
2953 (* (/ (point-max) 100) arg)
2954 (/ (* (point-max) arg) 100)))
2955 (back-to-indentation))
2956 (let (beg-lim end-lim)
2957 (if (and (eolp) (not (bolp))) (forward-char -1))
2958 (if (not (looking-at "[][(){}]"))
2959 (setq anchor-point (point)))
2962 (setq beg-lim (point))
2964 (setq end-lim (point)))
2965 (cond ((re-search-forward "[][(){}]" end-lim t)
2967 ((re-search-backward "[][(){}]" beg-lim t))
2969 (error "No matching character on line"))))
2970 (cond ((looking-at "[\(\[{]")
2971 (if com (vip-move-marker-locally 'vip-com-point (point)))
2974 (vip-execute-com 'vip-paren-match nil com)
2979 (vip-move-marker-locally 'vip-com-point anchor-point)
2981 (vip-execute-com 'vip-paren-match nil com)
2983 ((looking-at "[])}]")
2985 (if com (vip-move-marker-locally 'vip-com-point (point)))
2987 (if com (vip-execute-com 'vip-paren-match nil com)))
2990 (defun vip-toggle-parse-sexp-ignore-comments ()
2992 (setq vip-parse-sexp-ignore-comments (not vip-parse-sexp-ignore-comments))
2994 "From now on, `%%' will %signore parentheses inside comment fields"
2995 (if vip-parse-sexp-ignore-comments "" "NOT "))))
2998 ;; sentence ,paragraph and heading
3000 (defun vip-forward-sentence (arg)
3004 (let ((val (vip-p-val arg))
3005 (com (vip-getcom arg)))
3006 (if com (vip-move-marker-locally 'vip-com-point (point)))
3007 (forward-sentence val)
3008 (if com (vip-execute-com 'vip-forward-sentence nil com))))
3010 (defun vip-backward-sentence (arg)
3011 "Backward sentence."
3014 (let ((val (vip-p-val arg))
3015 (com (vip-getcom arg)))
3016 (if com (vip-move-marker-locally 'vip-com-point (point)))
3017 (backward-sentence val)
3018 (if com (vip-execute-com 'vip-backward-sentence nil com))))
3020 (defun vip-forward-paragraph (arg)
3021 "Forward paragraph."
3024 (let ((val (vip-p-val arg))
3025 (com (vip-getCom arg)))
3026 (if com (vip-move-marker-locally 'vip-com-point (point)))
3027 (forward-paragraph val)
3031 (vip-execute-com 'vip-forward-paragraph nil com)))))
3033 (defun vip-backward-paragraph (arg)
3034 "Backward paragraph."
3037 (let ((val (vip-p-val arg))
3038 (com (vip-getCom arg)))
3039 (if com (vip-move-marker-locally 'vip-com-point (point)))
3040 (backward-paragraph val)
3044 (vip-execute-com 'vip-backward-paragraph nil com)
3045 (backward-char 1)))))
3047 ;; should be mode-specific etc.
3049 (defun vip-prev-heading (arg)
3051 (let ((val (vip-p-val arg))
3052 (com (vip-getCom arg)))
3053 (if com (vip-move-marker-locally 'vip-com-point (point)))
3054 (re-search-backward vip-heading-start nil t val)
3055 (goto-char (match-beginning 0))
3056 (if com (vip-execute-com 'vip-prev-heading nil com))))
3058 (defun vip-heading-end (arg)
3060 (let ((val (vip-p-val arg))
3061 (com (vip-getCom arg)))
3062 (if com (vip-move-marker-locally 'vip-com-point (point)))
3063 (re-search-forward vip-heading-end nil t val)
3064 (goto-char (match-beginning 0))
3065 (if com (vip-execute-com 'vip-heading-end nil com))))
3067 (defun vip-next-heading (arg)
3069 (let ((val (vip-p-val arg))
3070 (com (vip-getCom arg)))
3071 (if com (vip-move-marker-locally 'vip-com-point (point)))
3073 (re-search-forward vip-heading-start nil t val)
3074 (goto-char (match-beginning 0))
3075 (if com (vip-execute-com 'vip-next-heading nil com))))
3080 (defun vip-scroll-screen (arg)
3081 "Scroll to next screen."
3087 (setq arg (1- arg)))
3090 (setq arg (1+ arg))))
3094 (message "End of buffer")
3095 (goto-char (point-max)))
3096 (message "Beginning of buffer")
3097 (goto-char (point-min))))
3100 (defun vip-scroll-screen-back (arg)
3101 "Scroll to previous screen."
3103 (vip-scroll-screen (- arg)))
3105 (defun vip-scroll-down (arg)
3106 "Pull down half screen."
3110 (scroll-down (/ (window-height) 2))
3113 (message "Beginning of buffer")
3114 (goto-char (point-min)))))
3116 (defun vip-scroll-down-one (arg)
3117 "Scroll up one line."
3121 (defun vip-scroll-up (arg)
3122 "Pull up half screen."
3126 (scroll-up (/ (window-height) 2))
3129 (message "End of buffer")
3130 (goto-char (point-max)))))
3132 (defun vip-scroll-up-one (arg)
3133 "Scroll down one line."
3140 (defun vip-if-string (prompt)
3141 (let ((s (vip-read-string-with-history
3145 (car vip-search-history))))
3146 (if (not (string= s ""))
3147 (setq vip-s-string s))))
3150 (defun vip-toggle-search-style (arg)
3151 "Toggle the value of vip-case-fold-search/vip-re-search.
3152 Without prefix argument, will ask which search style to toggle. With prefix
3153 arg 1,toggles vip-case-fold-search; with arg 2 toggles vip-re-search.
3155 Although this function is bound to \\[vip-toggle-search-style], the most
3156 convenient way to use it is to bind `//' to the macro
3157 `1 M-x vip-toggle-search-style' and `///' to
3158 `2 M-x vip-toggle-search-style'. In this way, hitting `//' quickly will
3159 toggle case-fold-search and hitting `/' three times witth toggle regexp
3160 search. Macros are more convenient in this case because they don't affect
3161 the Emacs binding of `/'."
3164 (cond ((or (eq arg 1)
3166 (y-or-n-p (format "Search style: '%s'. Want '%s'? "
3167 (if vip-case-fold-search
3168 "case-insensitive" "case-sensitive")
3169 (if vip-case-fold-search
3171 "case-insensitive")))))
3172 (setq vip-case-fold-search (null vip-case-fold-search))
3173 (if vip-case-fold-search
3174 (setq msg "Search becomes case-insensitive")
3175 (setq msg "Search becomes case-sensitive")))
3178 (y-or-n-p (format "Search style: '%s'. Want '%s'? "
3180 "regexp-search" "vanilla-search")
3183 "regexp-search")))))
3184 (setq vip-re-search (null vip-re-search))
3186 (setq msg "Search becomes regexp-style")
3187 (setq msg "Search becomes vanilla-style")))
3189 (setq msg "Search style remains unchanged")))
3192 (defun vip-set-searchstyle-toggling-macros (unset)
3193 "Set the macros for toggling the search style in Viper's vi-state.
3194 The macro that toggles case sensitivity is bound to `//', and the one that
3195 toggles regexp search is bound to `///'.
3196 With a prefix argument, this function unsets the macros. "
3201 ;; toggle case sensitivity in search
3202 (vip-record-kbd-macro
3204 [1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return]
3206 ;; toggle regexp/vanila search
3207 (vip-record-kbd-macro
3209 [2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return]
3213 "// and /// now toggle case-sensitivity and regexp search")))
3214 (vip-unrecord-kbd-macro "//" 'vi-state)
3216 (vip-unrecord-kbd-macro "///" 'vi-state))))
3219 (defun vip-set-parsing-style-toggling-macro (unset)
3220 "Set `%%%' to be a macro that toggles whether comment fields should be parsed for matching parentheses.
3221 This is used in conjunction with the `%' command.
3223 With a prefix argument, unsets the macro."
3228 ;; Make %%% toggle parsing comments for matching parentheses
3229 (vip-record-kbd-macro
3231 [(meta x) v i p - t o g g l e - p a r s e - s e x p - i g n o r e - c o m m e n t s return]
3235 "%%%%%% now toggles whether comments should be parsed for matching parentheses")))
3236 (vip-unrecord-kbd-macro "%%%" 'vi-state))))
3239 (defun vip-set-emacs-state-searchstyle-macros (unset &optional arg-majormode)
3240 "Set the macros for toggling the search style in Viper's emacs-state.
3241 The macro that toggles case sensitivity is bound to `//', and the one that
3242 toggles regexp search is bound to `///'.
3243 With a prefix argument, this function unsets the macros.
3244 If the optional prefix argument is non-nil and specifies a valid major mode,
3245 this sets the macros only in the macros in that major mode. Otherwise,
3246 the macros are set in the current major mode.
3247 \(When unsetting the macros, the second argument has no effect.\)"
3252 ;; toggle case sensitivity in search
3253 (vip-record-kbd-macro
3255 [1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return]
3256 (or arg-majormode major-mode))
3257 ;; toggle regexp/vanila search
3258 (vip-record-kbd-macro
3260 [2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return]
3261 (or arg-majormode major-mode))
3264 "// and /// now toggle case-sensitivity and regexp search.")))
3265 (vip-unrecord-kbd-macro "//" 'emacs-state)
3267 (vip-unrecord-kbd-macro "///" 'emacs-state))))
3270 (defun vip-search-forward (arg)
3271 "Search a string forward.
3272 ARG is used to find the ARG's occurrence of the string.
3273 Null string will repeat previous search."
3275 (let ((val (vip-P-val arg))
3276 (com (vip-getcom arg))
3277 (old-str vip-s-string))
3278 (setq vip-s-forward t)
3280 ;; this is not used at present, but may be used later
3281 (if (or (not (equal old-str vip-s-string))
3282 (not (markerp vip-local-search-start-marker))
3283 (not (marker-buffer vip-local-search-start-marker)))
3284 (setq vip-local-search-start-marker (point-marker)))
3285 (vip-search vip-s-string t val)
3288 (vip-move-marker-locally 'vip-com-point (mark t))
3289 (vip-execute-com 'vip-search-next val com)))))
3291 (defun vip-search-backward (arg)
3292 "Search a string backward.
3293 ARG is used to find the ARG's occurrence of the string.
3294 Null string will repeat previous search."
3296 (let ((val (vip-P-val arg))
3297 (com (vip-getcom arg))
3298 (old-str vip-s-string))
3299 (setq vip-s-forward nil)
3301 ;; this is not used at present, but may be used later
3302 (if (or (not (equal old-str vip-s-string))
3303 (not (markerp vip-local-search-start-marker))
3304 (not (marker-buffer vip-local-search-start-marker)))
3305 (setq vip-local-search-start-marker (point-marker)))
3306 (vip-search vip-s-string nil val)
3309 (vip-move-marker-locally 'vip-com-point (mark t))
3310 (vip-execute-com 'vip-search-next val com)))))
3313 ;; Search for COUNT's occurrence of STRING.
3314 ;; Search is forward if FORWARD is non-nil, otherwise backward.
3315 ;; INIT-POINT is the position where search is to start.
3317 ;; (STRING FORW COUNT &optional NO-OFFSET INIT-POINT LIMIT FAIL-IF-NOT-FOUND)
3318 (defun vip-search (string forward arg
3319 &optional no-offset init-point fail-if-not-found)
3320 (if (not (equal string ""))
3321 (let ((val (vip-p-val arg))
3322 (com (vip-getcom arg))
3323 (offset (not no-offset))
3324 (case-fold-search vip-case-fold-search)
3325 (start-point (or init-point (point))))
3326 (vip-deactivate-mark)
3330 (if offset (vip-forward-char-carefully))
3333 (re-search-forward string nil nil val)
3334 (re-search-backward string))
3335 (search-forward string nil nil val)
3336 (search-backward string))
3337 (if (not (equal start-point (point)))
3338 (push-mark start-point t)))
3340 (if (and (not fail-if-not-found) vip-search-wrap-around-t)
3342 (message "Search wrapped around BOTTOM of buffer")
3343 (goto-char (point-min))
3344 (vip-search string forward (cons 1 com) t start-point 'fail)
3345 ;; don't wait in macros
3346 (or executing-kbd-macro (sit-for 2))
3347 ;; delete the wrap-around message
3350 (goto-char start-point)
3351 (error "`%s': %s not found"
3353 (if vip-re-search "Pattern" "String"))
3359 (re-search-backward string nil nil val)
3360 (search-backward string nil nil val))
3361 (if (not (equal start-point (point)))
3362 (push-mark start-point t)))
3364 (if (and (not fail-if-not-found) vip-search-wrap-around-t)
3366 (message "Search wrapped around TOP of buffer")
3367 (goto-char (point-max))
3368 (vip-search string forward (cons 1 com) t start-point 'fail)
3369 ;; don't wait in macros
3370 (or executing-kbd-macro (sit-for 2))
3371 ;; delete the wrap-around message
3374 (goto-char start-point)
3375 (error "`%s': %s not found"
3377 (if vip-re-search "Pattern" "String"))
3379 ;; pull up or down if at top/bottom of window
3381 ;; highlight the result of search
3382 ;; don't wait and don't highlight in macros
3383 (or executing-kbd-macro
3384 vip-inside-command-argument-action
3385 (vip-flash-search-pattern))
3388 (defun vip-search-next (arg)
3389 "Repeat previous search."
3391 (let ((val (vip-p-val arg))
3392 (com (vip-getcom arg)))
3393 (if (null vip-s-string) (error vip-NoPrevSearch))
3394 (vip-search vip-s-string vip-s-forward arg)
3397 (vip-move-marker-locally 'vip-com-point (mark t))
3398 (vip-execute-com 'vip-search-next val com)))))
3400 (defun vip-search-Next (arg)
3401 "Repeat previous search in the reverse direction."
3403 (let ((val (vip-p-val arg))
3404 (com (vip-getcom arg)))
3405 (if (null vip-s-string) (error vip-NoPrevSearch))
3406 (vip-search vip-s-string (not vip-s-forward) arg)
3409 (vip-move-marker-locally 'vip-com-point (mark t))
3410 (vip-execute-com 'vip-search-Next val com)))))
3413 ;; Search contents of buffer defined by one of Viper's motion commands.
3414 ;; Repeatable via `n' and `N'.
3415 (defun vip-buffer-search-enable (&optional c)
3416 (cond (c (setq vip-buffer-search-char c))
3417 ((null vip-buffer-search-char)
3418 (setq vip-buffer-search-char ?g)))
3419 (define-key vip-vi-basic-map
3420 (char-to-string vip-buffer-search-char) 'vip-command-argument)
3421 (aset vip-exec-array vip-buffer-search-char 'vip-exec-buffer-search)
3422 (setq vip-prefix-commands (cons vip-buffer-search-char vip-prefix-commands)))
3424 ;; This is a Viper wraper for isearch-forward.
3425 (defun vip-isearch-forward (arg)
3426 "Do incremental search forward."
3428 ;; emacs bug workaround
3429 (if (listp arg) (setq arg (car arg)))
3430 (vip-exec-form-in-emacs (list 'isearch-forward arg)))
3432 ;; This is a Viper wraper for isearch-backward."
3433 (defun vip-isearch-backward (arg)
3434 "Do incremental search backward."
3436 ;; emacs bug workaround
3437 (if (listp arg) (setq arg (car arg)))
3438 (vip-exec-form-in-emacs (list 'isearch-backward arg)))
3441 ;; visiting and killing files, buffers
3443 (defun vip-switch-to-buffer ()
3444 "Switch to buffer in the current window."
3449 (format "Switch to buffer in this window \(%s\): "
3450 (buffer-name (other-buffer (current-buffer))))))
3451 (switch-to-buffer buffer)
3454 (defun vip-switch-to-buffer-other-window ()
3455 "Switch to buffer in another window."
3460 (format "Switch to buffer in another window \(%s\): "
3461 (buffer-name (other-buffer (current-buffer))))))
3462 (switch-to-buffer-other-window buffer)
3465 (defun vip-kill-buffer ()
3468 (let (buffer buffer-name)
3471 (format "Kill buffer \(%s\): "
3472 (buffer-name (current-buffer)))))
3474 (if (null buffer-name)
3476 (get-buffer buffer-name)))
3477 (if (null buffer) (error "`%s': No such buffer" buffer-name))
3478 (if (or (not (buffer-modified-p buffer))
3481 "Buffer `%s' is modified, are you sure you want to kill it? "
3483 (kill-buffer buffer)
3484 (error "Buffer not killed"))))
3487 (defcustom vip-smart-suffix-list
3488 '("" "tex" "c" "cc" "C" "el" "java" "html" "htm" "pl" "P" "p")
3489 "*List of suffixes that Viper automatically tries to append to filenames ending with a `.'.
3490 This is useful when you the current directory contains files with the same
3491 prefix and many different suffixes. Usually, only one of the suffixes
3492 represents an editable file. However, file completion will stop at the `.'
3493 The smart suffix feature lets you hit RET in such a case, and Viper will
3494 select the appropriate suffix.
3496 Suffixes are tried in the order given and the first suffix for which a
3497 corresponding file exists is selected. If no file exists for any of the
3498 suffixes, the user is asked to confirm.
3500 To turn this feature off, set this variable to nil."
3504 ;; Try to add suffix to files ending with a `.'
3505 ;; Useful when the user hits RET on a non-completed file name.
3506 (defun vip-file-add-suffix ()
3508 (len (length vip-smart-suffix-list))
3509 (file (buffer-string))
3511 (goto-char (point-max))
3512 (if (and vip-smart-suffix-list (string-match "\\.$" file))
3514 (while (and (not found) (< count len))
3515 (setq suff (nth count vip-smart-suffix-list)
3517 (if (file-exists-p (format "%s%s" file suff))
3524 (vip-tmp-insert-at-eob " [Please complete file name]")
3526 (while (not (memq cmd '(exit-minibuffer vip-exit-minibuffer)))
3528 (key-binding (setq key (read-key-sequence nil))))
3529 (cond ((eq cmd 'self-insert-command)
3531 (insert (events-to-keys key))
3533 ((memq cmd '(exit-minibuffer vip-exit-minibuffer))
3535 (t (command-execute cmd)))
3545 (defsubst vip-yank (text)
3546 "Yank TEXT silently. This works correctly with Emacs's yank-pop command."
3548 (setq this-command 'yank))
3550 (defun vip-put-back (arg)
3551 "Put back after point/below line."
3553 (let ((val (vip-p-val arg))
3554 (text (if vip-use-register
3555 (cond ((vip-valid-register vip-use-register '(digit))
3556 (current-kill (- vip-use-register ?1) 'do-not-rotate))
3557 ((vip-valid-register vip-use-register)
3558 (get-register (downcase vip-use-register)))
3559 (t (error vip-InvalidRegister vip-use-register)))
3562 (if vip-use-register
3563 (let ((reg vip-use-register))
3564 (setq vip-use-register nil)
3565 (error vip-EmptyRegister reg))
3567 (setq vip-use-register nil)
3568 (if (vip-end-with-a-newline-p text)
3574 (beginning-of-line))
3575 (if (not (eolp)) (vip-forward-char-carefully)))
3576 (set-marker (vip-mark-marker) (point) (current-buffer))
3577 (vip-set-destructive-command
3578 (list 'vip-put-back val nil vip-use-register nil nil))
3579 (vip-loop val (vip-yank text)))
3580 ;; Vi puts cursor on the last char when the yanked text doesn't contain a
3581 ;; newline; it leaves the cursor at the beginning when the text contains
3583 (if (vip-same-line (point) (mark))
3584 (or (= (point) (mark)) (vip-backward-char-carefully))
3585 (exchange-point-and-mark)
3587 (back-to-indentation)))
3588 (vip-deactivate-mark))
3590 (defun vip-Put-back (arg)
3591 "Put back at point/above line."
3593 (let ((val (vip-p-val arg))
3594 (text (if vip-use-register
3595 (cond ((vip-valid-register vip-use-register '(digit))
3596 (current-kill (- vip-use-register ?1) 'do-not-rotate))
3597 ((vip-valid-register vip-use-register)
3598 (get-register (downcase vip-use-register)))
3599 (t (error vip-InvalidRegister vip-use-register)))
3602 (if vip-use-register
3603 (let ((reg vip-use-register))
3604 (setq vip-use-register nil)
3605 (error vip-EmptyRegister reg))
3607 (setq vip-use-register nil)
3608 (if (vip-end-with-a-newline-p text) (beginning-of-line))
3609 (vip-set-destructive-command
3610 (list 'vip-Put-back val nil vip-use-register nil nil))
3611 (set-marker (vip-mark-marker) (point) (current-buffer))
3612 (vip-loop val (vip-yank text)))
3613 ;; Vi puts cursor on the last char when the yanked text doesn't contain a
3614 ;; newline; it leaves the cursor at the beginning when the text contains
3616 (if (vip-same-line (point) (mark))
3617 (or (= (point) (mark)) (vip-backward-char-carefully))
3618 (exchange-point-and-mark)
3620 (back-to-indentation)))
3621 (vip-deactivate-mark))
3624 ;; Copy region to kill-ring.
3625 ;; If BEG and END do not belong to the same buffer, copy empty region.
3626 (defun vip-copy-region-as-kill (beg end)
3628 (copy-region-as-kill beg end)
3629 (error (copy-region-as-kill beg beg))))
3632 (defun vip-delete-char (arg)
3635 (let ((val (vip-p-val arg)))
3636 (vip-set-destructive-command (list 'vip-delete-char val nil nil nil nil))
3639 (let ((here (point)))
3641 (if (> val (- (point) here))
3642 (setq val (- (point) here))))))
3643 (if (and (eq val 0) (not vip-ex-style-motion)) (setq val 1))
3644 (if (and vip-ex-style-motion (eolp))
3645 (if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch
3646 (if vip-use-register
3648 (cond ((vip-valid-register vip-use-register '((Letter)))
3649 (vip-append-to-register
3650 (downcase vip-use-register) (point) (- (point) val)))
3651 ((vip-valid-register vip-use-register)
3653 vip-use-register (point) (- (point) val) nil))
3654 (t (error vip-InvalidRegister vip-use-register)))
3655 (setq vip-use-register nil)))
3656 (if vip-ex-style-motion
3659 (if (and (eolp) (not (bolp))) (backward-char 1)))
3661 (delete-backward-char val t)
3662 (delete-char val t)))))
3664 (defun vip-delete-backward-char (arg)
3665 "Delete previous character. On reaching beginning of line, stop and beep."
3667 (let ((val (vip-p-val arg)))
3668 (vip-set-destructive-command
3669 (list 'vip-delete-backward-char val nil nil nil nil))
3672 (let ((here (point)))
3674 (if (> val (- here (point)))
3675 (setq val (- here (point)))))))
3676 (if vip-use-register
3678 (cond ((vip-valid-register vip-use-register '(Letter))
3679 (vip-append-to-register
3680 (downcase vip-use-register) (point) (+ (point) val)))
3681 ((vip-valid-register vip-use-register)
3683 vip-use-register (point) (+ (point) val) nil))
3684 (t (error vip-InvalidRegister vip-use-register)))
3685 (setq vip-use-register nil)))
3687 (delete-backward-char val t))))
3689 (defun vip-del-backward-char-in-insert ()
3690 "Delete 1 char backwards while in insert mode."
3692 (if (and vip-ex-style-editing-in-insert (bolp))
3694 (delete-backward-char 1 t)))
3696 (defun vip-del-backward-char-in-replace ()
3697 "Delete one character in replace mode.
3698 If `vip-delete-backwards-in-replace' is t, then DEL key actually deletes
3699 charecters. If it is nil, then the cursor just moves backwards, similarly
3700 to Vi. The variable `vip-ex-style-editing-in-insert', if t, doesn't let the
3701 cursor move past the beginning of line."
3703 (cond (vip-delete-backwards-in-replace
3705 (delete-backward-char 1 t))
3706 (vip-ex-style-editing-in-insert
3711 (delete-backward-char 1 t))))
3712 (vip-ex-style-editing-in-insert
3717 (backward-char 1))))
3723 (defun vip-join-lines (arg)
3724 "Join this line to next, if ARG is nil. Otherwise, join ARG lines."
3726 (let ((val (vip-P-val arg)))
3727 (vip-set-destructive-command (list 'vip-join-lines val nil nil nil nil))
3728 (vip-loop (if (null val) 1 (1- val))
3734 (delete-region (point) (1- (point)))
3736 ;; fixup-whitespace sometimes does not leave space
3737 ;; between objects, so we insert it as in Vi
3738 (or (looking-at " ")
3746 (defun vip-change (beg end)
3747 (if (markerp beg) (setq beg (marker-position beg)))
3748 (if (markerp end) (setq end (marker-position end)))
3749 ;; beg is sometimes (mark t), which may be nil
3750 (or beg (setq beg end))
3752 (vip-set-complex-command-for-undo)
3753 (if vip-use-register
3755 (copy-to-register vip-use-register beg end nil)
3756 (setq vip-use-register nil)))
3757 (vip-set-replace-overlay beg end)
3758 (setq last-command nil) ; separate repl text from prev kills
3760 (if (= (vip-replace-start) (point-max))
3761 (error "End of buffer"))
3763 (setq vip-last-replace-region
3764 (buffer-substring (vip-replace-start)
3767 ;; protect against error while inserting "@" and other disasters
3768 ;; (e.g., read-only buff)
3769 (condition-case conds
3770 (if (or vip-allow-multiline-replace-regions
3771 (vip-same-line (vip-replace-start)
3774 ;; tabs cause problems in replace, so untabify
3775 (goto-char (vip-replace-end))
3776 (insert-before-markers "@") ; put placeholder after the TAB
3777 (untabify (vip-replace-start) (point))
3778 ;; del @, don't put on kill ring
3779 (delete-backward-char 1)
3781 (vip-set-replace-overlay-glyphs
3782 vip-replace-region-start-delimiter
3783 vip-replace-region-end-delimiter)
3784 ;; this move takes care of the last posn in the overlay, which
3785 ;; has to be shifted because of insert. We can't simply insert
3786 ;; "$" before-markers because then overlay-start will shift the
3787 ;; beginning of the overlay in case we are replacing a single
3788 ;; character. This fixes the bug with `s' and `cl' commands.
3789 (vip-move-replace-overlay (vip-replace-start) (point))
3790 (goto-char (vip-replace-start))
3791 (vip-change-state-to-replace t))
3792 (kill-region (vip-replace-start)
3794 (vip-hide-replace-overlay)
3795 (vip-change-state-to-insert))
3796 (error ;; make sure that the overlay doesn't stay.
3797 ;; go back to the original point
3798 (goto-char (vip-replace-start))
3799 (vip-hide-replace-overlay)
3800 (vip-message-conditions conds))))
3803 (defun vip-change-subr (beg end)
3804 ;; beg is sometimes (mark t), which may be nil
3805 (or beg (setq beg end))
3807 (if vip-use-register
3809 (copy-to-register vip-use-register beg end nil)
3810 (setq vip-use-register nil)))
3811 (kill-region beg end)
3812 (setq this-command 'vip-change)
3813 (vip-yank-last-insertion))
3815 (defun vip-toggle-case (arg)
3816 "Toggle character case."
3818 (let ((val (vip-p-val arg)) (c))
3819 (vip-set-destructive-command (list 'vip-toggle-case val nil nil nil nil))
3821 (setq c (following-char))
3823 (if (eq c (upcase c))
3824 (insert-char (downcase c) 1)
3825 (insert-char (upcase c) 1))
3826 (if (eolp) (backward-char 1))
3827 (setq val (1- val)))))
3832 (defun vip-query-replace ()
3834 If a null string is suplied as the string to be replaced,
3835 the query replace mode will toggle between string replace
3836 and regexp replace."
3839 (setq str (vip-read-string-with-history
3840 (if vip-re-query-replace "Query replace regexp: "
3843 'vip-replace1-history
3844 (car vip-replace1-history) ; default
3846 (if (string= str "")
3848 (setq vip-re-query-replace (not vip-re-query-replace))
3849 (message "Query replace mode changed to %s"
3850 (if vip-re-query-replace "regexp replace"
3852 (if vip-re-query-replace
3853 (query-replace-regexp
3855 (vip-read-string-with-history
3856 (format "Query replace regexp `%s' with: " str)
3858 'vip-replace1-history
3859 (car vip-replace1-history) ; default
3863 (vip-read-string-with-history
3864 (format "Query replace `%s' with: " str)
3866 'vip-replace1-history
3867 (car vip-replace1-history) ; default
3873 (defun vip-mark-beginning-of-buffer ()
3874 "Mark beginning of buffer."
3877 (goto-char (point-min))
3878 (exchange-point-and-mark)
3879 (message "Mark set at the beginning of buffer"))
3881 (defun vip-mark-end-of-buffer ()
3882 "Mark end of buffer."
3885 (goto-char (point-max))
3886 (exchange-point-and-mark)
3887 (message "Mark set at the end of buffer"))
3889 (defun vip-mark-point ()
3890 "Set mark at point of buffer."
3892 (let ((char (read-char)))
3893 (cond ((and (<= ?a char) (<= char ?z))
3894 (point-to-register (1+ (- char ?a))))
3895 ((= char ?<) (vip-mark-beginning-of-buffer))
3896 ((= char ?>) (vip-mark-end-of-buffer))
3897 ((= char ?.) (vip-set-mark-if-necessary))
3898 ((= char ?,) (vip-cycle-through-mark-ring))
3899 ((= char ?D) (mark-defun))
3903 ;; Algorithm: If first invocation of this command save mark on ring, goto
3904 ;; mark, M0, and pop the most recent elt from the mark ring into mark,
3905 ;; making it into the new mark, M1.
3906 ;; Push this mark back and set mark to the original point position, p1.
3907 ;; So, if you hit '' or `` then you can return to p1.
3909 ;; If repeated command, pop top elt from the ring into mark and
3910 ;; jump there. This forgets the position, p1, and puts M1 back into mark.
3911 ;; Then we save the current pos, which is M0, jump to M1 and pop M2 from
3912 ;; the ring into mark. Push M2 back on the ring and set mark to M0.
3914 (defun vip-cycle-through-mark-ring ()
3915 "Visit previous locations on the mark ring.
3916 One can use `` and '' to temporarily jump 1 step back."
3917 (let* ((sv-pt (point)))
3918 ;; if repeated `m,' command, pop the previously saved mark.
3919 ;; Prev saved mark is actually prev saved point. It is used if the
3920 ;; user types `` or '' and is discarded
3921 ;; from the mark ring by the next `m,' command.
3922 ;; In any case, go to the previous or previously saved mark.
3923 ;; Then push the current mark (popped off the ring) and set current
3924 ;; point to be the mark. Current pt as mark is discarded by the next
3926 (if (eq last-command 'vip-cycle-through-mark-ring)
3928 ;; save current mark if the first iteration
3929 (setq mark-ring (delete (vip-mark-marker) mark-ring))
3931 (push-mark (mark t) t)) )
3933 (set-mark-command 1)
3934 ;; don't duplicate mark on the ring
3935 (setq mark-ring (delete (vip-mark-marker) mark-ring))
3937 (vip-deactivate-mark)
3938 (setq this-command 'vip-cycle-through-mark-ring)
3942 (defun vip-goto-mark (arg)
3945 (let ((char (read-char))
3946 (com (vip-getcom arg)))
3947 (vip-goto-mark-subr char com nil)))
3949 (defun vip-goto-mark-and-skip-white (arg)
3950 "Go to mark and skip to first non-white character on line."
3952 (let ((char (read-char))
3953 (com (vip-getCom arg)))
3954 (vip-goto-mark-subr char com t)))
3956 (defun vip-goto-mark-subr (char com skip-white)
3959 (error "Empty buffer")
3961 (cond ((vip-valid-register char '(letter))
3962 (let* ((buff (current-buffer))
3963 (reg (1+ (- char ?a)))
3964 (text-marker (get-register reg)))
3965 (if com (vip-move-marker-locally 'vip-com-point (point)))
3966 (if (not (vip-valid-marker text-marker))
3967 (error vip-EmptyTextmarker char))
3968 (if (and (vip-same-line (point) vip-last-jump)
3969 (= (point) vip-last-jump-ignore))
3970 (push-mark vip-last-jump t)
3971 (push-mark nil t)) ; no msg
3972 (vip-register-to-point reg)
3973 (setq vip-last-jump (point-marker))
3975 (back-to-indentation)
3976 (setq vip-last-jump-ignore (point))))
3978 (if (equal buff (current-buffer))
3979 (vip-execute-com (if skip-white
3980 'vip-goto-mark-and-skip-white
3983 (switch-to-buffer buff)
3984 (goto-char vip-com-point)
3985 (vip-change-state-to-vi)
3987 ((and (not skip-white) (= char ?`))
3988 (if com (vip-move-marker-locally 'vip-com-point (point)))
3989 (if (and (vip-same-line (point) vip-last-jump)
3990 (= (point) vip-last-jump-ignore))
3991 (goto-char vip-last-jump))
3992 (if (null (mark t)) (error "Mark is not set in this buffer"))
3993 (if (= (point) (mark t)) (pop-mark))
3994 (exchange-point-and-mark)
3995 (setq vip-last-jump (point-marker)
3996 vip-last-jump-ignore 0)
3997 (if com (vip-execute-com 'vip-goto-mark nil com)))
3998 ((and skip-white (= char ?'))
3999 (if com (vip-move-marker-locally 'vip-com-point (point)))
4000 (if (and (vip-same-line (point) vip-last-jump)
4001 (= (point) vip-last-jump-ignore))
4002 (goto-char vip-last-jump))
4003 (if (= (point) (mark t)) (pop-mark))
4004 (exchange-point-and-mark)
4005 (setq vip-last-jump (point))
4006 (back-to-indentation)
4007 (setq vip-last-jump-ignore (point))
4008 (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com)))
4009 (t (error vip-InvalidTextmarker char))))
4011 (defun vip-insert-tab ()
4015 (defun vip-exchange-point-and-mark ()
4017 (exchange-point-and-mark)
4018 (back-to-indentation))
4020 ;; Input Mode Indentation
4022 ;; Returns t, if the string before point matches the regexp STR.
4023 (defsubst vip-looking-back (str)
4024 (and (save-excursion (re-search-backward str nil t))
4025 (= (point) (match-end 0))))
4028 (defun vip-forward-indent ()
4029 "Indent forward -- `C-t' in Vi."
4032 (indent-to (+ (current-column) vip-shift-width)))
4034 (defun vip-backward-indent ()
4035 "Backtab, C-d in VI"
4038 (let ((p (point)) (c (current-column)) bol (indent t))
4039 (if (vip-looking-back "[0^]")
4041 (if (eq ?^ (preceding-char))
4042 (setq vip-preserve-indent t))
4043 (delete-backward-char 1)
4049 (if (re-search-backward "[^ \t]" bol 1) (forward-char))
4050 (delete-region (point) p)
4052 (indent-to (- c vip-shift-width)))
4053 (if (or (bolp) (vip-looking-back "[^ \t]"))
4054 (setq vip-cted nil)))))
4056 (defun vip-autoindent ()
4057 "Auto Indentation, Vi-style."
4059 (let ((col (current-indentation)))
4060 (if abbrev-mode (expand-abbrev))
4061 (if vip-preserve-indent
4062 (setq vip-preserve-indent nil)
4063 (setq vip-current-indent col))
4064 ;; don't leave whitespace lines around
4065 (if (memq last-command
4067 vip-open-line vip-Open-line
4068 vip-replace-state-exit-cmd))
4069 (indent-to-left-margin))
4070 ;; use \n instead of newline, or else <Return> will move the insert point
4076 (if (and vip-electric-mode
4077 (not (eq major-mode 'fundamental-mode)))
4078 (indent-according-to-mode)
4079 (indent-to vip-current-indent))
4084 ;; Viewing registers
4086 (defun vip-ket-function (arg)
4087 "Function called by \], the ket. View registers and call \]\]."
4089 (let ((reg (read-char)))
4090 (cond ((vip-valid-register reg '(letter Letter))
4091 (view-register (downcase reg)))
4092 ((vip-valid-register reg '(digit))
4093 (let ((text (current-kill (- reg ?1) 'do-not-rotate)))
4095 (set-buffer (get-buffer-create "*Output*"))
4096 (delete-region (point-min) (point-max))
4097 (insert (format "Register %c contains the string:\n" reg))
4099 (goto-char (point-min)))
4100 (display-buffer "*Output*")))
4102 (vip-next-heading arg))
4104 vip-InvalidRegister reg)))))
4106 (defun vip-brac-function (arg)
4107 "Function called by \[, the brac. View textmarkers and call \[\["
4109 (let ((reg (read-char)))
4111 (vip-prev-heading arg))
4113 (vip-heading-end arg))
4114 ((vip-valid-register reg '(letter))
4115 (let* ((val (get-register (1+ (- reg ?a))))
4117 (error vip-EmptyTextmarker reg)
4118 (marker-buffer val)))
4119 (pos (marker-position val))
4120 line-no text (s pos) (e pos))
4122 (set-buffer (get-buffer-create "*Output*"))
4123 (delete-region (point-min) (point-max))
4128 (setq line-no (1+ (count-lines (point-min) val)))
4131 (if (re-search-backward "[^ \t]" nil t)
4137 (if (re-search-forward "[^ \t]" nil t)
4141 (setq text (buffer-substring s e))
4142 (setq text (format "%s<%c>%s"
4143 (substring text 0 (- pos s))
4144 reg (substring text (- pos s)))))
4147 "Textmarker `%c' is in buffer `%s' at line %d.\n"
4148 reg (buffer-name buf) line-no))
4149 (insert (format "Here is some text around %c:\n\n %s"
4151 (insert (format vip-EmptyTextmarker reg)))
4152 (goto-char (point-min)))
4153 (display-buffer "*Output*")))
4154 (t (error vip-InvalidTextmarker reg)))))
4158 ;; commands in insertion mode
4160 (defun vip-delete-backward-word (arg)
4161 "Delete previous word."
4166 (delete-region (point) (mark t))
4170 (defun viper-set-expert-level (&optional dont-change-unless)
4171 "Sets the expert level for a Viper user.
4172 Can be called interactively to change (temporarily or permanently) the
4173 current expert level.
4175 The optional argument DONT-CHANGE-UNLESS, if not nil, says that
4176 the level should not be changed, unless its current value is
4177 meaningless (i.e., not one of 1,2,3,4,5).
4179 User level determines the setting of Viper variables that are most
4180 sensitive for VI-style look-and-feel."
4184 (if (not (natnump viper-expert-level)) (setq viper-expert-level 0))
4186 (save-window-excursion
4187 (delete-other-windows)
4188 ;; if 0 < viper-expert-level < viper-max-expert-level
4189 ;; & dont-change-unless = t -- use it; else ask
4190 (vip-ask-level dont-change-unless))
4192 (setq viper-always t
4193 vip-ex-style-motion t
4194 vip-ex-style-editing-in-insert t
4195 vip-want-ctl-h-help nil)
4197 (cond ((eq viper-expert-level 1) ; novice or beginner
4198 (global-set-key ; in emacs-state
4200 (if (vip-window-display-p) 'vip-iconify 'suspend-emacs))
4201 (setq vip-no-multiple-ESC t
4203 vip-vi-style-in-minibuffer t
4204 vip-search-wrap-around-t t
4205 vip-electric-mode nil
4206 vip-want-emacs-keys-in-vi nil
4207 vip-want-emacs-keys-in-insert nil))
4209 ((and (> viper-expert-level 1) (< viper-expert-level 5))
4210 ;; intermediate to guru
4211 (setq vip-no-multiple-ESC (if (vip-window-display-p)
4214 vip-want-emacs-keys-in-vi t
4215 vip-want-emacs-keys-in-insert (> viper-expert-level 2))
4217 (if (eq viper-expert-level 4) ; respect user's ex-style motion
4218 ; and vip-no-multiple-ESC
4221 vip-ex-style-editing-in-insert
4222 (viper-standard-value 'vip-ex-style-editing-in-insert)
4224 (viper-standard-value 'vip-ex-style-motion))
4225 (setq vip-ex-style-motion
4226 (viper-standard-value 'vip-ex-style-motion)
4227 vip-ex-style-editing-in-insert
4228 (viper-standard-value 'vip-ex-style-editing-in-insert)
4230 (viper-standard-value 'vip-re-search)
4232 (viper-standard-value 'vip-no-multiple-ESC)))))
4235 ;; Ideally, if 5 is selected, a buffer should pop up to let the
4236 ;; user toggle the values of variables.
4237 (t (setq-default vip-ex-style-editing-in-insert
4238 (viper-standard-value 'vip-ex-style-editing-in-insert)
4240 (viper-standard-value 'vip-ex-style-motion))
4241 (setq vip-want-ctl-h-help
4242 (viper-standard-value 'vip-want-ctl-h-help)
4244 (viper-standard-value 'viper-always)
4246 (viper-standard-value 'vip-no-multiple-ESC)
4248 (viper-standard-value 'vip-ex-style-motion)
4249 vip-ex-style-editing-in-insert
4250 (viper-standard-value 'vip-ex-style-editing-in-insert)
4252 (viper-standard-value 'vip-re-search)
4254 (viper-standard-value 'vip-electric-mode)
4255 vip-want-emacs-keys-in-vi
4256 (viper-standard-value 'vip-want-emacs-keys-in-vi)
4257 vip-want-emacs-keys-in-insert
4258 (viper-standard-value 'vip-want-emacs-keys-in-insert))))
4260 (vip-set-mode-vars-for vip-current-state)
4261 (if (or viper-always
4262 (and (> viper-expert-level 0) (> 5 viper-expert-level)))
4265 ;; Ask user expert level.
4266 (defun vip-ask-level (dont-change-unless)
4267 (let ((ask-buffer " *vip-ask-level*")
4268 level-changed repeated)
4269 (save-window-excursion
4270 (switch-to-buffer ask-buffer)
4272 (while (or (> viper-expert-level viper-max-expert-level)
4273 (< viper-expert-level 1)
4274 (null dont-change-unless))
4278 (message "Invalid user level")
4281 (setq dont-change-unless t
4284 Please specify your level of familiarity with the venomous VI PERil
4285 (and the VI Plan for Emacs Rescue).
4286 You can change it at any time by typing `M-x viper-set-expert-level RET'
4288 1 -- BEGINNER: Almost all Emacs features are suppressed.
4289 Feels almost like straight Vi. File name completion and
4290 command history in the minibuffer are thrown in as a bonus.
4291 To use Emacs productively, you must reach level 3 or higher.
4292 2 -- MASTER: C-c now has its standard Emacs meaning in Vi command state,
4293 so most Emacs commands can be used when Viper is in Vi state.
4294 Good progress---you are well on the way to level 3!
4295 3 -- GRAND MASTER: Like 3, but most Emacs commands are available also
4296 in Viper's insert state.
4297 4 -- GURU: Like 3, but user settings are respected for vip-no-multiple-ESC,
4298 vip-re-search, vip-ex-style-motion, & vip-ex-style-editing-in-insert
4299 variables. Adjust these settings to your taste.
4300 5 -- WIZARD: Like 4, but user settings are also respected for viper-always,
4301 vip-electric-mode, vip-want-ctl-h-help, vip-want-emacs-keys-in-vi,
4302 and vip-want-emacs-keys-in-insert. Adjust these to your taste.
4304 Please, specify your level now: ")
4306 (setq viper-expert-level (- (vip-read-char-exclusive) ?0))
4309 ;; tell the user if level was changed
4313 (format "\n\n\n\n\n\t\tYou have selected user level %d"
4314 viper-expert-level))
4315 (if (y-or-n-p "Do you wish to make this change permanent? ")
4316 ;; save the setting for viper-expert-level
4319 (format "Saving user level %d ..." viper-expert-level)
4320 vip-custom-file-name))
4322 (bury-buffer) ; remove ask-buffer from screen
4332 ;; if ENFORCE-BUFFER is not nil, error if CHAR is a marker in another buffer
4333 (defun vip-register-to-point (char &optional enforce-buffer)
4334 "Like jump-to-register, but switches to another buffer in another window."
4335 (interactive "cViper register to point: ")
4336 (let ((val (get-register char)))
4338 ((and (fboundp 'frame-configuration-p)
4339 (frame-configuration-p val))
4340 (set-frame-configuration val))
4341 ((window-configuration-p val)
4342 (set-window-configuration val))
4343 ((vip-valid-marker val)
4344 (if (and enforce-buffer
4345 (not (equal (current-buffer) (marker-buffer val))))
4346 (error (concat vip-EmptyTextmarker " in this buffer")
4348 (pop-to-buffer (marker-buffer val))
4350 ((and (consp val) (eq (car val) 'file))
4351 (find-file (cdr val)))
4353 (error vip-EmptyTextmarker (1- (+ char ?a)))))))
4356 (defun vip-save-kill-buffer ()
4357 "Save then kill current buffer. "
4359 (if (< viper-expert-level 2)
4360 (save-buffers-kill-emacs)
4362 (kill-buffer (current-buffer))))
4368 (defun vip-submit-report ()
4369 "Submit bug report on Viper."
4371 (let ((reporter-prompt-for-summary-p t)
4372 (vip-device-type (vip-device-type))
4373 color-display-p frame-parameters
4374 minibuffer-emacs-face minibuffer-vi-face minibuffer-insert-face
4375 varlist salutation window-config)
4377 ;; If mode info is needed, add variable to `let' and then set it below,
4378 ;; like we did with color-display-p.
4379 (setq color-display-p (if (vip-window-display-p)
4380 (vip-color-display-p)
4382 minibuffer-vi-face (if (vip-has-face-support-p)
4383 (vip-get-face vip-minibuffer-vi-face)
4385 minibuffer-insert-face (if (vip-has-face-support-p)
4386 (vip-get-face vip-minibuffer-insert-face)
4388 minibuffer-emacs-face (if (vip-has-face-support-p)
4389 (vip-get-face vip-minibuffer-emacs-face)
4391 frame-parameters (if (fboundp 'frame-parameters)
4392 (frame-parameters (selected-frame))))
4394 (setq varlist (list 'vip-vi-minibuffer-minor-mode
4395 'vip-insert-minibuffer-minor-mode
4396 'vip-vi-intercept-minor-mode
4397 'vip-vi-local-user-minor-mode
4398 'vip-vi-kbd-minor-mode
4399 'vip-vi-global-user-minor-mode
4400 'vip-vi-state-modifier-minor-mode
4401 'vip-vi-diehard-minor-mode
4402 'vip-vi-basic-minor-mode
4403 'vip-replace-minor-mode
4404 'vip-insert-intercept-minor-mode
4405 'vip-insert-local-user-minor-mode
4406 'vip-insert-kbd-minor-mode
4407 'vip-insert-global-user-minor-mode
4408 'vip-insert-state-modifier-minor-mode
4409 'vip-insert-diehard-minor-mode
4410 'vip-insert-basic-minor-mode
4411 'vip-emacs-intercept-minor-mode
4412 'vip-emacs-local-user-minor-mode
4413 'vip-emacs-kbd-minor-mode
4414 'vip-emacs-global-user-minor-mode
4415 'vip-emacs-state-modifier-minor-mode
4416 'vip-automatic-iso-accents
4417 'vip-want-emacs-keys-in-insert
4418 'vip-want-emacs-keys-in-vi
4419 'vip-keep-point-on-undo
4420 'vip-no-multiple-ESC
4423 'vip-want-ctl-h-help
4424 'vip-ex-style-editing-in-insert
4425 'vip-delete-backwards-in-replace
4426 'vip-vi-style-in-minibuffer
4428 'vip-insert-state-hook
4429 'vip-replace-state-hook
4430 'vip-emacs-state-hook
4431 'ex-cycle-other-window
4432 'ex-cycle-through-non-files
4439 'minibuffer-insert-face
4440 'minibuffer-emacs-face
4443 Congratulations! You may have unearthed a bug in Viper!
4444 Please mail a concise, accurate summary of the problem to the address above.
4446 -------------------------------------------------------------------")
4447 (setq window-config (current-window-configuration))
4448 (with-output-to-temp-buffer " *vip-info*"
4449 (switch-to-buffer " *vip-info*")
4450 (delete-other-windows)
4452 PLEASE FOLLOW THESE PROCEDURES
4453 ------------------------------
4455 Before reporting a bug, please verify that it is related to Viper, and is
4456 not cause by other packages you are using.
4458 Don't report compilation warnings, unless you are certain that there is a
4459 problem. These warnings are normal and unavoidable.
4461 Please note that users should not modify variables and keymaps other than
4462 those advertised in the manual. Such `customization' is likely to crash
4463 Viper, as it would any other improperly customized Emacs package.
4465 If you are reporting an error message received while executing one of the
4466 Viper commands, type:
4468 M-x set-variable <Return> debug-on-error <Return> t <Return>
4470 Then reproduce the error. The above command will cause Emacs to produce a
4471 back trace of the execution that leads to the error. Please include this
4472 trace in your bug report.
4474 If you believe that one of Viper's commands goes into an infinite loop
4475 \(e.g., Emacs freezes\), type:
4477 M-x set-variable <Return> debug-on-quit <Return> t <Return>
4479 Then reproduce the problem. Wait for a few seconds, then type C-g to abort
4480 the current command. Include the resulting back trace in the bug report.
4482 Mail anyway (y or n)? ")
4483 (if (y-or-n-p "Mail anyway? ")
4485 (set-window-configuration window-config)
4486 (error "Bug report aborted")))
4489 (set-window-configuration window-config)
4491 (reporter-submit-bug-report "kifer@cs.sunysb.edu"
4494 nil 'delete-other-windows
4501 ;; Smoothes out the difference between Emacs' unread-command-events
4502 ;; and XEmacs unread-command-event. Arg is a character, an event, a list of
4503 ;; events or a sequence of keys.
4505 ;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event
4506 ;; symbol in unread-command-events list may cause Emacs to turn this symbol
4507 ;; into an event. Below, we delete nil from event lists, since nil is the most
4508 ;; common symbol that might appear in this wrong context.
4509 (defun vip-set-unread-command-events (arg)
4512 unread-command-events
4514 (cond ((eventp arg) (list arg))
4517 (listify-key-sequence arg))
4519 "vip-set-unread-command-events: Invalid argument, %S"
4521 (if (not (eventp nil))
4522 (setq new-events (delq nil new-events)))
4523 (append new-events unread-command-events)))
4526 unread-command-events
4528 (cond ((vip-characterp arg) (list (character-to-event arg)))
4529 ((eventp arg) (list arg))
4530 ((stringp arg) (mapcar 'character-to-event arg))
4531 ((vectorp arg) (append arg nil)) ; turn into list
4532 ((listp arg) (vip-eventify-list-xemacs arg))
4534 "vip-set-unread-command-events: Invalid argument, %S" arg)))
4535 unread-command-events))))
4537 ;; list is assumed to be a list of events of characters
4538 (defun vip-eventify-list-xemacs (lis)
4540 (function (lambda (elt)
4541 (cond ((vip-characterp elt) (character-to-event elt))
4544 "vip-eventify-list-xemacs: can't convert to event, %S"
4550 ;;; viper-cmd.el ends here