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