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