Mercurial > hg > xemacs-beta

comparison lisp/viper/viper-util.el @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents 9ee227acff29
children 441bb1e64a06
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
1 ;;; viper-util.el --- Utilities used by viper.el 1 ;;; viper-util.el --- Utilities used by viper.el
2 2
3 ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
4 4
5 ;; This file is part of GNU Emacs. 5 ;; This file is part of GNU Emacs.
6 6
7 ;; GNU Emacs is free software; you can redistribute it and/or modify 7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by 8 ;; it under the terms of the GNU General Public License as published by
20 ;; Boston, MA 02111-1307, USA. 20 ;; Boston, MA 02111-1307, USA.
21 21
22 22
23 ;; Code 23 ;; Code
24 24
25 (require 'ring)
26
27 ;; Compiler pacifier 25 ;; Compiler pacifier
28 (defvar vip-overriding-map) 26 (defvar vip-overriding-map)
29 (defvar pm-color-alist) 27 (defvar pm-color-alist)
30 (defvar zmacs-region-stays) 28 (defvar zmacs-region-stays)
31 (defvar vip-search-face)
32 (defvar vip-minibuffer-current-face) 29 (defvar vip-minibuffer-current-face)
33 (defvar vip-minibuffer-insert-face) 30 (defvar vip-minibuffer-insert-face)
34 (defvar vip-minibuffer-vi-face) 31 (defvar vip-minibuffer-vi-face)
35 (defvar vip-minibuffer-emacs-face) 32 (defvar vip-minibuffer-emacs-face)
36 (defvar vip-replace-overlay-face) 33 (defvar vip-replace-overlay-face)
37 (defvar vip-minibuffer-overlay)
38 (defvar vip-replace-overlay)
39 (defvar vip-search-overlay)
40 (defvar vip-replace-overlay-cursor-color)
41 (defvar vip-intermediate-command)
42 (defvar vip-use-replace-region-delimiters)
43 (defvar vip-fast-keyseq-timeout) 34 (defvar vip-fast-keyseq-timeout)
44 (defvar vip-related-files-and-buffers-ring)
45 (defvar vip-saved-cursor-color)
46 (defvar ex-unix-type-shell) 35 (defvar ex-unix-type-shell)
47 (defvar ex-unix-type-shell-options) 36 (defvar ex-unix-type-shell-options)
48 (defvar vip-ex-tmp-buf-name) 37 (defvar vip-ex-tmp-buf-name)
38
39 (require 'cl)
40 (require 'ring)
41
42 (and noninteractive
43 (eval-when-compile
44 (let ((load-path (cons (expand-file-name ".") load-path)))
45 (or (featurep 'viper-init)
46 (load "viper-init.el" nil nil 'nosuffix))
47 )))
49 ;; end pacifier 48 ;; end pacifier
50 49
51 ;; Is it XEmacs? 50 (require 'viper-init)
52 (defconst vip-xemacs-p (string-match "\\(Lucid\\|XEmacs\\)" emacs-version))
53 ;; Is it Emacs?
54 (defconst vip-emacs-p (not vip-xemacs-p))
55 ;; Tell whether we are running as a window application or on a TTY
56 (defsubst vip-device-type ()
57 (if vip-emacs-p
58 window-system
59 (device-type (selected-device))))
60 ;; in XEmacs: device-type is tty on tty and stream in batch.
61 (defun vip-window-display-p ()
62 (and (vip-device-type) (not (memq (vip-device-type) '(tty stream pc)))))
63
64 (defvar vip-ms-style-os-p (memq system-type '(ms-dos windows-nt windows-95))
65 "Tells if Emacs is running under an MS-style OS: ms-dos, windows-nt, W95.")
66 (defvar vip-vms-os-p (memq system-type '(vax-vms axp-vms))
67 "Tells if Emacs is running under VMS.")
68
69 (defvar vip-force-faces nil
70 "If t, Viper will think that it is running on a display that supports faces.
71 This is provided as a temporary relief for users of face-capable displays
72 that Viper doesn't know about.")
73
74 (defun vip-has-face-support-p ()
75 (cond ((vip-window-display-p))
76 (vip-force-faces)
77 (vip-emacs-p (memq (vip-device-type) '(pc)))
78 (vip-xemacs-p (memq (vip-device-type) '(tty pc)))))
79
80
81 ;;; Macros
82
83 (defmacro vip-deflocalvar (var default-value &optional documentation)
84 (` (progn
85 (defvar (, var) (, default-value)
86 (, (format "%s\n\(buffer local\)" documentation)))
87 (make-variable-buffer-local '(, var))
88 )))
89
90 (defmacro vip-loop (count body)
91 "(vip-loop COUNT BODY) Execute BODY COUNT times."
92 (list 'let (list (list 'count count))
93 (list 'while '(> count 0)
94 body
95 '(setq count (1- count))
96 )))
97
98 (defmacro vip-buffer-live-p (buf)
99 (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf))))))
100
101 ;; return buffer-specific macro definition, given a full macro definition
102 (defmacro vip-kbd-buf-alist (macro-elt)
103 (` (nth 1 (, macro-elt))))
104 ;; get a pair: (curr-buffer . macro-definition)
105 (defmacro vip-kbd-buf-pair (macro-elt)
106 (` (assoc (buffer-name) (vip-kbd-buf-alist (, macro-elt)))))
107 ;; get macro definition for current buffer
108 (defmacro vip-kbd-buf-definition (macro-elt)
109 (` (cdr (vip-kbd-buf-pair (, macro-elt)))))
110
111 ;; return mode-specific macro definitions, given a full macro definition
112 (defmacro vip-kbd-mode-alist (macro-elt)
113 (` (nth 2 (, macro-elt))))
114 ;; get a pair: (major-mode . macro-definition)
115 (defmacro vip-kbd-mode-pair (macro-elt)
116 (` (assoc major-mode (vip-kbd-mode-alist (, macro-elt)))))
117 ;; get macro definition for the current major mode
118 (defmacro vip-kbd-mode-definition (macro-elt)
119 (` (cdr (vip-kbd-mode-pair (, macro-elt)))))
120
121 ;; return global macro definition, given a full macro definition
122 (defmacro vip-kbd-global-pair (macro-elt)
123 (` (nth 3 (, macro-elt))))
124 ;; get global macro definition from an elt of macro-alist
125 (defmacro vip-kbd-global-definition (macro-elt)
126 (` (cdr (vip-kbd-global-pair (, macro-elt)))))
127
128 ;; last elt of a sequence
129 (defsubst vip-seq-last-elt (seq)
130 (elt seq (1- (length seq))))
131
132 ;; Check if arg is a valid character for register
133 ;; TYPE is a list that can contain `letter', `Letter', and `digit'.
134 ;; Letter means lowercase letters, Letter means uppercase letters, and
135 ;; digit means digits from 1 to 9.
136 ;; If TYPE is nil, then down/uppercase letters and digits are allowed.
137 (defun vip-valid-register (reg &optional type)
138 (or type (setq type '(letter Letter digit)))
139 (or (if (memq 'letter type)
140 (and (<= ?a reg) (<= reg ?z)))
141 (if (memq 'digit type)
142 (and (<= ?1 reg) (<= reg ?9)))
143 (if (memq 'Letter type)
144 (and (<= ?A reg) (<= reg ?Z)))
145 ))
146
147 ;; checks if object is a marker, has a buffer, and points to within that buffer
148 (defun vip-valid-marker (marker)
149 (if (and (markerp marker) (marker-buffer marker))
150 (let ((buf (marker-buffer marker))
151 (pos (marker-position marker)))
152 (save-excursion
153 (set-buffer buf)
154 (and (<= pos (point-max)) (<= (point-min) pos))))))
155
156
157 (defvar vip-minibuffer-overlay-priority 300)
158 (defvar vip-replace-overlay-priority 400)
159 (defvar vip-search-overlay-priority 500)
160
161
162 ;;; Viper minor modes
163
164 ;; This is not local in Emacs, so we make it local.
165 ;; This must be local because although the stack of minor modes can be the same
166 ;; for all buffers, the associated *keymaps* can be different. In Viper,
167 ;; vip-vi-local-user-map, vip-insert-local-user-map, and others can have
168 ;; different keymaps for different buffers.
169 ;; Also, the keymaps associated with vip-vi/insert-state-modifier-minor-mode
170 ;; can be different.
171 (make-variable-buffer-local 'minor-mode-map-alist)
172
173 ;; Mode for vital things like \e, C-z.
174 (vip-deflocalvar vip-vi-intercept-minor-mode nil)
175
176 (vip-deflocalvar vip-vi-basic-minor-mode nil
177 "Viper's minor mode for Vi bindings.")
178
179 (vip-deflocalvar vip-vi-local-user-minor-mode nil
180 "Auxiliary minor mode for user-defined local bindings in Vi state.")
181
182 (vip-deflocalvar vip-vi-global-user-minor-mode nil
183 "Auxiliary minor mode for user-defined global bindings in Vi state.")
184
185 (vip-deflocalvar vip-vi-state-modifier-minor-mode nil
186 "Minor mode used to make major-mode-specific modification to Vi state.")
187
188 (vip-deflocalvar vip-vi-diehard-minor-mode nil
189 "This minor mode is in effect when the user wants Viper to be Vi.")
190
191 (vip-deflocalvar vip-vi-kbd-minor-mode nil
192 "Minor mode for Ex command macros in Vi state.
193 The corresponding keymap stores key bindings of Vi macros defined with
194 the Ex command :map.")
195
196 ;; Mode for vital things like \e, C-z.
197 (vip-deflocalvar vip-insert-intercept-minor-mode nil)
198
199 (vip-deflocalvar vip-insert-basic-minor-mode nil
200 "Viper's minor mode for bindings in Insert mode.")
201
202 (vip-deflocalvar vip-insert-local-user-minor-mode nil
203 "Auxiliary minor mode for buffer-local user-defined bindings in Insert state.
204 This is a way to overshadow normal Insert mode bindings locally to certain
205 designated buffers.")
206
207 (vip-deflocalvar vip-insert-global-user-minor-mode nil
208 "Auxiliary minor mode for global user-defined bindings in Insert state.")
209
210 (vip-deflocalvar vip-insert-state-modifier-minor-mode nil
211 "Minor mode used to make major-mode-specific modification to Insert state.")
212
213 (vip-deflocalvar vip-insert-diehard-minor-mode nil
214 "Minor mode that simulates Vi very closely.
215 Not recommened, except for the novice user.")
216
217 (vip-deflocalvar vip-insert-kbd-minor-mode nil
218 "Minor mode for Ex command macros Insert state.
219 The corresponding keymap stores key bindings of Vi macros defined with
220 the Ex command :map!.")
221
222 (vip-deflocalvar vip-replace-minor-mode nil
223 "Minor mode in effect in replace state (cw, C, and the like commands).")
224
225 ;; Mode for vital things like \C-z and \C-x)
226 ;; This is t, by default. So, any new buffer will have C-z defined as
227 ;; switch to Vi, unless we switched states in this buffer
228 (vip-deflocalvar vip-emacs-intercept-minor-mode t)
229
230 (vip-deflocalvar vip-emacs-local-user-minor-mode t
231 "Minor mode for local user bindings effective in Emacs state.
232 Users can use it to override Emacs bindings when Viper is in its Emacs
233 state.")
234
235 (vip-deflocalvar vip-emacs-global-user-minor-mode t
236 "Minor mode for global user bindings in effect in Emacs state.
237 Users can use it to override Emacs bindings when Viper is in its Emacs
238 state.")
239
240 (vip-deflocalvar vip-emacs-kbd-minor-mode t
241 "Minor mode for Vi style macros in Emacs state.
242 The corresponding keymap stores key bindings of Vi macros defined with
243 `vip-record-kbd-macro' command. There is no Ex-level command to do this
244 interactively.")
245
246 (vip-deflocalvar vip-emacs-state-modifier-minor-mode t
247 "Minor mode used to make major-mode-specific modification to Emacs state.
248 For instance, a Vi purist may want to bind `dd' in Dired mode to a function
249 that deletes a file.")
250
251 (vip-deflocalvar vip-vi-minibuffer-minor-mode nil
252 "Minor mode that forces Vi-style when the Minibuffer is in Vi state.")
253
254 (vip-deflocalvar vip-insert-minibuffer-minor-mode nil
255 "Minor mode that forces Vi-style when the Minibuffer is in Insert state.")
256
257
258
259 ;; Some common error messages
260
261 (defconst vip-SpuriousText "Spurious text after command" "")
262 (defconst vip-BadExCommand "Not an editor command" "")
263 (defconst vip-InvalidCommandArgument "Invalid command argument" "")
264 (defconst vip-NoPrevSearch "No previous search string" "")
265 (defconst vip-EmptyRegister "`%c': Nothing in this register" "")
266 (defconst vip-InvalidRegister "`%c': Invalid register" "")
267 (defconst vip-EmptyTextmarker "`%c': Text marker doesn't point anywhere" "")
268 (defconst vip-InvalidTextmarker "`%c': Invalid text marker" "")
269 (defconst vip-InvalidViCommand "Invalid command" "")
270 (defconst vip-BadAddress "Ill-formed address" "")
271 (defconst vip-FirstAddrExceedsSecond "First address exceeds second" "")
272 (defconst vip-NoFileSpecified "No file specified" "")
273 51
274 52
275 53
276 ;;; XEmacs support 54 ;;; XEmacs support
277 55
358 (stringp new-color) (vip-color-defined-p new-color) 136 (stringp new-color) (vip-color-defined-p new-color)
359 (not (string= new-color (vip-get-cursor-color)))) 137 (not (string= new-color (vip-get-cursor-color))))
360 (modify-frame-parameters 138 (modify-frame-parameters
361 (selected-frame) (list (cons 'cursor-color new-color))))) 139 (selected-frame) (list (cons 'cursor-color new-color)))))
362 140
363 (defsubst vip-save-cursor-color () 141 (defun vip-save-cursor-color ()
364 (if (and (vip-window-display-p) (vip-color-display-p)) 142 (if (and (vip-window-display-p) (vip-color-display-p))
365 (let ((color (vip-get-cursor-color))) 143 (let ((color (vip-get-cursor-color)))
366 (if (and (stringp color) (vip-color-defined-p color) 144 (if (and (stringp color) (vip-color-defined-p color)
367 (not (string= color vip-replace-overlay-cursor-color))) 145 (not (string= color vip-replace-overlay-cursor-color)))
368 (vip-overlay-put vip-replace-overlay 'vip-cursor-color color))))) 146 (vip-overlay-put vip-replace-overlay 'vip-cursor-color color)))))
372 (vip-change-cursor-color 150 (vip-change-cursor-color
373 (vip-overlay-get vip-replace-overlay 'vip-cursor-color))) 151 (vip-overlay-get vip-replace-overlay 'vip-cursor-color)))
374 (defsubst vip-restore-cursor-color-after-insert () 152 (defsubst vip-restore-cursor-color-after-insert ()
375 (vip-change-cursor-color vip-saved-cursor-color)) 153 (vip-change-cursor-color vip-saved-cursor-color))
376 154
155
156 ;; Face-saving tricks
157
158 (defvar vip-search-face
159 (if (vip-has-face-support-p)
160 (progn
161 (make-face 'vip-search-face)
162 (vip-hide-face 'vip-search-face)
163 (or (face-differs-from-default-p 'vip-search-face)
164 ;; face wasn't set in .vip or .Xdefaults
165 (if (vip-can-use-colors "Black" "khaki")
166 (progn
167 (set-face-background 'vip-search-face "khaki")
168 (set-face-foreground 'vip-search-face "Black"))
169 (set-face-underline-p 'vip-search-face t)
170 (vip-set-face-pixmap 'vip-search-face vip-search-face-pixmap)))
171 'vip-search-face))
172 "*Face used to flash out the search pattern.")
173
174 (defvar vip-replace-overlay-face
175 (if (vip-has-face-support-p)
176 (progn
177 (make-face 'vip-replace-overlay-face)
178 (vip-hide-face 'vip-replace-overlay-face)
179 (or (face-differs-from-default-p 'vip-replace-overlay-face)
180 (progn
181 (if (vip-can-use-colors "darkseagreen2" "Black")
182 (progn
183 (set-face-background
184 'vip-replace-overlay-face "darkseagreen2")
185 (set-face-foreground 'vip-replace-overlay-face "Black")))
186 (set-face-underline-p 'vip-replace-overlay-face t)
187 (vip-set-face-pixmap
188 'vip-replace-overlay-face vip-replace-overlay-pixmap)))
189 'vip-replace-overlay-face))
190 "*Face for highlighting replace regions on a window display.")
191
192 (defvar vip-minibuffer-emacs-face
193 (if (vip-has-face-support-p)
194 (progn
195 (make-face 'vip-minibuffer-emacs-face)
196 (vip-hide-face 'vip-minibuffer-emacs-face)
197 (or (face-differs-from-default-p 'vip-minibuffer-emacs-face)
198 ;; face wasn't set in .vip or .Xdefaults
199 (if vip-vi-style-in-minibuffer
200 ;; emacs state is an exception in the minibuffer
201 (if (vip-can-use-colors "darkseagreen2" "Black")
202 (progn
203 (set-face-background
204 'vip-minibuffer-emacs-face "darkseagreen2")
205 (set-face-foreground
206 'vip-minibuffer-emacs-face "Black"))
207 (copy-face 'modeline 'vip-minibuffer-emacs-face))
208 ;; emacs state is the main state in the minibuffer
209 (if (vip-can-use-colors "Black" "pink")
210 (progn
211 (set-face-background 'vip-minibuffer-emacs-face "pink")
212 (set-face-foreground
213 'vip-minibuffer-emacs-face "Black"))
214 (copy-face 'italic 'vip-minibuffer-emacs-face))
215 ))
216 'vip-minibuffer-emacs-face))
217 "Face used in the Minibuffer when it is in Emacs state.")
218
219 (defvar vip-minibuffer-insert-face
220 (if (vip-has-face-support-p)
221 (progn
222 (make-face 'vip-minibuffer-insert-face)
223 (vip-hide-face 'vip-minibuffer-insert-face)
224 (or (face-differs-from-default-p 'vip-minibuffer-insert-face)
225 (if vip-vi-style-in-minibuffer
226 (if (vip-can-use-colors "Black" "pink")
227 (progn
228 (set-face-background 'vip-minibuffer-insert-face "pink")
229 (set-face-foreground
230 'vip-minibuffer-insert-face "Black"))
231 (copy-face 'italic 'vip-minibuffer-insert-face))
232 ;; If Insert state is an exception
233 (if (vip-can-use-colors "darkseagreen2" "Black")
234 (progn
235 (set-face-background
236 'vip-minibuffer-insert-face "darkseagreen2")
237 (set-face-foreground
238 'vip-minibuffer-insert-face "Black"))
239 (copy-face 'modeline 'vip-minibuffer-insert-face))
240 (vip-italicize-face 'vip-minibuffer-insert-face)))
241 'vip-minibuffer-insert-face))
242 "Face used in the Minibuffer when it is in Insert state.")
243
244 (defvar vip-minibuffer-vi-face
245 (if (vip-has-face-support-p)
246 (progn
247 (make-face 'vip-minibuffer-vi-face)
248 (vip-hide-face 'vip-minibuffer-vi-face)
249 (or (face-differs-from-default-p 'vip-minibuffer-vi-face)
250 (if vip-vi-style-in-minibuffer
251 (if (vip-can-use-colors "Black" "grey")
252 (progn
253 (set-face-background 'vip-minibuffer-vi-face "grey")
254 (set-face-foreground 'vip-minibuffer-vi-face "Black"))
255 (copy-face 'bold 'vip-minibuffer-vi-face))
256 (copy-face 'bold 'vip-minibuffer-vi-face)
257 (invert-face 'vip-minibuffer-vi-face)))
258 'vip-minibuffer-vi-face))
259 "Face used in the Minibuffer when it is in Vi state.")
260
261 ;; the current face to be used in the minibuffer
262 (vip-deflocalvar vip-minibuffer-current-face vip-minibuffer-emacs-face "")
263
377 264
378 ;; Check the current version against the major and minor version numbers 265 ;; Check the current version against the major and minor version numbers
379 ;; using op: cur-vers op major.minor If emacs-major-version or 266 ;; using op: cur-vers op major.minor If emacs-major-version or
380 ;; emacs-minor-version are not defined, we assume that the current version 267 ;; emacs-minor-version are not defined, we assume that the current version
381 ;; is hopelessly outdated. We assume that emacs-major-version and 268 ;; is hopelessly outdated. We assume that emacs-major-version and
401 (error "%S: Invalid op in vip-check-version" op)))) 288 (error "%S: Invalid op in vip-check-version" op))))
402 (cond ((memq op '(= > >=)) nil) 289 (cond ((memq op '(= > >=)) nil)
403 ((memq op '(< <=)) t)))) 290 ((memq op '(< <=)) t))))
404 291
405 ;;;; warn if it is a wrong version of emacs 292 ;;;; warn if it is a wrong version of emacs
406 ;;(if (or (vip-check-version '< 19 29 'emacs) 293 ;;(if (or (vip-check-version '< 19 35 'emacs)
407 ;; (vip-check-version '< 19 12 'xemacs)) 294 ;; (vip-check-version '< 19 15 'xemacs))
408 ;; (progn 295 ;; (progn
409 ;; (with-output-to-temp-buffer " *vip-info*" 296 ;; (with-output-to-temp-buffer " *vip-info*"
410 ;; (switch-to-buffer " *vip-info*") 297 ;; (switch-to-buffer " *vip-info*")
411 ;; (insert 298 ;; (insert
412 ;; (format " 299 ;; (format "
413 ;; 300 ;;
414 ;;This version of Viper requires 301 ;;This version of Viper requires
415 ;; 302 ;;
416 ;;\t Emacs 19.29 and higher 303 ;;\t Emacs 19.35 and higher
417 ;;\t OR 304 ;;\t OR
418 ;;\t XEmacs 19.12 and higher 305 ;;\t XEmacs 19.15 and higher
419 ;; 306 ;;
420 ;;It is unlikely to work under Emacs version %s 307 ;;It is unlikely to work under Emacs version %s
421 ;;that you are using... " emacs-version)) 308 ;;that you are using... " emacs-version))
422 ;; 309 ;;
423 ;; (if noninteractive 310 ;; (if noninteractive
671 (file-name-nondirectory (car tmp))) 558 (file-name-nondirectory (car tmp)))
672 "$")) 559 "$"))
673 tmp2)) 560 tmp2))
674 (setq tmp (cdr tmp))) 561 (setq tmp (cdr tmp)))
675 (reverse (apply 'append tmp2)))) 562 (reverse (apply 'append tmp2))))
676
677 (defun vip-convert-standard-file-name (fname)
678 (if vip-emacs-p
679 (convert-standard-filename fname)
680 ;; hopefully, XEmacs adds this functionality
681 fname))
682
683 563
684 564
685 ;;; Insertion ring 565 ;;; Insertion ring
686 566
687 ;; Rotate RING's index. DIRection can be positive or negative. 567 ;; Rotate RING's index. DIRection can be positive or negative.
890 (setq vip-replace-overlay (vip-make-overlay beg end (current-buffer))) 770 (setq vip-replace-overlay (vip-make-overlay beg end (current-buffer)))
891 ;; never detach 771 ;; never detach
892 (vip-overlay-put 772 (vip-overlay-put
893 vip-replace-overlay (if vip-emacs-p 'evaporate 'detachable) nil) 773 vip-replace-overlay (if vip-emacs-p 'evaporate 'detachable) nil)
894 (vip-overlay-put 774 (vip-overlay-put
895 vip-replace-overlay 'priority vip-replace-overlay-priority)) 775 vip-replace-overlay 'priority vip-replace-overlay-priority)
776 ;; If Emacs will start supporting overlay maps, as it currently supports
777 ;; text-property maps, we could do away with vip-replace-minor-mode and
778 ;; just have keymap attached to replace overlay.
779 ;;(vip-overlay-put
780 ;; vip-replace-overlay
781 ;; (if vip-xemacs-p 'keymap 'local-map)
782 ;; vip-replace-map)
783 )
896 (if (vip-has-face-support-p) 784 (if (vip-has-face-support-p)
897 (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face)) 785 (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face))
898 (vip-save-cursor-color) 786 (vip-save-cursor-color)
899 (vip-change-cursor-color vip-replace-overlay-cursor-color) 787 (vip-change-cursor-color vip-replace-overlay-cursor-color)
900 ) 788 )
901 789
902 790
903 (defsubst vip-set-replace-overlay-glyphs (before-glyph after-glyph) 791 (defun vip-set-replace-overlay-glyphs (before-glyph after-glyph)
904 (if (or (not (vip-has-face-support-p)) 792 (if (or (not (vip-has-face-support-p))
905 vip-use-replace-region-delimiters) 793 vip-use-replace-region-delimiters)
906 (let ((before-name (if vip-xemacs-p 'begin-glyph 'before-string)) 794 (let ((before-name (if vip-xemacs-p 'begin-glyph 'before-string))
907 (after-name (if vip-xemacs-p 'end-glyph 'after-string))) 795 (after-name (if vip-xemacs-p 'end-glyph 'after-string)))
908 (vip-overlay-put vip-replace-overlay before-name before-glyph) 796 (vip-overlay-put vip-replace-overlay before-name before-glyph)
909 (vip-overlay-put vip-replace-overlay after-name after-glyph)))) 797 (vip-overlay-put vip-replace-overlay after-name after-glyph))))
910 798
911 (defsubst vip-hide-replace-overlay () 799 (defun vip-hide-replace-overlay ()
912 (vip-set-replace-overlay-glyphs nil nil) 800 (vip-set-replace-overlay-glyphs nil nil)
913 (vip-restore-cursor-color-after-replace) 801 (vip-restore-cursor-color-after-replace)
914 (vip-restore-cursor-color-after-insert) 802 (vip-restore-cursor-color-after-insert)
915 (if (vip-has-face-support-p) 803 (if (vip-has-face-support-p)
916 (vip-overlay-put vip-replace-overlay 'face nil))) 804 (vip-overlay-put vip-replace-overlay 'face nil)))
977 ;; EVENT may be a single event of a sequence of events 865 ;; EVENT may be a single event of a sequence of events
978 (defsubst vip-ESC-event-p (event) 866 (defsubst vip-ESC-event-p (event)
979 (let ((ESC-keys '(?\e (control \[) escape)) 867 (let ((ESC-keys '(?\e (control \[) escape))
980 (key (vip-event-key event))) 868 (key (vip-event-key event)))
981 (member key ESC-keys))) 869 (member key ESC-keys)))
982 870
871 ;; checks if object is a marker, has a buffer, and points to within that buffer
872 (defun vip-valid-marker (marker)
873 (if (and (markerp marker) (marker-buffer marker))
874 (let ((buf (marker-buffer marker))
875 (pos (marker-position marker)))
876 (save-excursion
877 (set-buffer buf)
878 (and (<= pos (point-max)) (<= (point-min) pos))))))
983 879
984 (defsubst vip-mark-marker () 880 (defsubst vip-mark-marker ()
985 (if vip-xemacs-p 881 (if vip-xemacs-p
986 (mark-marker t) 882 (mark-marker t)
987 (mark-marker))) 883 (mark-marker)))
1001 (deactivate-mark))) 897 (deactivate-mark)))
1002 898
1003 (defsubst vip-leave-region-active () 899 (defsubst vip-leave-region-active ()
1004 (if vip-xemacs-p 900 (if vip-xemacs-p
1005 (setq zmacs-region-stays t))) 901 (setq zmacs-region-stays t)))
902
903 ;; Check if arg is a valid character for register
904 ;; TYPE is a list that can contain `letter', `Letter', and `digit'.
905 ;; Letter means lowercase letters, Letter means uppercase letters, and
906 ;; digit means digits from 1 to 9.
907 ;; If TYPE is nil, then down/uppercase letters and digits are allowed.
908 (defun vip-valid-register (reg &optional type)
909 (or type (setq type '(letter Letter digit)))
910 (or (if (memq 'letter type)
911 (and (<= ?a reg) (<= reg ?z)))
912 (if (memq 'digit type)
913 (and (<= ?1 reg) (<= reg ?9)))
914 (if (memq 'Letter type)
915 (and (<= ?A reg) (<= reg ?Z)))
916 ))
1006 917
1007 918
1008 (defsubst vip-events-to-keys (events) 919 (defsubst vip-events-to-keys (events)
1009 (cond (vip-xemacs-p (events-to-keys events)) 920 (cond (vip-xemacs-p (events-to-keys events))
1010 (t events))) 921 (t events)))
1101 ;; instead of nil, if '(nil) was previously inadvertently assigned to 1012 ;; instead of nil, if '(nil) was previously inadvertently assigned to
1102 ;; unread-command-events 1013 ;; unread-command-events
1103 (defun vip-event-key (event) 1014 (defun vip-event-key (event)
1104 (or (and event (eventp event)) 1015 (or (and event (eventp event))
1105 (error "vip-event-key: Wrong type argument, eventp, %S" event)) 1016 (error "vip-event-key: Wrong type argument, eventp, %S" event))
1106 (let ((mod (event-modifiers event)) 1017 (when (cond (vip-xemacs-p (or (key-press-event-p event)
1107 basis) 1018 (mouse-event-p event)))
1108 (setq basis 1019 (t t))
1109 (cond 1020 (let ((mod (event-modifiers event))
1110 (vip-xemacs-p 1021 basis)
1111 (cond ((key-press-event-p event) 1022 (setq basis
1112 (event-key event)) 1023 (cond
1113 ((button-event-p event) 1024 (vip-xemacs-p
1114 (concat "mouse-" (prin1-to-string (event-button event)))) 1025 (cond ((key-press-event-p event)
1115 (t 1026 (event-key event))
1116 (error "vip-event-key: Unknown event, %S" event)))) 1027 ((button-event-p event)
1117 (t 1028 (concat "mouse-" (prin1-to-string (event-button event))))
1118 ;; Emacs doesn't handle capital letters correctly, since 1029 (t
1119 ;; \S-a isn't considered the same as A (it behaves as 1030 (error "vip-event-key: Unknown event, %S" event))))
1120 ;; plain `a' instead). So we take care of this here 1031 (t
1121 (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z)) 1032 ;; Emacs doesn't handle capital letters correctly, since
1122 (setq mod nil 1033 ;; \S-a isn't considered the same as A (it behaves as
1123 event event)) 1034 ;; plain `a' instead). So we take care of this here
1124 ;; Emacs has the oddity whereby characters 128+char 1035 (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z))
1125 ;; represent M-char *if* this appears inside a string. 1036 (setq mod nil
1126 ;; So, we convert them manually to (meta char). 1037 event event))
1127 ((and (vip-characterp event) (< ?\C-? event) (<= event 255)) 1038 ;; Emacs has the oddity whereby characters 128+char
1128 (setq mod '(meta) 1039 ;; represent M-char *if* this appears inside a string.
1129 event (- event ?\C-? 1))) 1040 ;; So, we convert them manually to (meta char).
1130 (t (event-basic-type event))) 1041 ((and (vip-characterp event)
1131 ))) 1042 (< ?\C-? event) (<= event 255))
1132 (if (vip-characterp basis) 1043 (setq mod '(meta)
1133 (setq basis 1044 event (- event ?\C-? 1)))
1134 (if (= basis ?\C-?) 1045 (t (event-basic-type event)))
1135 (list 'control '\?) ; taking care of an emacs bug 1046 )))
1136 (intern (char-to-string basis))))) 1047 (if (vip-characterp basis)
1137 (if mod 1048 (setq basis
1138 (append mod (list basis)) 1049 (if (= basis ?\C-?)
1139 basis))) 1050 (list 'control '\?) ; taking care of an emacs bug
1051 (intern (char-to-string basis)))))
1052 (if mod
1053 (append mod (list basis))
1054 basis))))
1140 1055
1141 (defun vip-key-to-emacs-key (key) 1056 (defun vip-key-to-emacs-key (key)
1142 (let (key-name char-p modifiers mod-char-list base-key base-key-name) 1057 (let (key-name char-p modifiers mod-char-list base-key base-key-name)
1143 (cond (vip-xemacs-p key) 1058 (cond (vip-xemacs-p key)
1144 ((symbolp key) 1059 ((symbolp key)
1301 (append (vconcat addl-chars) nil)) 1216 (append (vconcat addl-chars) nil))
1302 (memq (char-syntax char) 1217 (memq (char-syntax char)
1303 (append (vconcat vip-ALPHA-char-class) nil))))) 1218 (append (vconcat vip-ALPHA-char-class) nil)))))
1304 )) 1219 ))
1305 1220
1306 (defsubst vip-looking-at-separator () 1221 (defun vip-looking-at-separator ()
1307 (let ((char (char-after (point)))) 1222 (let ((char (char-after (point))))
1308 (if char 1223 (if char
1309 (or (eq char ?\n) ; RET is always a separator in Vi 1224 (or (eq char ?\n) ; RET is always a separator in Vi
1310 (memq (char-syntax char) 1225 (memq (char-syntax char)
1311 (append (vconcat vip-SEP-char-class) nil)))))) 1226 (append (vconcat vip-SEP-char-class) nil))))))
1312 1227
1313 (defsubst vip-looking-at-alphasep (&optional addl-chars) 1228 (defsubst vip-looking-at-alphasep (&optional addl-chars)
1314 (or (vip-looking-at-separator) (vip-looking-at-alpha addl-chars))) 1229 (or (vip-looking-at-separator) (vip-looking-at-alpha addl-chars)))
1315 1230
1316 (defsubst vip-skip-alpha-forward (&optional addl-chars) 1231 (defun vip-skip-alpha-forward (&optional addl-chars)
1317 (or (stringp addl-chars) (setq addl-chars "")) 1232 (or (stringp addl-chars) (setq addl-chars ""))
1318 (vip-skip-syntax 1233 (vip-skip-syntax
1319 'forward 1234 'forward
1320 (cond ((eq vip-syntax-preference 'strict-vi) 1235 (cond ((eq vip-syntax-preference 'strict-vi)
1321 "") 1236 "")
1322 (t vip-ALPHA-char-class )) 1237 (t vip-ALPHA-char-class ))
1323 (cond ((eq vip-syntax-preference 'strict-vi) 1238 (cond ((eq vip-syntax-preference 'strict-vi)
1324 (concat vip-strict-ALPHA-chars addl-chars)) 1239 (concat vip-strict-ALPHA-chars addl-chars))
1325 (t addl-chars)))) 1240 (t addl-chars))))
1326 1241
1327 (defsubst vip-skip-alpha-backward (&optional addl-chars) 1242 (defun vip-skip-alpha-backward (&optional addl-chars)
1328 (or (stringp addl-chars) (setq addl-chars "")) 1243 (or (stringp addl-chars) (setq addl-chars ""))
1329 (vip-skip-syntax 1244 (vip-skip-syntax
1330 'backward 1245 'backward
1331 (cond ((eq vip-syntax-preference 'strict-vi) 1246 (cond ((eq vip-syntax-preference 'strict-vi)
1332 "") 1247 "")
1349 (defun vip-skip-nonseparators (direction) 1264 (defun vip-skip-nonseparators (direction)
1350 (let ((func (intern (format "skip-syntax-%S" direction)))) 1265 (let ((func (intern (format "skip-syntax-%S" direction))))
1351 (funcall func (concat "^" vip-SEP-char-class) 1266 (funcall func (concat "^" vip-SEP-char-class)
1352 (vip-line-pos (if (eq direction 'forward) 'end 'start))))) 1267 (vip-line-pos (if (eq direction 'forward) 'end 'start)))))
1353 1268
1354 (defsubst vip-skip-nonalphasep-forward () 1269 (defun vip-skip-nonalphasep-forward ()
1355 (if (eq vip-syntax-preference 'strict-vi) 1270 (if (eq vip-syntax-preference 'strict-vi)
1356 (skip-chars-forward 1271 (skip-chars-forward
1357 (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars)) 1272 (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars))
1358 (skip-syntax-forward 1273 (skip-syntax-forward
1359 (concat 1274 (concat
1360 "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'end)))) 1275 "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'end))))
1361 (defsubst vip-skip-nonalphasep-backward () 1276 (defun vip-skip-nonalphasep-backward ()
1362 (if (eq vip-syntax-preference 'strict-vi) 1277 (if (eq vip-syntax-preference 'strict-vi)
1363 (skip-chars-backward 1278 (skip-chars-backward
1364 (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars)) 1279 (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars))
1365 (skip-syntax-backward 1280 (skip-syntax-backward
1366 (concat 1281 (concat