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