|
0
|
1 ;;; viper-util.el --- Utilities used by viper.el
|
|
|
2
|
|
|
3 ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; This file is part of GNU Emacs.
|
|
|
6
|
|
|
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
|
|
|
9 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
10 ;; any later version.
|
|
|
11
|
|
|
12 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
15 ;; GNU General Public License for more details.
|
|
|
16
|
|
|
17 ;; You should have received a copy of the GNU General Public License
|
|
|
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
20 ;; Boston, MA 02111-1307, USA.
|
|
|
21
|
|
|
22
|
|
|
23 ;; Code
|
|
|
24
|
|
|
25 (require 'ring)
|
|
|
26
|
|
|
27 ;; Compiler pacifier
|
|
|
28 (defvar vip-overriding-map)
|
|
|
29 (defvar pm-color-alist)
|
|
|
30 (defvar zmacs-region-stays)
|
|
|
31 (defvar vip-search-face)
|
|
|
32 (defvar vip-minibuffer-current-face)
|
|
|
33 (defvar vip-minibuffer-insert-face)
|
|
|
34 (defvar vip-minibuffer-vi-face)
|
|
|
35 (defvar vip-minibuffer-emacs-face)
|
|
|
36 (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)
|
|
|
44 (defvar vip-related-files-and-buffers-ring)
|
|
14
|
45 (defvar vip-saved-cursor-color)
|
|
|
46 (defvar ex-unix-type-shell)
|
|
|
47 (defvar ex-unix-type-shell-options)
|
|
|
48 (defvar vip-ex-tmp-buf-name)
|
|
|
49 ;; end pacifier
|
|
0
|
50
|
|
|
51 ;; Is it XEmacs?
|
|
|
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 ()
|
|
12
|
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.")
|
|
0
|
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
|
|
14
|
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
|
|
|
274
|
|
|
275
|
|
0
|
276 ;;; XEmacs support
|
|
|
277
|
|
|
278 (if vip-xemacs-p
|
|
|
279 (progn
|
|
|
280 (fset 'vip-read-event (symbol-function 'next-command-event))
|
|
|
281 (fset 'vip-make-overlay (symbol-function 'make-extent))
|
|
|
282 (fset 'vip-overlay-start (symbol-function 'extent-start-position))
|
|
|
283 (fset 'vip-overlay-end (symbol-function 'extent-end-position))
|
|
|
284 (fset 'vip-overlay-put (symbol-function 'set-extent-property))
|
|
|
285 (fset 'vip-overlay-p (symbol-function 'extentp))
|
|
|
286 (fset 'vip-overlay-get (symbol-function 'extent-property))
|
|
|
287 (fset 'vip-move-overlay (symbol-function 'set-extent-endpoints))
|
|
|
288 (if (vip-window-display-p)
|
|
|
289 (fset 'vip-iconify (symbol-function 'iconify-frame)))
|
|
|
290 (cond ((vip-has-face-support-p)
|
|
|
291 (fset 'vip-get-face (symbol-function 'get-face))
|
|
|
292 (fset 'vip-color-defined-p
|
|
|
293 (symbol-function 'valid-color-name-p))
|
|
|
294 )))
|
|
|
295 (fset 'vip-read-event (symbol-function 'read-event))
|
|
|
296 (fset 'vip-make-overlay (symbol-function 'make-overlay))
|
|
|
297 (fset 'vip-overlay-start (symbol-function 'overlay-start))
|
|
|
298 (fset 'vip-overlay-end (symbol-function 'overlay-end))
|
|
|
299 (fset 'vip-overlay-put (symbol-function 'overlay-put))
|
|
|
300 (fset 'vip-overlay-p (symbol-function 'overlayp))
|
|
|
301 (fset 'vip-overlay-get (symbol-function 'overlay-get))
|
|
|
302 (fset 'vip-move-overlay (symbol-function 'move-overlay))
|
|
|
303 (if (vip-window-display-p)
|
|
|
304 (fset 'vip-iconify (symbol-function 'iconify-or-deiconify-frame)))
|
|
|
305 (cond ((vip-has-face-support-p)
|
|
|
306 (fset 'vip-get-face (symbol-function 'internal-get-face))
|
|
|
307 (fset 'vip-color-defined-p (symbol-function 'x-color-defined-p))
|
|
|
308 )))
|
|
|
309
|
|
|
310 (fset 'vip-characterp
|
|
|
311 (symbol-function
|
|
|
312 (if vip-xemacs-p 'characterp 'integerp)))
|
|
|
313
|
|
|
314 (defsubst vip-color-display-p ()
|
|
|
315 (if vip-emacs-p
|
|
|
316 (x-display-color-p)
|
|
|
317 (eq (device-class (selected-device)) 'color)))
|
|
|
318
|
|
|
319 (defsubst vip-get-cursor-color ()
|
|
12
|
320 (if vip-emacs-p
|
|
|
321 (cdr (assoc 'cursor-color (frame-parameters)))
|
|
|
322 (color-instance-name (frame-property (selected-frame) 'cursor-color))))
|
|
|
323
|
|
|
324 (defun vip-set-face-pixmap (face pixmap)
|
|
|
325 "Set face pixmap on a monochrome display."
|
|
|
326 (if (and (vip-window-display-p) (not (vip-color-display-p)))
|
|
|
327 (condition-case nil
|
|
|
328 (set-face-background-pixmap face pixmap)
|
|
|
329 (error
|
|
|
330 (message "Pixmap not found for %S: %s" (face-name face) pixmap)
|
|
|
331 (sit-for 1)))))
|
|
|
332
|
|
0
|
333
|
|
|
334 ;; OS/2
|
|
|
335 (cond ((eq (vip-device-type) 'pm)
|
|
|
336 (fset 'vip-color-defined-p
|
|
|
337 (function (lambda (color) (assoc color pm-color-alist))))))
|
|
|
338
|
|
|
339 ;; needed to smooth out the difference between Emacs and XEmacs
|
|
|
340 (defsubst vip-italicize-face (face)
|
|
|
341 (if vip-xemacs-p
|
|
|
342 (make-face-italic face)
|
|
|
343 (make-face-italic face nil 'noerror)))
|
|
|
344
|
|
|
345 ;; test if display is color and the colors are defined
|
|
|
346 (defsubst vip-can-use-colors (&rest colors)
|
|
|
347 (if (vip-color-display-p)
|
|
|
348 (not (memq nil (mapcar 'vip-color-defined-p colors)))
|
|
|
349 ))
|
|
|
350
|
|
|
351 (defun vip-hide-face (face)
|
|
|
352 (if (and (vip-has-face-support-p) vip-emacs-p)
|
|
|
353 (add-to-list 'facemenu-unlisted-faces face)))
|
|
|
354
|
|
|
355 ;; cursor colors
|
|
|
356 (defun vip-change-cursor-color (new-color)
|
|
|
357 (if (and (vip-window-display-p) (vip-color-display-p)
|
|
|
358 (stringp new-color) (vip-color-defined-p new-color)
|
|
|
359 (not (string= new-color (vip-get-cursor-color))))
|
|
|
360 (modify-frame-parameters
|
|
|
361 (selected-frame) (list (cons 'cursor-color new-color)))))
|
|
|
362
|
|
|
363 (defsubst vip-save-cursor-color ()
|
|
|
364 (if (and (vip-window-display-p) (vip-color-display-p))
|
|
|
365 (let ((color (vip-get-cursor-color)))
|
|
|
366 (if (and (stringp color) (vip-color-defined-p color)
|
|
|
367 (not (string= color vip-replace-overlay-cursor-color)))
|
|
|
368 (vip-overlay-put vip-replace-overlay 'vip-cursor-color color)))))
|
|
|
369
|
|
12
|
370 ;; restore cursor color from replace overlay
|
|
|
371 (defsubst vip-restore-cursor-color-after-replace ()
|
|
0
|
372 (vip-change-cursor-color
|
|
|
373 (vip-overlay-get vip-replace-overlay 'vip-cursor-color)))
|
|
12
|
374 (defsubst vip-restore-cursor-color-after-insert ()
|
|
|
375 (vip-change-cursor-color vip-saved-cursor-color))
|
|
14
|
376
|
|
0
|
377
|
|
|
378 ;; Check the current version against the major and minor version numbers
|
|
|
379 ;; 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
|
|
|
381 ;; is hopelessly outdated. We assume that emacs-major-version and
|
|
|
382 ;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the
|
|
|
383 ;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value
|
|
|
384 ;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be
|
|
|
385 ;; incorrect. However, this gives correct result in our cases, since we are
|
|
|
386 ;; testing for sufficiently high Emacs versions.
|
|
|
387 (defun vip-check-version (op major minor &optional type-of-emacs)
|
|
|
388 (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
|
|
|
389 (and (cond ((eq type-of-emacs 'xemacs) vip-xemacs-p)
|
|
|
390 ((eq type-of-emacs 'emacs) vip-emacs-p)
|
|
|
391 (t t))
|
|
|
392 (cond ((eq op '=) (and (= emacs-minor-version minor)
|
|
|
393 (= emacs-major-version major)))
|
|
|
394 ((memq op '(> >= < <=))
|
|
|
395 (and (or (funcall op emacs-major-version major)
|
|
|
396 (= emacs-major-version major))
|
|
|
397 (if (= emacs-major-version major)
|
|
|
398 (funcall op emacs-minor-version minor)
|
|
|
399 t)))
|
|
|
400 (t
|
|
|
401 (error "%S: Invalid op in vip-check-version" op))))
|
|
|
402 (cond ((memq op '(= > >=)) nil)
|
|
|
403 ((memq op '(< <=)) t))))
|
|
|
404
|
|
|
405 ;;;; warn if it is a wrong version of emacs
|
|
|
406 ;;(if (or (vip-check-version '< 19 29 'emacs)
|
|
|
407 ;; (vip-check-version '< 19 12 'xemacs))
|
|
|
408 ;; (progn
|
|
|
409 ;; (with-output-to-temp-buffer " *vip-info*"
|
|
|
410 ;; (switch-to-buffer " *vip-info*")
|
|
|
411 ;; (insert
|
|
|
412 ;; (format "
|
|
|
413 ;;
|
|
|
414 ;;This version of Viper requires
|
|
|
415 ;;
|
|
|
416 ;;\t Emacs 19.29 and higher
|
|
|
417 ;;\t OR
|
|
|
418 ;;\t XEmacs 19.12 and higher
|
|
|
419 ;;
|
|
|
420 ;;It is unlikely to work under Emacs version %s
|
|
|
421 ;;that you are using... " emacs-version))
|
|
|
422 ;;
|
|
|
423 ;; (if noninteractive
|
|
|
424 ;; ()
|
|
|
425 ;; (beep 1)
|
|
|
426 ;; (beep 1)
|
|
|
427 ;; (insert "\n\nType any key to continue... ")
|
|
|
428 ;; (vip-read-event)))
|
|
|
429 ;; (kill-buffer " *vip-info*")))
|
|
|
430
|
|
|
431
|
|
|
432 (defun vip-get-visible-buffer-window (wind)
|
|
|
433 (if vip-xemacs-p
|
|
|
434 (get-buffer-window wind t)
|
|
|
435 (get-buffer-window wind 'visible)))
|
|
|
436
|
|
|
437
|
|
|
438 ;; Return line position.
|
|
|
439 ;; If pos is 'start then returns position of line start.
|
|
|
440 ;; If pos is 'end, returns line end. If pos is 'mid, returns line center.
|
|
|
441 ;; Pos = 'indent returns beginning of indentation.
|
|
|
442 ;; Otherwise, returns point. Current point is not moved in any case."
|
|
|
443 (defun vip-line-pos (pos)
|
|
|
444 (let ((cur-pos (point))
|
|
|
445 (result))
|
|
|
446 (cond
|
|
|
447 ((equal pos 'start)
|
|
|
448 (beginning-of-line))
|
|
|
449 ((equal pos 'end)
|
|
|
450 (end-of-line))
|
|
|
451 ((equal pos 'mid)
|
|
|
452 (goto-char (+ (vip-line-pos 'start) (vip-line-pos 'end) 2)))
|
|
|
453 ((equal pos 'indent)
|
|
|
454 (back-to-indentation))
|
|
|
455 (t nil))
|
|
|
456 (setq result (point))
|
|
|
457 (goto-char cur-pos)
|
|
|
458 result))
|
|
|
459
|
|
|
460
|
|
|
461 ;; Like move-marker but creates a virgin marker if arg isn't already a marker.
|
|
|
462 ;; The first argument must eval to a variable name.
|
|
|
463 ;; Arguments: (var-name position &optional buffer).
|
|
|
464 ;;
|
|
|
465 ;; This is useful for moving markers that are supposed to be local.
|
|
|
466 ;; For this, VAR-NAME should be made buffer-local with nil as a default.
|
|
|
467 ;; Then, each time this var is used in `vip-move-marker-locally' in a new
|
|
|
468 ;; buffer, a new marker will be created.
|
|
|
469 (defun vip-move-marker-locally (var pos &optional buffer)
|
|
|
470 (if (markerp (eval var))
|
|
|
471 ()
|
|
|
472 (set var (make-marker)))
|
|
|
473 (move-marker (eval var) pos buffer))
|
|
|
474
|
|
|
475
|
|
|
476 ;; Print CONDITIONS as a message.
|
|
|
477 (defun vip-message-conditions (conditions)
|
|
|
478 (let ((case (car conditions)) (msg (cdr conditions)))
|
|
|
479 (if (null msg)
|
|
|
480 (message "%s" case)
|
|
|
481 (message "%s: %s" case (mapconcat 'prin1-to-string msg " ")))
|
|
|
482 (beep 1)))
|
|
|
483
|
|
|
484
|
|
|
485
|
|
|
486 ;;; List/alist utilities
|
|
|
487
|
|
|
488 ;; Convert LIST to an alist
|
|
|
489 (defun vip-list-to-alist (lst)
|
|
|
490 (let ((alist))
|
|
|
491 (while lst
|
|
|
492 (setq alist (cons (list (car lst)) alist))
|
|
|
493 (setq lst (cdr lst)))
|
|
|
494 alist))
|
|
|
495
|
|
|
496 ;; Convert ALIST to a list.
|
|
|
497 (defun vip-alist-to-list (alst)
|
|
|
498 (let ((lst))
|
|
|
499 (while alst
|
|
|
500 (setq lst (cons (car (car alst)) lst))
|
|
|
501 (setq alst (cdr alst)))
|
|
|
502 lst))
|
|
|
503
|
|
|
504 ;; Filter ALIST using REGEXP. Return alist whose elements match the regexp.
|
|
|
505 (defun vip-filter-alist (regexp alst)
|
|
|
506 (interactive "s x")
|
|
|
507 (let ((outalst) (inalst alst))
|
|
|
508 (while (car inalst)
|
|
|
509 (if (string-match regexp (car (car inalst)))
|
|
|
510 (setq outalst (cons (car inalst) outalst)))
|
|
|
511 (setq inalst (cdr inalst)))
|
|
|
512 outalst))
|
|
|
513
|
|
|
514 ;; Filter LIST using REGEXP. Return list whose elements match the regexp.
|
|
|
515 (defun vip-filter-list (regexp lst)
|
|
|
516 (interactive "s x")
|
|
|
517 (let ((outlst) (inlst lst))
|
|
|
518 (while (car inlst)
|
|
|
519 (if (string-match regexp (car inlst))
|
|
|
520 (setq outlst (cons (car inlst) outlst)))
|
|
|
521 (setq inlst (cdr inlst)))
|
|
|
522 outlst))
|
|
|
523
|
|
|
524
|
|
|
525 ;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1
|
|
|
526 ;; LIS2 is modified by filtering it: deleting its members of the form
|
|
|
527 ;; \(car elt\) such that (car elt') is in LIS1.
|
|
|
528 (defun vip-append-filter-alist (lis1 lis2)
|
|
|
529 (let ((temp lis1)
|
|
|
530 elt)
|
|
|
531
|
|
|
532 ;;filter-append the second list
|
|
|
533 (while temp
|
|
|
534 ;; delete all occurrences
|
|
|
535 (while (setq elt (assoc (car (car temp)) lis2))
|
|
|
536 (setq lis2 (delq elt lis2)))
|
|
|
537 (setq temp (cdr temp)))
|
|
|
538
|
|
|
539 (nconc lis1 lis2)))
|
|
|
540
|
|
|
541
|
|
|
542 ;;; Support for :e and file globbing
|
|
|
543
|
|
|
544 (defun vip-ex-nontrivial-find-file-unix (filespec)
|
|
|
545 "Glob the file spec and visit all files matching the spec.
|
|
|
546 This function is designed to work under Unix. It may also work under VMS.
|
|
|
547
|
|
|
548 Users who prefer other types of shells should write their own version of this
|
|
|
549 function and set the variable `ex-nontrivial-find-file-function'
|
|
|
550 appropriately."
|
|
|
551 (let ((gshell
|
|
|
552 (cond (ex-unix-type-shell shell-file-name)
|
|
|
553 ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VAX VMS
|
|
|
554 (t "sh"))) ; probably Unix anyway
|
|
|
555 (gshell-options
|
|
|
556 ;; using cond in anticipation of further additions
|
|
|
557 (cond (ex-unix-type-shell-options)
|
|
|
558 ))
|
|
12
|
559 (command (cond (vip-ms-style-os-p (format "\"ls -1 -d %s\"" filespec))
|
|
|
560 (t (format "ls -1 -d %s" filespec))))
|
|
|
561 file-list status)
|
|
0
|
562 (save-excursion
|
|
12
|
563 (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
|
|
0
|
564 (erase-buffer)
|
|
|
565 (setq status
|
|
|
566 (if gshell-options
|
|
|
567 (call-process gshell nil t nil
|
|
|
568 gshell-options
|
|
|
569 "-c"
|
|
|
570 command)
|
|
|
571 (call-process gshell nil t nil
|
|
|
572 "-c"
|
|
|
573 command)))
|
|
|
574 (goto-char (point-min))
|
|
|
575 ;; Issue an error, if no match.
|
|
|
576 (if (> status 0)
|
|
|
577 (save-excursion
|
|
|
578 (skip-chars-forward " \t\n\j")
|
|
|
579 (if (looking-at "ls:")
|
|
|
580 (vip-forward-Word 1))
|
|
|
581 (error "%s: %s"
|
|
|
582 (if (stringp gshell)
|
|
|
583 gshell
|
|
|
584 "shell")
|
|
|
585 (buffer-substring (point) (vip-line-pos 'end)))
|
|
|
586 ))
|
|
|
587 (goto-char (point-min))
|
|
|
588 (setq file-list (vip-get-filenames-from-buffer 'one-per-line)))
|
|
|
589
|
|
|
590 (mapcar 'find-file file-list)
|
|
|
591 ))
|
|
|
592
|
|
|
593 (defun vip-ex-nontrivial-find-file-ms (filespec)
|
|
|
594 "Glob the file spec and visit all files matching the spec.
|
|
|
595 This function is designed to work under MS type systems, such as NT, W95, and
|
|
|
596 DOS. It may also work under OS/2.
|
|
|
597
|
|
|
598 The users of Unix-type shells should be able to use
|
|
|
599 `vip-ex-nontrivial-find-file-unix', making it into the value of the variable
|
|
|
600 `ex-nontrivial-find-file-function'. If this doesn't work, the user may have
|
|
|
601 to write a custom function, similar to `vip-ex-nontrivial-find-file-unix'."
|
|
|
602 (save-excursion
|
|
12
|
603 (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
|
|
0
|
604 (erase-buffer)
|
|
|
605 (insert filespec)
|
|
|
606 (goto-char (point-min))
|
|
|
607 (mapcar 'find-file
|
|
|
608 (vip-glob-ms-windows-files (vip-get-filenames-from-buffer)))
|
|
|
609 ))
|
|
|
610
|
|
|
611
|
|
|
612 ;; Interpret the stuff in the buffer as a list of file names
|
|
|
613 ;; return a list of file names listed in the buffer beginning at point
|
|
|
614 ;; If optional arg is supplied, assume each filename is listed on a separate
|
|
|
615 ;; line
|
|
12
|
616 (defun vip-get-filenames-from-buffer (&optional one-per-line)
|
|
0
|
617 (let ((skip-chars (if one-per-line "\t\n" " \t\n"))
|
|
|
618 result fname delim)
|
|
|
619 (skip-chars-forward skip-chars)
|
|
|
620 (while (not (eobp))
|
|
|
621 (if (cond ((looking-at "\"")
|
|
|
622 (setq delim ?\")
|
|
|
623 (re-search-forward "[^\"]+" nil t)) ; noerror
|
|
|
624 ((looking-at "'")
|
|
|
625 (setq delim ?')
|
|
|
626 (re-search-forward "[^']+" nil t)) ; noerror
|
|
|
627 (t
|
|
|
628 (re-search-forward
|
|
|
629 (concat "[^" skip-chars "]+") nil t))) ;noerror
|
|
|
630 (setq fname
|
|
|
631 (buffer-substring (match-beginning 0) (match-end 0))))
|
|
|
632 (if delim
|
|
|
633 (forward-char 1))
|
|
|
634 (skip-chars-forward " \t\n")
|
|
|
635 (setq result (cons fname result)))
|
|
|
636 result))
|
|
|
637
|
|
|
638 ;; convert MS-DOS wildcards to regexp
|
|
|
639 (defun vip-wildcard-to-regexp (wcard)
|
|
|
640 (save-excursion
|
|
12
|
641 (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
|
|
0
|
642 (erase-buffer)
|
|
|
643 (insert wcard)
|
|
|
644 (goto-char (point-min))
|
|
|
645 (while (not (eobp))
|
|
|
646 (skip-chars-forward "^*?.\\\\")
|
|
|
647 (cond ((eq (char-after (point)) ?*) (insert ".")(forward-char 1))
|
|
|
648 ((eq (char-after (point)) ?.) (insert "\\")(forward-char 1))
|
|
|
649 ((eq (char-after (point)) ?\\) (insert "\\")(forward-char 1))
|
|
|
650 ((eq (char-after (point)) ??) (delete-char 1)(insert ".")))
|
|
|
651 )
|
|
|
652 (buffer-string)
|
|
|
653 ))
|
|
|
654
|
|
|
655
|
|
|
656 ;; glob windows files
|
|
|
657 ;; LIST is expected to be in reverse order
|
|
|
658 (defun vip-glob-ms-windows-files (list)
|
|
|
659 (let ((tmp list)
|
|
|
660 (case-fold-search t)
|
|
|
661 tmp2)
|
|
|
662 (while tmp
|
|
|
663 (setq tmp2 (cons (directory-files
|
|
|
664 ;; the directory part
|
|
|
665 (or (file-name-directory (car tmp))
|
|
|
666 "")
|
|
|
667 t ; return full names
|
|
|
668 ;; the regexp part: globs the file names
|
|
|
669 (concat "^"
|
|
|
670 (vip-wildcard-to-regexp
|
|
|
671 (file-name-nondirectory (car tmp)))
|
|
|
672 "$"))
|
|
|
673 tmp2))
|
|
|
674 (setq tmp (cdr tmp)))
|
|
|
675 (reverse (apply 'append tmp2))))
|
|
|
676
|
|
12
|
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))
|
|
0
|
682
|
|
|
683
|
|
|
684
|
|
|
685 ;;; Insertion ring
|
|
|
686
|
|
|
687 ;; Rotate RING's index. DIRection can be positive or negative.
|
|
|
688 (defun vip-ring-rotate1 (ring dir)
|
|
|
689 (if (and (ring-p ring) (> (ring-length ring) 0))
|
|
|
690 (progn
|
|
|
691 (setcar ring (cond ((> dir 0)
|
|
|
692 (ring-plus1 (car ring) (ring-length ring)))
|
|
|
693 ((< dir 0)
|
|
|
694 (ring-minus1 (car ring) (ring-length ring)))
|
|
|
695 ;; don't rotate if dir = 0
|
|
|
696 (t (car ring))))
|
|
|
697 (vip-current-ring-item ring)
|
|
|
698 )))
|
|
|
699
|
|
|
700 (defun vip-special-ring-rotate1 (ring dir)
|
|
|
701 (if (memq vip-intermediate-command
|
|
|
702 '(repeating-display-destructive-command
|
|
|
703 repeating-insertion-from-ring))
|
|
|
704 (vip-ring-rotate1 ring dir)
|
|
|
705 ;; don't rotate otherwise
|
|
|
706 (vip-ring-rotate1 ring 0)))
|
|
|
707
|
|
|
708 ;; current ring item; if N is given, then so many items back from the
|
|
|
709 ;; current
|
|
|
710 (defun vip-current-ring-item (ring &optional n)
|
|
|
711 (setq n (or n 0))
|
|
|
712 (if (and (ring-p ring) (> (ring-length ring) 0))
|
|
|
713 (aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring)))))
|
|
|
714
|
|
|
715 ;; push item onto ring. the second argument is a ring-variable, not value.
|
|
|
716 (defun vip-push-onto-ring (item ring-var)
|
|
|
717 (or (ring-p (eval ring-var))
|
|
|
718 (set ring-var (make-ring (eval (intern (format "%S-size" ring-var))))))
|
|
|
719 (or (null item) ; don't push nil
|
|
|
720 (and (stringp item) (string= item "")) ; or empty strings
|
|
|
721 (equal item (vip-current-ring-item (eval ring-var))) ; or old stuff
|
|
|
722 ;; Since vip-set-destructive-command checks if we are inside vip-repeat,
|
|
|
723 ;; we don't check whether this-command-keys is a `.'.
|
|
|
724 ;; The cmd vip-repeat makes a call to the current function only if
|
|
|
725 ;; `.' is executing a command from the command history. It doesn't
|
|
|
726 ;; call the push-onto-ring function if `.' is simply repeating the
|
|
|
727 ;; last destructive command.
|
|
|
728 ;; We only check for ESC (which happens when we do insert with a
|
|
|
729 ;; prefix argument, or if this-command-keys doesn't give anything
|
|
|
730 ;; meaningful (in that case we don't know what to show to the user).
|
|
|
731 (and (eq ring-var 'vip-command-ring)
|
|
|
732 (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)"
|
|
|
733 (vip-array-to-string (this-command-keys))))
|
|
|
734 (vip-ring-insert (eval ring-var) item))
|
|
|
735 )
|
|
|
736
|
|
|
737
|
|
|
738 ;; removing elts from ring seems to break it
|
|
|
739 (defun vip-cleanup-ring (ring)
|
|
|
740 (or (< (ring-length ring) 2)
|
|
|
741 (null (vip-current-ring-item ring))
|
|
|
742 ;; last and previous equal
|
|
|
743 (if (equal (vip-current-ring-item ring) (vip-current-ring-item ring 1))
|
|
|
744 (vip-ring-pop ring))))
|
|
|
745
|
|
|
746 ;; ring-remove seems to be buggy, so we concocted this for our purposes.
|
|
|
747 (defun vip-ring-pop (ring)
|
|
|
748 (let* ((ln (ring-length ring))
|
|
|
749 (vec (cdr (cdr ring)))
|
|
|
750 (veclen (length vec))
|
|
|
751 (hd (car ring))
|
|
|
752 (idx (max 0 (ring-minus1 hd ln)))
|
|
|
753 (top-elt (aref vec idx)))
|
|
|
754
|
|
|
755 ;; shift elements
|
|
|
756 (while (< (1+ idx) veclen)
|
|
|
757 (aset vec idx (aref vec (1+ idx)))
|
|
|
758 (setq idx (1+ idx)))
|
|
|
759 (aset vec idx nil)
|
|
|
760
|
|
|
761 (setq hd (max 0 (ring-minus1 hd ln)))
|
|
|
762 (if (= hd (1- ln)) (setq hd 0))
|
|
|
763 (setcar ring hd) ; move head
|
|
|
764 (setcar (cdr ring) (max 0 (1- ln))) ; adjust length
|
|
|
765 top-elt
|
|
|
766 ))
|
|
|
767
|
|
|
768 (defun vip-ring-insert (ring item)
|
|
|
769 (let* ((ln (ring-length ring))
|
|
|
770 (vec (cdr (cdr ring)))
|
|
|
771 (veclen (length vec))
|
|
|
772 (hd (car ring))
|
|
|
773 (vecpos-after-hd (if (= hd 0) ln hd))
|
|
|
774 (idx ln))
|
|
|
775
|
|
|
776 (if (= ln veclen)
|
|
|
777 (progn
|
|
|
778 (aset vec hd item) ; hd is always 1+ the actual head index in vec
|
|
|
779 (setcar ring (ring-plus1 hd ln)))
|
|
|
780 (setcar (cdr ring) (1+ ln))
|
|
|
781 (setcar ring (ring-plus1 vecpos-after-hd (1+ ln)))
|
|
|
782 (while (and (>= idx vecpos-after-hd) (> ln 0))
|
|
|
783 (aset vec idx (aref vec (1- idx)))
|
|
|
784 (setq idx (1- idx)))
|
|
|
785 (aset vec vecpos-after-hd item))
|
|
|
786 item))
|
|
|
787
|
|
|
788
|
|
|
789 ;;; String utilities
|
|
|
790
|
|
|
791 ;; If STRING is longer than MAX-LEN, truncate it and print ...... instead
|
|
|
792 ;; PRE-STRING is a string to prepend to the abbrev string.
|
|
|
793 ;; POST-STRING is a string to append to the abbrev string.
|
|
|
794 ;; ABBREV_SIGN is a string to be inserted before POST-STRING
|
|
|
795 ;; if the orig string was truncated.
|
|
|
796 (defun vip-abbreviate-string (string max-len
|
|
|
797 pre-string post-string abbrev-sign)
|
|
|
798 (let (truncated-str)
|
|
|
799 (setq truncated-str
|
|
|
800 (if (stringp string)
|
|
|
801 (substring string 0 (min max-len (length string)))))
|
|
|
802 (cond ((null truncated-str) "")
|
|
|
803 ((> (length string) max-len)
|
|
|
804 (format "%s%s%s%s"
|
|
|
805 pre-string truncated-str abbrev-sign post-string))
|
|
|
806 (t (format "%s%s%s" pre-string truncated-str post-string)))))
|
|
|
807
|
|
|
808 ;; tells if we are over a whitespace-only line
|
|
|
809 (defsubst vip-over-whitespace-line ()
|
|
|
810 (save-excursion
|
|
|
811 (beginning-of-line)
|
|
|
812 (looking-at "^[ \t]*$")))
|
|
|
813
|
|
|
814
|
|
|
815 ;;; Saving settings in custom file
|
|
|
816
|
|
|
817 ;; Save the current setting of VAR in CUSTOM-FILE.
|
|
|
818 ;; If given, MESSAGE is a message to be displayed after that.
|
|
|
819 ;; This message is erased after 2 secs, if erase-msg is non-nil.
|
|
|
820 ;; Arguments: var message custom-file &optional erase-message
|
|
|
821 (defun vip-save-setting (var message custom-file &optional erase-msg)
|
|
|
822 (let* ((var-name (symbol-name var))
|
|
|
823 (var-val (if (boundp var) (eval var)))
|
|
|
824 (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name))
|
|
|
825 (buf (find-file-noselect (substitute-in-file-name custom-file)))
|
|
|
826 )
|
|
|
827 (message message)
|
|
|
828 (save-excursion
|
|
|
829 (set-buffer buf)
|
|
|
830 (goto-char (point-min))
|
|
|
831 (if (re-search-forward regexp nil t)
|
|
|
832 (let ((reg-end (1- (match-end 0))))
|
|
|
833 (search-backward var-name)
|
|
|
834 (delete-region (match-beginning 0) reg-end)
|
|
|
835 (goto-char (match-beginning 0))
|
|
|
836 (insert (format "%s '%S" var-name var-val)))
|
|
|
837 (goto-char (point-max))
|
|
|
838 (if (not (bolp)) (insert "\n"))
|
|
|
839 (insert (format "(setq %s '%S)\n" var-name var-val)))
|
|
|
840 (save-buffer))
|
|
|
841 (kill-buffer buf)
|
|
|
842 (if erase-msg
|
|
|
843 (progn
|
|
|
844 (sit-for 2)
|
|
|
845 (message "")))
|
|
|
846 ))
|
|
|
847
|
|
|
848 ;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that
|
|
|
849 ;; match this pattern.
|
|
|
850 (defun vip-save-string-in-file (string custom-file &optional pattern)
|
|
|
851 (let ((buf (find-file-noselect (substitute-in-file-name custom-file))))
|
|
|
852 (save-excursion
|
|
|
853 (set-buffer buf)
|
|
|
854 (goto-char (point-min))
|
|
|
855 (if pattern (delete-matching-lines pattern))
|
|
|
856 (goto-char (point-max))
|
|
|
857 (if string (insert string))
|
|
|
858 (save-buffer))
|
|
|
859 (kill-buffer buf)
|
|
|
860 ))
|
|
|
861
|
|
|
862
|
|
|
863 ;;; Overlays
|
|
|
864
|
|
|
865 ;; Search
|
|
|
866
|
|
|
867 (defun vip-flash-search-pattern ()
|
|
|
868 (if (vip-overlay-p vip-search-overlay)
|
|
|
869 (vip-move-overlay vip-search-overlay (match-beginning 0) (match-end 0))
|
|
|
870 (setq vip-search-overlay
|
|
|
871 (vip-make-overlay
|
|
|
872 (match-beginning 0) (match-end 0) (current-buffer))))
|
|
|
873
|
|
|
874 (vip-overlay-put vip-search-overlay 'priority vip-search-overlay-priority)
|
|
|
875 (if (vip-has-face-support-p)
|
|
|
876 (progn
|
|
|
877 (vip-overlay-put vip-search-overlay 'face vip-search-face)
|
|
|
878 (sit-for 2)
|
|
|
879 (vip-overlay-put vip-search-overlay 'face nil))))
|
|
|
880
|
|
12
|
881
|
|
0
|
882 ;; Replace state
|
|
|
883
|
|
|
884 (defsubst vip-move-replace-overlay (beg end)
|
|
|
885 (vip-move-overlay vip-replace-overlay beg end))
|
|
|
886
|
|
|
887 (defun vip-set-replace-overlay (beg end)
|
|
|
888 (if (vip-overlay-p vip-replace-overlay)
|
|
|
889 (vip-move-replace-overlay beg end)
|
|
|
890 (setq vip-replace-overlay (vip-make-overlay beg end (current-buffer)))
|
|
|
891 ;; never detach
|
|
|
892 (vip-overlay-put
|
|
|
893 vip-replace-overlay (if vip-emacs-p 'evaporate 'detachable) nil)
|
|
|
894 (vip-overlay-put
|
|
|
895 vip-replace-overlay 'priority vip-replace-overlay-priority))
|
|
|
896 (if (vip-has-face-support-p)
|
|
|
897 (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face))
|
|
|
898 (vip-save-cursor-color)
|
|
|
899 (vip-change-cursor-color vip-replace-overlay-cursor-color)
|
|
|
900 )
|
|
|
901
|
|
|
902
|
|
|
903 (defsubst vip-set-replace-overlay-glyphs (before-glyph after-glyph)
|
|
|
904 (if (or (not (vip-has-face-support-p))
|
|
|
905 vip-use-replace-region-delimiters)
|
|
|
906 (let ((before-name (if vip-xemacs-p 'begin-glyph 'before-string))
|
|
|
907 (after-name (if vip-xemacs-p 'end-glyph 'after-string)))
|
|
|
908 (vip-overlay-put vip-replace-overlay before-name before-glyph)
|
|
|
909 (vip-overlay-put vip-replace-overlay after-name after-glyph))))
|
|
|
910
|
|
|
911 (defsubst vip-hide-replace-overlay ()
|
|
|
912 (vip-set-replace-overlay-glyphs nil nil)
|
|
12
|
913 (vip-restore-cursor-color-after-replace)
|
|
|
914 (vip-restore-cursor-color-after-insert)
|
|
0
|
915 (if (vip-has-face-support-p)
|
|
|
916 (vip-overlay-put vip-replace-overlay 'face nil)))
|
|
|
917
|
|
|
918
|
|
|
919 (defsubst vip-replace-start ()
|
|
|
920 (vip-overlay-start vip-replace-overlay))
|
|
|
921 (defsubst vip-replace-end ()
|
|
|
922 (vip-overlay-end vip-replace-overlay))
|
|
|
923
|
|
|
924
|
|
|
925 ;; Minibuffer
|
|
|
926
|
|
|
927 (defun vip-set-minibuffer-overlay ()
|
|
|
928 (vip-check-minibuffer-overlay)
|
|
|
929 (if (vip-has-face-support-p)
|
|
|
930 (progn
|
|
|
931 (vip-overlay-put
|
|
|
932 vip-minibuffer-overlay 'face vip-minibuffer-current-face)
|
|
|
933 (vip-overlay-put
|
|
|
934 vip-minibuffer-overlay 'priority vip-minibuffer-overlay-priority)
|
|
|
935 ;; never detach
|
|
|
936 (vip-overlay-put
|
|
|
937 vip-minibuffer-overlay (if vip-emacs-p 'evaporate 'detachable) nil)
|
|
|
938 ;; make vip-minibuffer-overlay open-ended
|
|
|
939 ;; In emacs, it is made open ended at creation time
|
|
|
940 (if vip-xemacs-p
|
|
|
941 (progn
|
|
|
942 (vip-overlay-put vip-minibuffer-overlay 'start-open nil)
|
|
|
943 (vip-overlay-put vip-minibuffer-overlay 'end-open nil)))
|
|
|
944 )))
|
|
|
945
|
|
|
946 (defun vip-check-minibuffer-overlay ()
|
|
|
947 (or (vip-overlay-p vip-minibuffer-overlay)
|
|
|
948 (setq vip-minibuffer-overlay
|
|
|
949 (if vip-xemacs-p
|
|
|
950 (vip-make-overlay 1 (1+ (buffer-size)) (current-buffer))
|
|
|
951 ;; make overlay open-ended
|
|
|
952 (vip-make-overlay
|
|
|
953 1 (1+ (buffer-size)) (current-buffer) nil 'rear-advance)))
|
|
|
954 ))
|
|
|
955
|
|
|
956
|
|
|
957 (defsubst vip-is-in-minibuffer ()
|
|
|
958 (string-match "\*Minibuf-" (buffer-name)))
|
|
|
959
|
|
|
960
|
|
|
961
|
|
|
962 ;;; XEmacs compatibility
|
|
|
963
|
|
|
964 (defun vip-abbreviate-file-name (file)
|
|
|
965 (if vip-emacs-p
|
|
|
966 (abbreviate-file-name file)
|
|
|
967 ;; XEmacs requires addl argument
|
|
|
968 (abbreviate-file-name file t)))
|
|
|
969
|
|
|
970 ;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
|
|
|
971 ;; in sit-for, so this function smoothes out the differences.
|
|
|
972 (defsubst vip-sit-for-short (val &optional nodisp)
|
|
|
973 (if vip-xemacs-p
|
|
|
974 (sit-for (/ val 1000.0) nodisp)
|
|
|
975 (sit-for 0 val nodisp)))
|
|
|
976
|
|
|
977 ;; EVENT may be a single event of a sequence of events
|
|
|
978 (defsubst vip-ESC-event-p (event)
|
|
|
979 (let ((ESC-keys '(?\e (control \[) escape))
|
|
|
980 (key (vip-event-key event)))
|
|
|
981 (member key ESC-keys)))
|
|
|
982
|
|
|
983
|
|
|
984 (defsubst vip-mark-marker ()
|
|
|
985 (if vip-xemacs-p
|
|
|
986 (mark-marker t)
|
|
|
987 (mark-marker)))
|
|
|
988
|
|
|
989 ;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring)
|
|
|
990 ;; is the same as (mark t).
|
|
|
991 (defsubst vip-set-mark-if-necessary ()
|
|
|
992 (setq mark-ring (delete (vip-mark-marker) mark-ring))
|
|
|
993 (set-mark-command nil))
|
|
|
994
|
|
|
995 ;; In transient mark mode (zmacs mode), it is annoying when regions become
|
|
|
996 ;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless
|
|
|
997 ;; the user explicitly wants highlighting, e.g., by hitting '' or ``
|
|
|
998 (defun vip-deactivate-mark ()
|
|
|
999 (if vip-xemacs-p
|
|
|
1000 (zmacs-deactivate-region)
|
|
|
1001 (deactivate-mark)))
|
|
|
1002
|
|
|
1003 (defsubst vip-leave-region-active ()
|
|
|
1004 (if vip-xemacs-p
|
|
|
1005 (setq zmacs-region-stays t)))
|
|
|
1006
|
|
|
1007
|
|
|
1008 (defsubst vip-events-to-keys (events)
|
|
|
1009 (cond (vip-xemacs-p (events-to-keys events))
|
|
|
1010 (t events)))
|
|
|
1011
|
|
|
1012
|
|
|
1013 (defun vip-eval-after-load (file form)
|
|
|
1014 (if vip-emacs-p
|
|
|
1015 (eval-after-load file form)
|
|
|
1016 (or (assoc file after-load-alist)
|
|
|
1017 (setq after-load-alist (cons (list file) after-load-alist)))
|
|
|
1018 (let ((elt (assoc file after-load-alist)))
|
|
|
1019 (or (member form (cdr elt))
|
|
|
1020 (setq elt (nconc elt (list form)))))
|
|
|
1021 form
|
|
|
1022 ))
|
|
|
1023
|
|
|
1024 ;; This is here because Emacs changed the way local hooks work.
|
|
|
1025 ;;
|
|
|
1026 ;;Add to the value of HOOK the function FUNCTION.
|
|
|
1027 ;;FUNCTION is not added if already present.
|
|
|
1028 ;;FUNCTION is added (if necessary) at the beginning of the hook list
|
|
|
1029 ;;unless the optional argument APPEND is non-nil, in which case
|
|
|
1030 ;;FUNCTION is added at the end.
|
|
|
1031 ;;
|
|
|
1032 ;;HOOK should be a symbol, and FUNCTION may be any valid function. If
|
|
|
1033 ;;HOOK is void, it is first set to nil. If HOOK's value is a single
|
|
|
1034 ;;function, it is changed to a list of functions."
|
|
|
1035 (defun vip-add-hook (hook function &optional append)
|
|
|
1036 (if (not (boundp hook)) (set hook nil))
|
|
|
1037 ;; If the hook value is a single function, turn it into a list.
|
|
|
1038 (let ((old (symbol-value hook)))
|
|
|
1039 (if (or (not (listp old)) (eq (car old) 'lambda))
|
|
|
1040 (setq old (list old)))
|
|
|
1041 (if (member function old)
|
|
|
1042 nil
|
|
|
1043 (set hook (if append
|
|
|
1044 (append old (list function)) ; don't nconc
|
|
|
1045 (cons function old))))))
|
|
|
1046
|
|
|
1047 ;; This is here because of Emacs's changes in the semantics of add/remove-hooks
|
|
|
1048 ;; and due to the bugs they introduced.
|
|
|
1049 ;;
|
|
|
1050 ;; Remove from the value of HOOK the function FUNCTION.
|
|
|
1051 ;; HOOK should be a symbol, and FUNCTION may be any valid function. If
|
|
|
1052 ;; FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
|
|
|
1053 ;; list of hooks to run in HOOK, then nothing is done. See `vip-add-hook'."
|
|
|
1054 (defun vip-remove-hook (hook function)
|
|
|
1055 (if (or (not (boundp hook)) ;unbound symbol, or
|
|
|
1056 (null (symbol-value hook)) ;value is nil, or
|
|
|
1057 (null function)) ;function is nil, then
|
|
|
1058 nil ;Do nothing.
|
|
|
1059 (let ((hook-value (symbol-value hook)))
|
|
|
1060 (if (consp hook-value)
|
|
|
1061 ;; don't side-effect the list
|
|
|
1062 (setq hook-value (delete function (copy-sequence hook-value)))
|
|
|
1063 (if (equal hook-value function)
|
|
|
1064 (setq hook-value nil)))
|
|
|
1065 (set hook hook-value))))
|
|
|
1066
|
|
|
1067
|
|
14
|
1068 ;; it is suggested that an event must be copied before it is assigned to
|
|
|
1069 ;; last-command-event in XEmacs
|
|
|
1070 (defun vip-copy-event (event)
|
|
|
1071 (if vip-xemacs-p
|
|
|
1072 (copy-event event)
|
|
|
1073 event))
|
|
0
|
1074
|
|
|
1075 ;; like read-event, but in XEmacs also try to convert to char, if possible
|
|
|
1076 (defun vip-read-event-convert-to-char ()
|
|
|
1077 (let (event)
|
|
|
1078 (if vip-emacs-p
|
|
|
1079 (read-event)
|
|
|
1080 (setq event (next-command-event))
|
|
|
1081 (or (event-to-character event)
|
|
|
1082 event))
|
|
|
1083 ))
|
|
|
1084
|
|
|
1085 ;; This function lets function-key-map convert key sequences into logical
|
|
|
1086 ;; keys. This does a better job than vip-read-event when it comes to kbd
|
|
12
|
1087 ;; macros, since it enables certain macros to be shared between X and TTY modes
|
|
|
1088 ;; by correctly mapping key sequences for Left/Right/... (one an ascii
|
|
|
1089 ;; terminal) into logical keys left, right, etc.
|
|
0
|
1090 (defun vip-read-key ()
|
|
14
|
1091 (let ((overriding-local-map vip-overriding-map)
|
|
12
|
1092 (inhibit-quit t)
|
|
0
|
1093 key)
|
|
|
1094 (use-global-map vip-overriding-map)
|
|
|
1095 (setq key (elt (read-key-sequence nil) 0))
|
|
|
1096 (use-global-map global-map)
|
|
12
|
1097 key))
|
|
0
|
1098
|
|
|
1099
|
|
|
1100 ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil)
|
|
|
1101 ;; instead of nil, if '(nil) was previously inadvertently assigned to
|
|
|
1102 ;; unread-command-events
|
|
|
1103 (defun vip-event-key (event)
|
|
|
1104 (or (and event (eventp event))
|
|
|
1105 (error "vip-event-key: Wrong type argument, eventp, %S" event))
|
|
|
1106 (let ((mod (event-modifiers event))
|
|
|
1107 basis)
|
|
|
1108 (setq basis
|
|
|
1109 (cond
|
|
|
1110 (vip-xemacs-p
|
|
|
1111 (cond ((key-press-event-p event)
|
|
|
1112 (event-key event))
|
|
|
1113 ((button-event-p event)
|
|
|
1114 (concat "mouse-" (prin1-to-string (event-button event))))
|
|
|
1115 (t
|
|
|
1116 (error "vip-event-key: Unknown event, %S" event))))
|
|
|
1117 (t
|
|
|
1118 ;; Emacs doesn't handle capital letters correctly, since
|
|
|
1119 ;; \S-a isn't considered the same as A (it behaves as
|
|
|
1120 ;; plain `a' instead). So we take care of this here
|
|
|
1121 (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z))
|
|
|
1122 (setq mod nil
|
|
|
1123 event event))
|
|
|
1124 ;; Emacs has the oddity whereby characters 128+char
|
|
|
1125 ;; represent M-char *if* this appears inside a string.
|
|
|
1126 ;; So, we convert them manually to (meta char).
|
|
|
1127 ((and (vip-characterp event) (< ?\C-? event) (<= event 255))
|
|
|
1128 (setq mod '(meta)
|
|
|
1129 event (- event ?\C-? 1)))
|
|
|
1130 (t (event-basic-type event)))
|
|
|
1131 )))
|
|
|
1132 (if (vip-characterp basis)
|
|
|
1133 (setq basis
|
|
|
1134 (if (= basis ?\C-?)
|
|
|
1135 (list 'control '\?) ; taking care of an emacs bug
|
|
|
1136 (intern (char-to-string basis)))))
|
|
|
1137 (if mod
|
|
|
1138 (append mod (list basis))
|
|
|
1139 basis)))
|
|
|
1140
|
|
|
1141 (defun vip-key-to-emacs-key (key)
|
|
|
1142 (let (key-name char-p modifiers mod-char-list base-key base-key-name)
|
|
|
1143 (cond (vip-xemacs-p key)
|
|
|
1144 ((symbolp key)
|
|
|
1145 (setq key-name (symbol-name key))
|
|
|
1146 (if (= (length key-name) 1) ; character event
|
|
|
1147 (string-to-char key-name)
|
|
|
1148 key))
|
|
|
1149 ((listp key)
|
|
|
1150 (setq modifiers (subseq key 0 (1- (length key)))
|
|
|
1151 base-key (vip-seq-last-elt key)
|
|
|
1152 base-key-name (symbol-name base-key)
|
|
|
1153 char-p (= (length base-key-name) 1))
|
|
|
1154 (setq mod-char-list
|
|
|
1155 (mapcar
|
|
|
1156 '(lambda (elt) (upcase (substring (symbol-name elt) 0 1)))
|
|
|
1157 modifiers))
|
|
|
1158 (if char-p
|
|
|
1159 (setq key-name
|
|
|
1160 (car (read-from-string
|
|
|
1161 (concat
|
|
|
1162 "?\\"
|
|
|
1163 (mapconcat 'identity mod-char-list "-\\")
|
|
|
1164 "-"
|
|
|
1165 base-key-name))))
|
|
|
1166 (setq key-name
|
|
|
1167 (intern
|
|
|
1168 (concat
|
|
|
1169 (mapconcat 'identity mod-char-list "-")
|
|
|
1170 "-"
|
|
|
1171 base-key-name))))))
|
|
|
1172 ))
|
|
|
1173
|
|
|
1174
|
|
|
1175 ;; Args can be a sequence of events, a string, or a Viper macro. Will try to
|
|
|
1176 ;; convert events to keys and, if all keys are regular printable
|
|
|
1177 ;; characters, will return a string. Otherwise, will return a string
|
|
|
1178 ;; representing a vector of converted events. If the input was a Viper macro,
|
|
|
1179 ;; will return a string that represents this macro as a vector.
|
|
|
1180 (defun vip-array-to-string (event-seq)
|
|
|
1181 (let (temp temp2)
|
|
|
1182 (cond ((stringp event-seq) event-seq)
|
|
|
1183 ((vip-event-vector-p event-seq)
|
|
|
1184 (setq temp (mapcar 'vip-event-key event-seq))
|
|
|
1185 (cond ((vip-char-symbol-sequence-p temp)
|
|
|
1186 (mapconcat 'symbol-name temp ""))
|
|
|
1187 ((and (vip-char-array-p
|
|
|
1188 (setq temp2 (mapcar 'vip-key-to-character temp))))
|
|
|
1189 (mapconcat 'char-to-string temp2 ""))
|
|
|
1190 (t (prin1-to-string (vconcat temp)))))
|
|
|
1191 ((vip-char-symbol-sequence-p event-seq)
|
|
|
1192 (mapconcat 'symbol-name event-seq ""))
|
|
|
1193 ((and (vectorp event-seq)
|
|
|
1194 (vip-char-array-p
|
|
|
1195 (setq temp (mapcar 'vip-key-to-character event-seq))))
|
|
|
1196 (mapconcat 'char-to-string temp ""))
|
|
|
1197 (t (prin1-to-string event-seq)))))
|
|
|
1198
|
|
|
1199 (defun vip-key-press-events-to-chars (events)
|
|
|
1200 (mapconcat (if vip-emacs-p
|
|
|
1201 'char-to-string
|
|
|
1202 (function
|
|
|
1203 (lambda (elt) (char-to-string (event-to-character elt)))))
|
|
|
1204 events
|
|
|
1205 ""))
|
|
|
1206
|
|
|
1207
|
|
|
1208 (defsubst vip-fast-keysequence-p ()
|
|
|
1209 (not (vip-sit-for-short vip-fast-keyseq-timeout t)))
|
|
|
1210
|
|
|
1211 (defun vip-read-char-exclusive ()
|
|
|
1212 (let (char
|
|
|
1213 (echo-keystrokes 1))
|
|
|
1214 (while (null char)
|
|
|
1215 (condition-case nil
|
|
|
1216 (setq char (read-char))
|
|
|
1217 (error
|
|
|
1218 ;; skip event if not char
|
|
|
1219 (vip-read-event))))
|
|
|
1220 char))
|
|
|
1221
|
|
|
1222 ;; key is supposed to be in viper's representation, e.g., (control l), a
|
|
|
1223 ;; character, etc.
|
|
|
1224 (defun vip-key-to-character (key)
|
|
|
1225 (cond ((eq key 'space) ?\ )
|
|
|
1226 ((eq key 'delete) ?\C-?)
|
|
|
1227 ((eq key 'backspace) ?\C-h)
|
|
|
1228 ((and (symbolp key)
|
|
|
1229 (= 1 (length (symbol-name key))))
|
|
|
1230 (string-to-char (symbol-name key)))
|
|
|
1231 ((and (listp key)
|
|
|
1232 (eq (car key) 'control)
|
|
|
1233 (symbol-name (nth 1 key))
|
|
|
1234 (= 1 (length (symbol-name (nth 1 key)))))
|
|
|
1235 (read (format "?\\C-%s" (symbol-name (nth 1 key)))))
|
|
|
1236 (t key)))
|
|
|
1237
|
|
|
1238
|
|
|
1239 (defun vip-setup-master-buffer (&rest other-files-or-buffers)
|
|
|
1240 "Set up the current buffer as a master buffer.
|
|
|
1241 Arguments become related buffers. This function should normally be used in
|
|
|
1242 the `Local variables' section of a file."
|
|
|
1243 (setq vip-related-files-and-buffers-ring
|
|
|
1244 (make-ring (1+ (length other-files-or-buffers))))
|
|
|
1245 (mapcar '(lambda (elt)
|
|
|
1246 (vip-ring-insert vip-related-files-and-buffers-ring elt))
|
|
|
1247 other-files-or-buffers)
|
|
|
1248 (vip-ring-insert vip-related-files-and-buffers-ring (buffer-name))
|
|
|
1249 )
|
|
|
1250
|
|
|
1251 ;;; Movement utilities
|
|
|
1252
|
|
|
1253 (defvar vip-syntax-preference 'strict-vi
|
|
|
1254 "*Syntax type characterizing Viper's alphanumeric symbols.
|
|
|
1255 `emacs' means only word constituents are considered to be alphanumeric.
|
|
|
1256 Word constituents are symbols specified as word constituents by the current
|
|
|
1257 syntax table.
|
|
|
1258 `extended' means word and symbol constituents.
|
|
|
1259 `reformed-vi' means Vi-ish behavior: word constituents and the symbol `_'.
|
|
|
1260 However, word constituents are determined according to Emacs syntax tables,
|
|
|
1261 which may be different from Vi in some major modes.
|
|
|
1262 `strict-vi' means Viper words are exactly as in Vi.")
|
|
|
1263
|
|
|
1264 (vip-deflocalvar vip-ALPHA-char-class "w"
|
|
|
1265 "String of syntax classes characterizing Viper's alphanumeric symbols.
|
|
|
1266 In addition, the symbol `_' may be considered alphanumeric if
|
|
|
1267 `vip-syntax-preference'is `reformed-vi'.")
|
|
|
1268
|
|
|
1269 (vip-deflocalvar vip-strict-ALPHA-chars "a-zA-Z0-9_"
|
|
|
1270 "Regexp matching the set of alphanumeric characters acceptable to strict
|
|
|
1271 Vi.")
|
|
|
1272 (vip-deflocalvar vip-strict-SEP-chars " \t\n"
|
|
|
1273 "Regexp matching the set of alphanumeric characters acceptable to strict
|
|
|
1274 Vi.")
|
|
|
1275
|
|
|
1276 (vip-deflocalvar vip-SEP-char-class " -"
|
|
|
1277 "String of syntax classes for Vi separators.
|
|
|
1278 Usually contains ` ', linefeed, TAB or formfeed.")
|
|
|
1279
|
|
|
1280 (defun vip-update-alphanumeric-class ()
|
|
12
|
1281 "Set the syntax class of Viper alphanumerals according to `vip-syntax-preference'.
|
|
|
1282 Must be called in order for changes to `vip-syntax-preference' to take effect."
|
|
0
|
1283 (interactive)
|
|
|
1284 (setq-default
|
|
|
1285 vip-ALPHA-char-class
|
|
|
1286 (cond ((eq vip-syntax-preference 'emacs) "w") ; only word constituents
|
|
|
1287 ((eq vip-syntax-preference 'extended) "w_") ; word & symbol chars
|
|
|
1288 (t "w")))) ; vi syntax: word constituents and the symbol `_'
|
|
|
1289
|
|
|
1290 ;; addl-chars are characters to be temporarily considered as alphanumerical
|
|
|
1291 (defun vip-looking-at-alpha (&optional addl-chars)
|
|
|
1292 (or (stringp addl-chars) (setq addl-chars ""))
|
|
|
1293 (if (eq vip-syntax-preference 'reformed-vi)
|
|
|
1294 (setq addl-chars (concat addl-chars "_")))
|
|
|
1295 (let ((char (char-after (point))))
|
|
|
1296 (if char
|
|
|
1297 (if (eq vip-syntax-preference 'strict-vi)
|
|
|
1298 (looking-at (concat "[" vip-strict-ALPHA-chars addl-chars "]"))
|
|
|
1299 (or (memq char
|
|
|
1300 ;; convert string to list
|
|
|
1301 (append (vconcat addl-chars) nil))
|
|
|
1302 (memq (char-syntax char)
|
|
|
1303 (append (vconcat vip-ALPHA-char-class) nil)))))
|
|
|
1304 ))
|
|
|
1305
|
|
|
1306 (defsubst vip-looking-at-separator ()
|
|
|
1307 (let ((char (char-after (point))))
|
|
|
1308 (if char
|
|
|
1309 (or (eq char ?\n) ; RET is always a separator in Vi
|
|
|
1310 (memq (char-syntax char)
|
|
|
1311 (append (vconcat vip-SEP-char-class) nil))))))
|
|
|
1312
|
|
|
1313 (defsubst vip-looking-at-alphasep (&optional addl-chars)
|
|
|
1314 (or (vip-looking-at-separator) (vip-looking-at-alpha addl-chars)))
|
|
|
1315
|
|
|
1316 (defsubst vip-skip-alpha-forward (&optional addl-chars)
|
|
|
1317 (or (stringp addl-chars) (setq addl-chars ""))
|
|
|
1318 (vip-skip-syntax
|
|
|
1319 'forward
|
|
|
1320 (cond ((eq vip-syntax-preference 'strict-vi)
|
|
|
1321 "")
|
|
|
1322 (t vip-ALPHA-char-class ))
|
|
|
1323 (cond ((eq vip-syntax-preference 'strict-vi)
|
|
|
1324 (concat vip-strict-ALPHA-chars addl-chars))
|
|
|
1325 (t addl-chars))))
|
|
|
1326
|
|
|
1327 (defsubst vip-skip-alpha-backward (&optional addl-chars)
|
|
|
1328 (or (stringp addl-chars) (setq addl-chars ""))
|
|
|
1329 (vip-skip-syntax
|
|
|
1330 'backward
|
|
|
1331 (cond ((eq vip-syntax-preference 'strict-vi)
|
|
|
1332 "")
|
|
|
1333 (t vip-ALPHA-char-class ))
|
|
|
1334 (cond ((eq vip-syntax-preference 'strict-vi)
|
|
|
1335 (concat vip-strict-ALPHA-chars addl-chars))
|
|
|
1336 (t addl-chars))))
|
|
|
1337
|
|
|
1338 ;; weird syntax tables may confuse strict-vi style
|
|
|
1339 (defsubst vip-skip-all-separators-forward (&optional within-line)
|
|
|
1340 (vip-skip-syntax 'forward
|
|
|
1341 vip-SEP-char-class
|
|
|
1342 (or within-line "\n")
|
|
|
1343 (if within-line (vip-line-pos 'end))))
|
|
|
1344 (defsubst vip-skip-all-separators-backward (&optional within-line)
|
|
|
1345 (vip-skip-syntax 'backward
|
|
|
1346 vip-SEP-char-class
|
|
|
1347 (or within-line "\n")
|
|
|
1348 (if within-line (vip-line-pos 'start))))
|
|
|
1349 (defun vip-skip-nonseparators (direction)
|
|
|
1350 (let ((func (intern (format "skip-syntax-%S" direction))))
|
|
|
1351 (funcall func (concat "^" vip-SEP-char-class)
|
|
|
1352 (vip-line-pos (if (eq direction 'forward) 'end 'start)))))
|
|
|
1353
|
|
|
1354 (defsubst vip-skip-nonalphasep-forward ()
|
|
|
1355 (if (eq vip-syntax-preference 'strict-vi)
|
|
|
1356 (skip-chars-forward
|
|
|
1357 (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars))
|
|
|
1358 (skip-syntax-forward
|
|
|
1359 (concat
|
|
|
1360 "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'end))))
|
|
|
1361 (defsubst vip-skip-nonalphasep-backward ()
|
|
|
1362 (if (eq vip-syntax-preference 'strict-vi)
|
|
|
1363 (skip-chars-backward
|
|
|
1364 (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars))
|
|
|
1365 (skip-syntax-backward
|
|
|
1366 (concat
|
|
|
1367 "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'start))))
|
|
|
1368
|
|
|
1369 ;; Skip SYNTAX like skip-syntax-* and ADDL-CHARS like skip-chars-*
|
|
|
1370 ;; Return the number of chars traveled.
|
|
|
1371 ;; Either SYNTAX or ADDL-CHARS can be nil, in which case they are interpreted
|
|
|
1372 ;; as an empty string.
|
|
|
1373 (defun vip-skip-syntax (direction syntax addl-chars &optional limit)
|
|
|
1374 (let ((total 0)
|
|
|
1375 (local 1)
|
|
|
1376 (skip-chars-func (intern (format "skip-chars-%S" direction)))
|
|
|
1377 (skip-syntax-func (intern (format "skip-syntax-%S" direction))))
|
|
|
1378 (or (stringp addl-chars) (setq addl-chars ""))
|
|
|
1379 (or (stringp syntax) (setq syntax ""))
|
|
|
1380 (while (and (not (= local 0)) (not (eobp)))
|
|
|
1381 (setq local
|
|
|
1382 (+ (funcall skip-syntax-func syntax limit)
|
|
|
1383 (funcall skip-chars-func addl-chars limit)))
|
|
|
1384 (setq total (+ total local)))
|
|
|
1385 total
|
|
|
1386 ))
|
|
|
1387
|
|
|
1388
|
|
|
1389
|
|
|
1390
|
|
|
1391 (provide 'viper-util)
|
|
|
1392
|
|
|
1393 ;;; viper-util.el ends here
|
