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