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