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