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