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