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