|
0
|
1 ;;; viper-util.el --- Utilities used by viper.el
|
|
|
2
|
|
70
|
3 ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
|
|
0
|
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
|
|
70
|
25 (require 'ring)
|
|
|
26
|
|
0
|
27 ;; Compiler pacifier
|
|
|
28 (defvar vip-overriding-map)
|
|
|
29 (defvar pm-color-alist)
|
|
|
30 (defvar zmacs-region-stays)
|
|
70
|
31 (defvar vip-search-face)
|
|
0
|
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)
|
|
70
|
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)
|
|
0
|
43 (defvar vip-fast-keyseq-timeout)
|
|
70
|
44 (defvar vip-related-files-and-buffers-ring)
|
|
|
45 ;; end compiler pacifier
|
|
16
|
46
|
|
70
|
47 ;; Is it XEmacs?
|
|
|
48 (defconst vip-xemacs-p (string-match "\\(Lucid\\|XEmacs\\)" emacs-version))
|
|
|
49 ;; Is it Emacs?
|
|
|
50 (defconst vip-emacs-p (not vip-xemacs-p))
|
|
|
51 ;; Tell whether we are running as a window application or on a TTY
|
|
|
52 (defsubst vip-device-type ()
|
|
|
53 (if vip-emacs-p
|
|
|
54 window-system
|
|
|
55 (device-type (selected-device))))
|
|
|
56 ;; in XEmacs: device-type is tty on tty and stream in batch.
|
|
|
57 (defun vip-window-display-p ()
|
|
|
58 (and (vip-device-type) (not (memq (vip-device-type) '(tty stream)))))
|
|
0
|
59
|
|
70
|
60 (defvar vip-force-faces nil
|
|
|
61 "If t, Viper will think that it is running on a display that supports faces.
|
|
|
62 This is provided as a temporary relief for users of face-capable displays
|
|
|
63 that Viper doesn't know about.")
|
|
14
|
64
|
|
70
|
65 (defun vip-has-face-support-p ()
|
|
|
66 (cond ((vip-window-display-p))
|
|
|
67 (vip-force-faces)
|
|
|
68 (vip-emacs-p (memq (vip-device-type) '(pc)))
|
|
|
69 (vip-xemacs-p (memq (vip-device-type) '(tty pc)))))
|
|
14
|
70
|
|
|
71
|
|
70
|
72 ;;; Macros
|
|
|
73
|
|
|
74 (defmacro vip-deflocalvar (var default-value &optional documentation)
|
|
|
75 (` (progn
|
|
|
76 (defvar (, var) (, default-value)
|
|
|
77 (, (format "%s\n\(buffer local\)" documentation)))
|
|
|
78 (make-variable-buffer-local '(, var))
|
|
|
79 )))
|
|
|
80
|
|
|
81 (defmacro vip-loop (count body)
|
|
|
82 "(vip-loop COUNT BODY) Execute BODY COUNT times."
|
|
|
83 (list 'let (list (list 'count count))
|
|
|
84 (list 'while '(> count 0)
|
|
|
85 body
|
|
|
86 '(setq count (1- count))
|
|
|
87 )))
|
|
0
|
88
|
|
70
|
89 (defmacro vip-buffer-live-p (buf)
|
|
|
90 (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf))))))
|
|
|
91
|
|
|
92 ;; return buffer-specific macro definition, given a full macro definition
|
|
|
93 (defmacro vip-kbd-buf-alist (macro-elt)
|
|
|
94 (` (nth 1 (, macro-elt))))
|
|
|
95 ;; get a pair: (curr-buffer . macro-definition)
|
|
|
96 (defmacro vip-kbd-buf-pair (macro-elt)
|
|
|
97 (` (assoc (buffer-name) (vip-kbd-buf-alist (, macro-elt)))))
|
|
|
98 ;; get macro definition for current buffer
|
|
|
99 (defmacro vip-kbd-buf-definition (macro-elt)
|
|
|
100 (` (cdr (vip-kbd-buf-pair (, macro-elt)))))
|
|
|
101
|
|
|
102 ;; return mode-specific macro definitions, given a full macro definition
|
|
|
103 (defmacro vip-kbd-mode-alist (macro-elt)
|
|
|
104 (` (nth 2 (, macro-elt))))
|
|
|
105 ;; get a pair: (major-mode . macro-definition)
|
|
|
106 (defmacro vip-kbd-mode-pair (macro-elt)
|
|
|
107 (` (assoc major-mode (vip-kbd-mode-alist (, macro-elt)))))
|
|
|
108 ;; get macro definition for the current major mode
|
|
|
109 (defmacro vip-kbd-mode-definition (macro-elt)
|
|
|
110 (` (cdr (vip-kbd-mode-pair (, macro-elt)))))
|
|
|
111
|
|
|
112 ;; return global macro definition, given a full macro definition
|
|
|
113 (defmacro vip-kbd-global-pair (macro-elt)
|
|
|
114 (` (nth 3 (, macro-elt))))
|
|
|
115 ;; get global macro definition from an elt of macro-alist
|
|
|
116 (defmacro vip-kbd-global-definition (macro-elt)
|
|
|
117 (` (cdr (vip-kbd-global-pair (, macro-elt)))))
|
|
|
118
|
|
|
119 ;; last elt of a sequence
|
|
|
120 (defsubst vip-seq-last-elt (seq)
|
|
|
121 (elt seq (1- (length seq))))
|
|
|
122
|
|
|
123 ;; Check if arg is a valid character for register
|
|
|
124 ;; TYPE is a list that can contain `letter', `Letter', and `digit'.
|
|
|
125 ;; Letter means lowercase letters, Letter means uppercase letters, and
|
|
|
126 ;; digit means digits from 1 to 9.
|
|
|
127 ;; If TYPE is nil, then down/uppercase letters and digits are allowed.
|
|
|
128 (defun vip-valid-register (reg &optional type)
|
|
|
129 (or type (setq type '(letter Letter digit)))
|
|
|
130 (or (if (memq 'letter type)
|
|
|
131 (and (<= ?a reg) (<= reg ?z)))
|
|
|
132 (if (memq 'digit type)
|
|
|
133 (and (<= ?1 reg) (<= reg ?9)))
|
|
|
134 (if (memq 'Letter type)
|
|
|
135 (and (<= ?A reg) (<= reg ?Z)))
|
|
26
|
136 ))
|
|
70
|
137
|
|
|
138 ;; checks if object is a marker, has a buffer, and points to within that buffer
|
|
|
139 (defun vip-valid-marker (marker)
|
|
|
140 (if (and (markerp marker) (marker-buffer marker))
|
|
|
141 (let ((buf (marker-buffer marker))
|
|
|
142 (pos (marker-position marker)))
|
|
|
143 (save-excursion
|
|
|
144 (set-buffer buf)
|
|
|
145 (and (<= pos (point-max)) (<= (point-min) pos))))))
|
|
|
146
|
|
|
147
|
|
|
148 (defvar vip-minibuffer-overlay-priority 300)
|
|
|
149 (defvar vip-replace-overlay-priority 400)
|
|
|
150 (defvar vip-search-overlay-priority 500)
|
|
|
151
|
|
|
152
|
|
|
153 ;;; XEmacs support
|
|
26
|
154
|
|
0
|
155 (if vip-xemacs-p
|
|
|
156 (progn
|
|
|
157 (fset 'vip-read-event (symbol-function 'next-command-event))
|
|
|
158 (fset 'vip-make-overlay (symbol-function 'make-extent))
|
|
|
159 (fset 'vip-overlay-start (symbol-function 'extent-start-position))
|
|
|
160 (fset 'vip-overlay-end (symbol-function 'extent-end-position))
|
|
|
161 (fset 'vip-overlay-put (symbol-function 'set-extent-property))
|
|
|
162 (fset 'vip-overlay-p (symbol-function 'extentp))
|
|
|
163 (fset 'vip-overlay-get (symbol-function 'extent-property))
|
|
|
164 (fset 'vip-move-overlay (symbol-function 'set-extent-endpoints))
|
|
|
165 (if (vip-window-display-p)
|
|
|
166 (fset 'vip-iconify (symbol-function 'iconify-frame)))
|
|
|
167 (cond ((vip-has-face-support-p)
|
|
|
168 (fset 'vip-get-face (symbol-function 'get-face))
|
|
|
169 (fset 'vip-color-defined-p
|
|
|
170 (symbol-function 'valid-color-name-p))
|
|
|
171 )))
|
|
|
172 (fset 'vip-read-event (symbol-function 'read-event))
|
|
|
173 (fset 'vip-make-overlay (symbol-function 'make-overlay))
|
|
|
174 (fset 'vip-overlay-start (symbol-function 'overlay-start))
|
|
|
175 (fset 'vip-overlay-end (symbol-function 'overlay-end))
|
|
|
176 (fset 'vip-overlay-put (symbol-function 'overlay-put))
|
|
|
177 (fset 'vip-overlay-p (symbol-function 'overlayp))
|
|
|
178 (fset 'vip-overlay-get (symbol-function 'overlay-get))
|
|
|
179 (fset 'vip-move-overlay (symbol-function 'move-overlay))
|
|
|
180 (if (vip-window-display-p)
|
|
|
181 (fset 'vip-iconify (symbol-function 'iconify-or-deiconify-frame)))
|
|
|
182 (cond ((vip-has-face-support-p)
|
|
|
183 (fset 'vip-get-face (symbol-function 'internal-get-face))
|
|
|
184 (fset 'vip-color-defined-p (symbol-function 'x-color-defined-p))
|
|
|
185 )))
|
|
|
186
|
|
|
187 (fset 'vip-characterp
|
|
|
188 (symbol-function
|
|
|
189 (if vip-xemacs-p 'characterp 'integerp)))
|
|
|
190
|
|
|
191 (defsubst vip-color-display-p ()
|
|
|
192 (if vip-emacs-p
|
|
|
193 (x-display-color-p)
|
|
|
194 (eq (device-class (selected-device)) 'color)))
|
|
|
195
|
|
|
196 (defsubst vip-get-cursor-color ()
|
|
70
|
197 (cdr (assoc 'cursor-color (frame-parameters))))
|
|
0
|
198
|
|
|
199 ;; OS/2
|
|
|
200 (cond ((eq (vip-device-type) 'pm)
|
|
|
201 (fset 'vip-color-defined-p
|
|
|
202 (function (lambda (color) (assoc color pm-color-alist))))))
|
|
|
203
|
|
|
204 ;; needed to smooth out the difference between Emacs and XEmacs
|
|
|
205 (defsubst vip-italicize-face (face)
|
|
|
206 (if vip-xemacs-p
|
|
|
207 (make-face-italic face)
|
|
|
208 (make-face-italic face nil 'noerror)))
|
|
|
209
|
|
|
210 ;; test if display is color and the colors are defined
|
|
|
211 (defsubst vip-can-use-colors (&rest colors)
|
|
|
212 (if (vip-color-display-p)
|
|
|
213 (not (memq nil (mapcar 'vip-color-defined-p colors)))
|
|
|
214 ))
|
|
|
215
|
|
|
216 (defun vip-hide-face (face)
|
|
|
217 (if (and (vip-has-face-support-p) vip-emacs-p)
|
|
|
218 (add-to-list 'facemenu-unlisted-faces face)))
|
|
|
219
|
|
|
220 ;; cursor colors
|
|
|
221 (defun vip-change-cursor-color (new-color)
|
|
|
222 (if (and (vip-window-display-p) (vip-color-display-p)
|
|
|
223 (stringp new-color) (vip-color-defined-p new-color)
|
|
|
224 (not (string= new-color (vip-get-cursor-color))))
|
|
|
225 (modify-frame-parameters
|
|
|
226 (selected-frame) (list (cons 'cursor-color new-color)))))
|
|
|
227
|
|
70
|
228 (defsubst vip-save-cursor-color ()
|
|
0
|
229 (if (and (vip-window-display-p) (vip-color-display-p))
|
|
|
230 (let ((color (vip-get-cursor-color)))
|
|
|
231 (if (and (stringp color) (vip-color-defined-p color)
|
|
|
232 (not (string= color vip-replace-overlay-cursor-color)))
|
|
|
233 (vip-overlay-put vip-replace-overlay 'vip-cursor-color color)))))
|
|
|
234
|
|
70
|
235 (defsubst vip-restore-cursor-color ()
|
|
0
|
236 (vip-change-cursor-color
|
|
|
237 (vip-overlay-get vip-replace-overlay 'vip-cursor-color)))
|
|
14
|
238
|
|
0
|
239
|
|
|
240 ;; Check the current version against the major and minor version numbers
|
|
|
241 ;; using op: cur-vers op major.minor If emacs-major-version or
|
|
|
242 ;; emacs-minor-version are not defined, we assume that the current version
|
|
|
243 ;; is hopelessly outdated. We assume that emacs-major-version and
|
|
|
244 ;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the
|
|
|
245 ;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value
|
|
|
246 ;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be
|
|
|
247 ;; incorrect. However, this gives correct result in our cases, since we are
|
|
|
248 ;; testing for sufficiently high Emacs versions.
|
|
|
249 (defun vip-check-version (op major minor &optional type-of-emacs)
|
|
|
250 (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
|
|
|
251 (and (cond ((eq type-of-emacs 'xemacs) vip-xemacs-p)
|
|
|
252 ((eq type-of-emacs 'emacs) vip-emacs-p)
|
|
|
253 (t t))
|
|
|
254 (cond ((eq op '=) (and (= emacs-minor-version minor)
|
|
|
255 (= emacs-major-version major)))
|
|
|
256 ((memq op '(> >= < <=))
|
|
|
257 (and (or (funcall op emacs-major-version major)
|
|
|
258 (= emacs-major-version major))
|
|
|
259 (if (= emacs-major-version major)
|
|
|
260 (funcall op emacs-minor-version minor)
|
|
|
261 t)))
|
|
|
262 (t
|
|
|
263 (error "%S: Invalid op in vip-check-version" op))))
|
|
|
264 (cond ((memq op '(= > >=)) nil)
|
|
|
265 ((memq op '(< <=)) t))))
|
|
|
266
|
|
|
267 ;;;; warn if it is a wrong version of emacs
|
|
70
|
268 ;;(if (or (vip-check-version '< 19 29 'emacs)
|
|
|
269 ;; (vip-check-version '< 19 12 'xemacs))
|
|
0
|
270 ;; (progn
|
|
|
271 ;; (with-output-to-temp-buffer " *vip-info*"
|
|
|
272 ;; (switch-to-buffer " *vip-info*")
|
|
|
273 ;; (insert
|
|
|
274 ;; (format "
|
|
|
275 ;;
|
|
|
276 ;;This version of Viper requires
|
|
|
277 ;;
|
|
70
|
278 ;;\t Emacs 19.29 and higher
|
|
0
|
279 ;;\t OR
|
|
70
|
280 ;;\t XEmacs 19.12 and higher
|
|
0
|
281 ;;
|
|
|
282 ;;It is unlikely to work under Emacs version %s
|
|
|
283 ;;that you are using... " emacs-version))
|
|
|
284 ;;
|
|
|
285 ;; (if noninteractive
|
|
|
286 ;; ()
|
|
|
287 ;; (beep 1)
|
|
|
288 ;; (beep 1)
|
|
|
289 ;; (insert "\n\nType any key to continue... ")
|
|
|
290 ;; (vip-read-event)))
|
|
|
291 ;; (kill-buffer " *vip-info*")))
|
|
|
292
|
|
|
293
|
|
|
294 (defun vip-get-visible-buffer-window (wind)
|
|
|
295 (if vip-xemacs-p
|
|
|
296 (get-buffer-window wind t)
|
|
|
297 (get-buffer-window wind 'visible)))
|
|
|
298
|
|
|
299
|
|
|
300 ;; Return line position.
|
|
|
301 ;; If pos is 'start then returns position of line start.
|
|
|
302 ;; If pos is 'end, returns line end. If pos is 'mid, returns line center.
|
|
|
303 ;; Pos = 'indent returns beginning of indentation.
|
|
|
304 ;; Otherwise, returns point. Current point is not moved in any case."
|
|
|
305 (defun vip-line-pos (pos)
|
|
|
306 (let ((cur-pos (point))
|
|
|
307 (result))
|
|
|
308 (cond
|
|
|
309 ((equal pos 'start)
|
|
|
310 (beginning-of-line))
|
|
|
311 ((equal pos 'end)
|
|
|
312 (end-of-line))
|
|
|
313 ((equal pos 'mid)
|
|
|
314 (goto-char (+ (vip-line-pos 'start) (vip-line-pos 'end) 2)))
|
|
|
315 ((equal pos 'indent)
|
|
|
316 (back-to-indentation))
|
|
|
317 (t nil))
|
|
|
318 (setq result (point))
|
|
|
319 (goto-char cur-pos)
|
|
|
320 result))
|
|
|
321
|
|
|
322
|
|
|
323 ;; Like move-marker but creates a virgin marker if arg isn't already a marker.
|
|
|
324 ;; The first argument must eval to a variable name.
|
|
|
325 ;; Arguments: (var-name position &optional buffer).
|
|
|
326 ;;
|
|
|
327 ;; This is useful for moving markers that are supposed to be local.
|
|
|
328 ;; For this, VAR-NAME should be made buffer-local with nil as a default.
|
|
|
329 ;; Then, each time this var is used in `vip-move-marker-locally' in a new
|
|
|
330 ;; buffer, a new marker will be created.
|
|
|
331 (defun vip-move-marker-locally (var pos &optional buffer)
|
|
|
332 (if (markerp (eval var))
|
|
|
333 ()
|
|
|
334 (set var (make-marker)))
|
|
|
335 (move-marker (eval var) pos buffer))
|
|
|
336
|
|
|
337
|
|
|
338 ;; Print CONDITIONS as a message.
|
|
|
339 (defun vip-message-conditions (conditions)
|
|
|
340 (let ((case (car conditions)) (msg (cdr conditions)))
|
|
|
341 (if (null msg)
|
|
|
342 (message "%s" case)
|
|
|
343 (message "%s: %s" case (mapconcat 'prin1-to-string msg " ")))
|
|
|
344 (beep 1)))
|
|
|
345
|
|
|
346
|
|
|
347
|
|
|
348 ;;; List/alist utilities
|
|
|
349
|
|
|
350 ;; Convert LIST to an alist
|
|
|
351 (defun vip-list-to-alist (lst)
|
|
|
352 (let ((alist))
|
|
|
353 (while lst
|
|
|
354 (setq alist (cons (list (car lst)) alist))
|
|
|
355 (setq lst (cdr lst)))
|
|
|
356 alist))
|
|
|
357
|
|
|
358 ;; Convert ALIST to a list.
|
|
|
359 (defun vip-alist-to-list (alst)
|
|
|
360 (let ((lst))
|
|
|
361 (while alst
|
|
|
362 (setq lst (cons (car (car alst)) lst))
|
|
|
363 (setq alst (cdr alst)))
|
|
|
364 lst))
|
|
|
365
|
|
|
366 ;; Filter ALIST using REGEXP. Return alist whose elements match the regexp.
|
|
|
367 (defun vip-filter-alist (regexp alst)
|
|
|
368 (interactive "s x")
|
|
|
369 (let ((outalst) (inalst alst))
|
|
|
370 (while (car inalst)
|
|
|
371 (if (string-match regexp (car (car inalst)))
|
|
|
372 (setq outalst (cons (car inalst) outalst)))
|
|
|
373 (setq inalst (cdr inalst)))
|
|
|
374 outalst))
|
|
|
375
|
|
|
376 ;; Filter LIST using REGEXP. Return list whose elements match the regexp.
|
|
|
377 (defun vip-filter-list (regexp lst)
|
|
|
378 (interactive "s x")
|
|
|
379 (let ((outlst) (inlst lst))
|
|
|
380 (while (car inlst)
|
|
|
381 (if (string-match regexp (car inlst))
|
|
|
382 (setq outlst (cons (car inlst) outlst)))
|
|
|
383 (setq inlst (cdr inlst)))
|
|
|
384 outlst))
|
|
|
385
|
|
|
386
|
|
|
387 ;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1
|
|
|
388 ;; LIS2 is modified by filtering it: deleting its members of the form
|
|
|
389 ;; \(car elt\) such that (car elt') is in LIS1.
|
|
|
390 (defun vip-append-filter-alist (lis1 lis2)
|
|
|
391 (let ((temp lis1)
|
|
|
392 elt)
|
|
|
393
|
|
|
394 ;;filter-append the second list
|
|
|
395 (while temp
|
|
|
396 ;; delete all occurrences
|
|
|
397 (while (setq elt (assoc (car (car temp)) lis2))
|
|
|
398 (setq lis2 (delq elt lis2)))
|
|
|
399 (setq temp (cdr temp)))
|
|
|
400
|
|
|
401 (nconc lis1 lis2)))
|
|
|
402
|
|
|
403
|
|
|
404 ;;; Support for :e and file globbing
|
|
|
405
|
|
|
406 (defun vip-ex-nontrivial-find-file-unix (filespec)
|
|
|
407 "Glob the file spec and visit all files matching the spec.
|
|
|
408 This function is designed to work under Unix. It may also work under VMS.
|
|
|
409
|
|
|
410 Users who prefer other types of shells should write their own version of this
|
|
|
411 function and set the variable `ex-nontrivial-find-file-function'
|
|
|
412 appropriately."
|
|
|
413 (let ((gshell
|
|
|
414 (cond (ex-unix-type-shell shell-file-name)
|
|
|
415 ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VAX VMS
|
|
|
416 (t "sh"))) ; probably Unix anyway
|
|
|
417 (gshell-options
|
|
|
418 ;; using cond in anticipation of further additions
|
|
|
419 (cond (ex-unix-type-shell-options)
|
|
|
420 ))
|
|
70
|
421 (command (cond (vip-ms-style-os-p (format "\"ls -1 %s\"" filespec))
|
|
|
422 (t (format "ls -1 %s" filespec))))
|
|
|
423 file-list)
|
|
0
|
424 (save-excursion
|
|
70
|
425 (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
|
|
0
|
426 (erase-buffer)
|
|
|
427 (setq status
|
|
|
428 (if gshell-options
|
|
|
429 (call-process gshell nil t nil
|
|
|
430 gshell-options
|
|
|
431 "-c"
|
|
|
432 command)
|
|
|
433 (call-process gshell nil t nil
|
|
|
434 "-c"
|
|
|
435 command)))
|
|
|
436 (goto-char (point-min))
|
|
|
437 ;; Issue an error, if no match.
|
|
|
438 (if (> status 0)
|
|
|
439 (save-excursion
|
|
|
440 (skip-chars-forward " \t\n\j")
|
|
|
441 (if (looking-at "ls:")
|
|
|
442 (vip-forward-Word 1))
|
|
|
443 (error "%s: %s"
|
|
|
444 (if (stringp gshell)
|
|
|
445 gshell
|
|
|
446 "shell")
|
|
|
447 (buffer-substring (point) (vip-line-pos 'end)))
|
|
|
448 ))
|
|
|
449 (goto-char (point-min))
|
|
|
450 (setq file-list (vip-get-filenames-from-buffer 'one-per-line)))
|
|
|
451
|
|
|
452 (mapcar 'find-file file-list)
|
|
|
453 ))
|
|
|
454
|
|
|
455 (defun vip-ex-nontrivial-find-file-ms (filespec)
|
|
|
456 "Glob the file spec and visit all files matching the spec.
|
|
|
457 This function is designed to work under MS type systems, such as NT, W95, and
|
|
|
458 DOS. It may also work under OS/2.
|
|
|
459
|
|
|
460 The users of Unix-type shells should be able to use
|
|
|
461 `vip-ex-nontrivial-find-file-unix', making it into the value of the variable
|
|
|
462 `ex-nontrivial-find-file-function'. If this doesn't work, the user may have
|
|
|
463 to write a custom function, similar to `vip-ex-nontrivial-find-file-unix'."
|
|
|
464 (save-excursion
|
|
70
|
465 (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
|
|
0
|
466 (erase-buffer)
|
|
|
467 (insert filespec)
|
|
|
468 (goto-char (point-min))
|
|
|
469 (mapcar 'find-file
|
|
|
470 (vip-glob-ms-windows-files (vip-get-filenames-from-buffer)))
|
|
|
471 ))
|
|
|
472
|
|
|
473
|
|
|
474 ;; Interpret the stuff in the buffer as a list of file names
|
|
|
475 ;; return a list of file names listed in the buffer beginning at point
|
|
|
476 ;; If optional arg is supplied, assume each filename is listed on a separate
|
|
|
477 ;; line
|
|
70
|
478 (defun vip-get-filenames-from-buffer (one-per-line)
|
|
0
|
479 (let ((skip-chars (if one-per-line "\t\n" " \t\n"))
|
|
|
480 result fname delim)
|
|
|
481 (skip-chars-forward skip-chars)
|
|
|
482 (while (not (eobp))
|
|
|
483 (if (cond ((looking-at "\"")
|
|
|
484 (setq delim ?\")
|
|
|
485 (re-search-forward "[^\"]+" nil t)) ; noerror
|
|
|
486 ((looking-at "'")
|
|
|
487 (setq delim ?')
|
|
|
488 (re-search-forward "[^']+" nil t)) ; noerror
|
|
|
489 (t
|
|
|
490 (re-search-forward
|
|
|
491 (concat "[^" skip-chars "]+") nil t))) ;noerror
|
|
|
492 (setq fname
|
|
|
493 (buffer-substring (match-beginning 0) (match-end 0))))
|
|
|
494 (if delim
|
|
|
495 (forward-char 1))
|
|
|
496 (skip-chars-forward " \t\n")
|
|
|
497 (setq result (cons fname result)))
|
|
|
498 result))
|
|
|
499
|
|
|
500 ;; convert MS-DOS wildcards to regexp
|
|
|
501 (defun vip-wildcard-to-regexp (wcard)
|
|
|
502 (save-excursion
|
|
70
|
503 (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
|
|
0
|
504 (erase-buffer)
|
|
|
505 (insert wcard)
|
|
|
506 (goto-char (point-min))
|
|
|
507 (while (not (eobp))
|
|
|
508 (skip-chars-forward "^*?.\\\\")
|
|
|
509 (cond ((eq (char-after (point)) ?*) (insert ".")(forward-char 1))
|
|
|
510 ((eq (char-after (point)) ?.) (insert "\\")(forward-char 1))
|
|
|
511 ((eq (char-after (point)) ?\\) (insert "\\")(forward-char 1))
|
|
|
512 ((eq (char-after (point)) ??) (delete-char 1)(insert ".")))
|
|
|
513 )
|
|
|
514 (buffer-string)
|
|
|
515 ))
|
|
|
516
|
|
|
517
|
|
|
518 ;; glob windows files
|
|
|
519 ;; LIST is expected to be in reverse order
|
|
|
520 (defun vip-glob-ms-windows-files (list)
|
|
|
521 (let ((tmp list)
|
|
|
522 (case-fold-search t)
|
|
|
523 tmp2)
|
|
|
524 (while tmp
|
|
|
525 (setq tmp2 (cons (directory-files
|
|
|
526 ;; the directory part
|
|
|
527 (or (file-name-directory (car tmp))
|
|
|
528 "")
|
|
|
529 t ; return full names
|
|
|
530 ;; the regexp part: globs the file names
|
|
|
531 (concat "^"
|
|
|
532 (vip-wildcard-to-regexp
|
|
|
533 (file-name-nondirectory (car tmp)))
|
|
|
534 "$"))
|
|
|
535 tmp2))
|
|
|
536 (setq tmp (cdr tmp)))
|
|
|
537 (reverse (apply 'append tmp2))))
|
|
|
538
|
|
70
|
539
|
|
|
540
|
|
|
541
|
|
0
|
542
|
|
|
543 ;;; Insertion ring
|
|
|
544
|
|
|
545 ;; Rotate RING's index. DIRection can be positive or negative.
|
|
|
546 (defun vip-ring-rotate1 (ring dir)
|
|
|
547 (if (and (ring-p ring) (> (ring-length ring) 0))
|
|
|
548 (progn
|
|
|
549 (setcar ring (cond ((> dir 0)
|
|
|
550 (ring-plus1 (car ring) (ring-length ring)))
|
|
|
551 ((< dir 0)
|
|
|
552 (ring-minus1 (car ring) (ring-length ring)))
|
|
|
553 ;; don't rotate if dir = 0
|
|
|
554 (t (car ring))))
|
|
|
555 (vip-current-ring-item ring)
|
|
|
556 )))
|
|
|
557
|
|
|
558 (defun vip-special-ring-rotate1 (ring dir)
|
|
|
559 (if (memq vip-intermediate-command
|
|
|
560 '(repeating-display-destructive-command
|
|
|
561 repeating-insertion-from-ring))
|
|
|
562 (vip-ring-rotate1 ring dir)
|
|
|
563 ;; don't rotate otherwise
|
|
|
564 (vip-ring-rotate1 ring 0)))
|
|
|
565
|
|
|
566 ;; current ring item; if N is given, then so many items back from the
|
|
|
567 ;; current
|
|
|
568 (defun vip-current-ring-item (ring &optional n)
|
|
|
569 (setq n (or n 0))
|
|
|
570 (if (and (ring-p ring) (> (ring-length ring) 0))
|
|
|
571 (aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring)))))
|
|
|
572
|
|
|
573 ;; push item onto ring. the second argument is a ring-variable, not value.
|
|
|
574 (defun vip-push-onto-ring (item ring-var)
|
|
|
575 (or (ring-p (eval ring-var))
|
|
|
576 (set ring-var (make-ring (eval (intern (format "%S-size" ring-var))))))
|
|
|
577 (or (null item) ; don't push nil
|
|
|
578 (and (stringp item) (string= item "")) ; or empty strings
|
|
|
579 (equal item (vip-current-ring-item (eval ring-var))) ; or old stuff
|
|
|
580 ;; Since vip-set-destructive-command checks if we are inside vip-repeat,
|
|
|
581 ;; we don't check whether this-command-keys is a `.'.
|
|
|
582 ;; The cmd vip-repeat makes a call to the current function only if
|
|
|
583 ;; `.' is executing a command from the command history. It doesn't
|
|
|
584 ;; call the push-onto-ring function if `.' is simply repeating the
|
|
|
585 ;; last destructive command.
|
|
|
586 ;; We only check for ESC (which happens when we do insert with a
|
|
|
587 ;; prefix argument, or if this-command-keys doesn't give anything
|
|
|
588 ;; meaningful (in that case we don't know what to show to the user).
|
|
|
589 (and (eq ring-var 'vip-command-ring)
|
|
|
590 (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)"
|
|
|
591 (vip-array-to-string (this-command-keys))))
|
|
|
592 (vip-ring-insert (eval ring-var) item))
|
|
|
593 )
|
|
|
594
|
|
|
595
|
|
|
596 ;; removing elts from ring seems to break it
|
|
|
597 (defun vip-cleanup-ring (ring)
|
|
|
598 (or (< (ring-length ring) 2)
|
|
|
599 (null (vip-current-ring-item ring))
|
|
|
600 ;; last and previous equal
|
|
|
601 (if (equal (vip-current-ring-item ring) (vip-current-ring-item ring 1))
|
|
|
602 (vip-ring-pop ring))))
|
|
|
603
|
|
|
604 ;; ring-remove seems to be buggy, so we concocted this for our purposes.
|
|
|
605 (defun vip-ring-pop (ring)
|
|
|
606 (let* ((ln (ring-length ring))
|
|
|
607 (vec (cdr (cdr ring)))
|
|
|
608 (veclen (length vec))
|
|
|
609 (hd (car ring))
|
|
|
610 (idx (max 0 (ring-minus1 hd ln)))
|
|
|
611 (top-elt (aref vec idx)))
|
|
|
612
|
|
|
613 ;; shift elements
|
|
|
614 (while (< (1+ idx) veclen)
|
|
|
615 (aset vec idx (aref vec (1+ idx)))
|
|
|
616 (setq idx (1+ idx)))
|
|
|
617 (aset vec idx nil)
|
|
|
618
|
|
|
619 (setq hd (max 0 (ring-minus1 hd ln)))
|
|
|
620 (if (= hd (1- ln)) (setq hd 0))
|
|
|
621 (setcar ring hd) ; move head
|
|
|
622 (setcar (cdr ring) (max 0 (1- ln))) ; adjust length
|
|
|
623 top-elt
|
|
|
624 ))
|
|
|
625
|
|
|
626 (defun vip-ring-insert (ring item)
|
|
|
627 (let* ((ln (ring-length ring))
|
|
|
628 (vec (cdr (cdr ring)))
|
|
|
629 (veclen (length vec))
|
|
|
630 (hd (car ring))
|
|
|
631 (vecpos-after-hd (if (= hd 0) ln hd))
|
|
|
632 (idx ln))
|
|
|
633
|
|
|
634 (if (= ln veclen)
|
|
|
635 (progn
|
|
|
636 (aset vec hd item) ; hd is always 1+ the actual head index in vec
|
|
|
637 (setcar ring (ring-plus1 hd ln)))
|
|
|
638 (setcar (cdr ring) (1+ ln))
|
|
|
639 (setcar ring (ring-plus1 vecpos-after-hd (1+ ln)))
|
|
|
640 (while (and (>= idx vecpos-after-hd) (> ln 0))
|
|
|
641 (aset vec idx (aref vec (1- idx)))
|
|
|
642 (setq idx (1- idx)))
|
|
|
643 (aset vec vecpos-after-hd item))
|
|
|
644 item))
|
|
|
645
|
|
|
646
|
|
|
647 ;;; String utilities
|
|
|
648
|
|
|
649 ;; If STRING is longer than MAX-LEN, truncate it and print ...... instead
|
|
|
650 ;; PRE-STRING is a string to prepend to the abbrev string.
|
|
|
651 ;; POST-STRING is a string to append to the abbrev string.
|
|
|
652 ;; ABBREV_SIGN is a string to be inserted before POST-STRING
|
|
|
653 ;; if the orig string was truncated.
|
|
|
654 (defun vip-abbreviate-string (string max-len
|
|
|
655 pre-string post-string abbrev-sign)
|
|
|
656 (let (truncated-str)
|
|
|
657 (setq truncated-str
|
|
|
658 (if (stringp string)
|
|
|
659 (substring string 0 (min max-len (length string)))))
|
|
|
660 (cond ((null truncated-str) "")
|
|
|
661 ((> (length string) max-len)
|
|
|
662 (format "%s%s%s%s"
|
|
|
663 pre-string truncated-str abbrev-sign post-string))
|
|
|
664 (t (format "%s%s%s" pre-string truncated-str post-string)))))
|
|
|
665
|
|
|
666 ;; tells if we are over a whitespace-only line
|
|
|
667 (defsubst vip-over-whitespace-line ()
|
|
|
668 (save-excursion
|
|
|
669 (beginning-of-line)
|
|
|
670 (looking-at "^[ \t]*$")))
|
|
|
671
|
|
|
672
|
|
|
673 ;;; Saving settings in custom file
|
|
|
674
|
|
|
675 ;; Save the current setting of VAR in CUSTOM-FILE.
|
|
|
676 ;; If given, MESSAGE is a message to be displayed after that.
|
|
|
677 ;; This message is erased after 2 secs, if erase-msg is non-nil.
|
|
|
678 ;; Arguments: var message custom-file &optional erase-message
|
|
|
679 (defun vip-save-setting (var message custom-file &optional erase-msg)
|
|
|
680 (let* ((var-name (symbol-name var))
|
|
|
681 (var-val (if (boundp var) (eval var)))
|
|
|
682 (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name))
|
|
|
683 (buf (find-file-noselect (substitute-in-file-name custom-file)))
|
|
|
684 )
|
|
|
685 (message message)
|
|
|
686 (save-excursion
|
|
|
687 (set-buffer buf)
|
|
|
688 (goto-char (point-min))
|
|
|
689 (if (re-search-forward regexp nil t)
|
|
|
690 (let ((reg-end (1- (match-end 0))))
|
|
|
691 (search-backward var-name)
|
|
|
692 (delete-region (match-beginning 0) reg-end)
|
|
|
693 (goto-char (match-beginning 0))
|
|
|
694 (insert (format "%s '%S" var-name var-val)))
|
|
|
695 (goto-char (point-max))
|
|
|
696 (if (not (bolp)) (insert "\n"))
|
|
|
697 (insert (format "(setq %s '%S)\n" var-name var-val)))
|
|
|
698 (save-buffer))
|
|
|
699 (kill-buffer buf)
|
|
|
700 (if erase-msg
|
|
|
701 (progn
|
|
|
702 (sit-for 2)
|
|
|
703 (message "")))
|
|
|
704 ))
|
|
|
705
|
|
|
706 ;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that
|
|
|
707 ;; match this pattern.
|
|
|
708 (defun vip-save-string-in-file (string custom-file &optional pattern)
|
|
|
709 (let ((buf (find-file-noselect (substitute-in-file-name custom-file))))
|
|
|
710 (save-excursion
|
|
|
711 (set-buffer buf)
|
|
|
712 (goto-char (point-min))
|
|
|
713 (if pattern (delete-matching-lines pattern))
|
|
|
714 (goto-char (point-max))
|
|
|
715 (if string (insert string))
|
|
|
716 (save-buffer))
|
|
|
717 (kill-buffer buf)
|
|
|
718 ))
|
|
|
719
|
|
|
720
|
|
|
721 ;;; Overlays
|
|
|
722
|
|
|
723 ;; Search
|
|
|
724
|
|
|
725 (defun vip-flash-search-pattern ()
|
|
|
726 (if (vip-overlay-p vip-search-overlay)
|
|
|
727 (vip-move-overlay vip-search-overlay (match-beginning 0) (match-end 0))
|
|
|
728 (setq vip-search-overlay
|
|
|
729 (vip-make-overlay
|
|
|
730 (match-beginning 0) (match-end 0) (current-buffer))))
|
|
|
731
|
|
|
732 (vip-overlay-put vip-search-overlay 'priority vip-search-overlay-priority)
|
|
|
733 (if (vip-has-face-support-p)
|
|
|
734 (progn
|
|
|
735 (vip-overlay-put vip-search-overlay 'face vip-search-face)
|
|
|
736 (sit-for 2)
|
|
|
737 (vip-overlay-put vip-search-overlay 'face nil))))
|
|
|
738
|
|
|
739 ;; Replace state
|
|
|
740
|
|
|
741 (defsubst vip-move-replace-overlay (beg end)
|
|
|
742 (vip-move-overlay vip-replace-overlay beg end))
|
|
|
743
|
|
|
744 (defun vip-set-replace-overlay (beg end)
|
|
|
745 (if (vip-overlay-p vip-replace-overlay)
|
|
|
746 (vip-move-replace-overlay beg end)
|
|
|
747 (setq vip-replace-overlay (vip-make-overlay beg end (current-buffer)))
|
|
|
748 ;; never detach
|
|
|
749 (vip-overlay-put
|
|
|
750 vip-replace-overlay (if vip-emacs-p 'evaporate 'detachable) nil)
|
|
|
751 (vip-overlay-put
|
|
70
|
752 vip-replace-overlay 'priority vip-replace-overlay-priority))
|
|
0
|
753 (if (vip-has-face-support-p)
|
|
|
754 (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face))
|
|
|
755 (vip-save-cursor-color)
|
|
|
756 (vip-change-cursor-color vip-replace-overlay-cursor-color)
|
|
|
757 )
|
|
|
758
|
|
|
759
|
|
70
|
760 (defsubst vip-set-replace-overlay-glyphs (before-glyph after-glyph)
|
|
0
|
761 (if (or (not (vip-has-face-support-p))
|
|
|
762 vip-use-replace-region-delimiters)
|
|
|
763 (let ((before-name (if vip-xemacs-p 'begin-glyph 'before-string))
|
|
|
764 (after-name (if vip-xemacs-p 'end-glyph 'after-string)))
|
|
|
765 (vip-overlay-put vip-replace-overlay before-name before-glyph)
|
|
|
766 (vip-overlay-put vip-replace-overlay after-name after-glyph))))
|
|
|
767
|
|
70
|
768 (defsubst vip-hide-replace-overlay ()
|
|
0
|
769 (vip-set-replace-overlay-glyphs nil nil)
|
|
70
|
770 (vip-restore-cursor-color)
|
|
0
|
771 (if (vip-has-face-support-p)
|
|
|
772 (vip-overlay-put vip-replace-overlay 'face nil)))
|
|
|
773
|
|
|
774
|
|
|
775 (defsubst vip-replace-start ()
|
|
|
776 (vip-overlay-start vip-replace-overlay))
|
|
|
777 (defsubst vip-replace-end ()
|
|
|
778 (vip-overlay-end vip-replace-overlay))
|
|
|
779
|
|
|
780
|
|
|
781 ;; Minibuffer
|
|
|
782
|
|
|
783 (defun vip-set-minibuffer-overlay ()
|
|
|
784 (vip-check-minibuffer-overlay)
|
|
|
785 (if (vip-has-face-support-p)
|
|
|
786 (progn
|
|
|
787 (vip-overlay-put
|
|
|
788 vip-minibuffer-overlay 'face vip-minibuffer-current-face)
|
|
|
789 (vip-overlay-put
|
|
|
790 vip-minibuffer-overlay 'priority vip-minibuffer-overlay-priority)
|
|
|
791 ;; never detach
|
|
|
792 (vip-overlay-put
|
|
|
793 vip-minibuffer-overlay (if vip-emacs-p 'evaporate 'detachable) nil)
|
|
|
794 ;; make vip-minibuffer-overlay open-ended
|
|
|
795 ;; In emacs, it is made open ended at creation time
|
|
|
796 (if vip-xemacs-p
|
|
|
797 (progn
|
|
|
798 (vip-overlay-put vip-minibuffer-overlay 'start-open nil)
|
|
|
799 (vip-overlay-put vip-minibuffer-overlay 'end-open nil)))
|
|
|
800 )))
|
|
|
801
|
|
|
802 (defun vip-check-minibuffer-overlay ()
|
|
|
803 (or (vip-overlay-p vip-minibuffer-overlay)
|
|
|
804 (setq vip-minibuffer-overlay
|
|
|
805 (if vip-xemacs-p
|
|
|
806 (vip-make-overlay 1 (1+ (buffer-size)) (current-buffer))
|
|
|
807 ;; make overlay open-ended
|
|
|
808 (vip-make-overlay
|
|
|
809 1 (1+ (buffer-size)) (current-buffer) nil 'rear-advance)))
|
|
|
810 ))
|
|
|
811
|
|
|
812
|
|
|
813 (defsubst vip-is-in-minibuffer ()
|
|
|
814 (string-match "\*Minibuf-" (buffer-name)))
|
|
|
815
|
|
|
816
|
|
|
817
|
|
|
818 ;;; XEmacs compatibility
|
|
|
819
|
|
|
820 (defun vip-abbreviate-file-name (file)
|
|
|
821 (if vip-emacs-p
|
|
|
822 (abbreviate-file-name file)
|
|
|
823 ;; XEmacs requires addl argument
|
|
|
824 (abbreviate-file-name file t)))
|
|
|
825
|
|
|
826 ;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
|
|
|
827 ;; in sit-for, so this function smoothes out the differences.
|
|
|
828 (defsubst vip-sit-for-short (val &optional nodisp)
|
|
|
829 (if vip-xemacs-p
|
|
|
830 (sit-for (/ val 1000.0) nodisp)
|
|
|
831 (sit-for 0 val nodisp)))
|
|
|
832
|
|
|
833 ;; EVENT may be a single event of a sequence of events
|
|
|
834 (defsubst vip-ESC-event-p (event)
|
|
|
835 (let ((ESC-keys '(?\e (control \[) escape))
|
|
|
836 (key (vip-event-key event)))
|
|
|
837 (member key ESC-keys)))
|
|
70
|
838
|
|
0
|
839
|
|
|
840 (defsubst vip-mark-marker ()
|
|
|
841 (if vip-xemacs-p
|
|
|
842 (mark-marker t)
|
|
|
843 (mark-marker)))
|
|
|
844
|
|
|
845 ;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring)
|
|
|
846 ;; is the same as (mark t).
|
|
|
847 (defsubst vip-set-mark-if-necessary ()
|
|
|
848 (setq mark-ring (delete (vip-mark-marker) mark-ring))
|
|
|
849 (set-mark-command nil))
|
|
|
850
|
|
|
851 ;; In transient mark mode (zmacs mode), it is annoying when regions become
|
|
|
852 ;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless
|
|
|
853 ;; the user explicitly wants highlighting, e.g., by hitting '' or ``
|
|
|
854 (defun vip-deactivate-mark ()
|
|
|
855 (if vip-xemacs-p
|
|
|
856 (zmacs-deactivate-region)
|
|
|
857 (deactivate-mark)))
|
|
|
858
|
|
|
859 (defsubst vip-leave-region-active ()
|
|
|
860 (if vip-xemacs-p
|
|
|
861 (setq zmacs-region-stays t)))
|
|
|
862
|
|
|
863
|
|
|
864 (defsubst vip-events-to-keys (events)
|
|
|
865 (cond (vip-xemacs-p (events-to-keys events))
|
|
|
866 (t events)))
|
|
|
867
|
|
|
868
|
|
|
869 (defun vip-eval-after-load (file form)
|
|
|
870 (if vip-emacs-p
|
|
|
871 (eval-after-load file form)
|
|
|
872 (or (assoc file after-load-alist)
|
|
|
873 (setq after-load-alist (cons (list file) after-load-alist)))
|
|
|
874 (let ((elt (assoc file after-load-alist)))
|
|
|
875 (or (member form (cdr elt))
|
|
|
876 (setq elt (nconc elt (list form)))))
|
|
|
877 form
|
|
|
878 ))
|
|
|
879
|
|
|
880 ;; This is here because Emacs changed the way local hooks work.
|
|
|
881 ;;
|
|
|
882 ;;Add to the value of HOOK the function FUNCTION.
|
|
|
883 ;;FUNCTION is not added if already present.
|
|
|
884 ;;FUNCTION is added (if necessary) at the beginning of the hook list
|
|
|
885 ;;unless the optional argument APPEND is non-nil, in which case
|
|
|
886 ;;FUNCTION is added at the end.
|
|
|
887 ;;
|
|
|
888 ;;HOOK should be a symbol, and FUNCTION may be any valid function. If
|
|
|
889 ;;HOOK is void, it is first set to nil. If HOOK's value is a single
|
|
|
890 ;;function, it is changed to a list of functions."
|
|
|
891 (defun vip-add-hook (hook function &optional append)
|
|
|
892 (if (not (boundp hook)) (set hook nil))
|
|
|
893 ;; If the hook value is a single function, turn it into a list.
|
|
|
894 (let ((old (symbol-value hook)))
|
|
|
895 (if (or (not (listp old)) (eq (car old) 'lambda))
|
|
|
896 (setq old (list old)))
|
|
|
897 (if (member function old)
|
|
|
898 nil
|
|
|
899 (set hook (if append
|
|
|
900 (append old (list function)) ; don't nconc
|
|
|
901 (cons function old))))))
|
|
|
902
|
|
|
903 ;; This is here because of Emacs's changes in the semantics of add/remove-hooks
|
|
|
904 ;; and due to the bugs they introduced.
|
|
|
905 ;;
|
|
|
906 ;; Remove from the value of HOOK the function FUNCTION.
|
|
|
907 ;; HOOK should be a symbol, and FUNCTION may be any valid function. If
|
|
|
908 ;; FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
|
|
|
909 ;; list of hooks to run in HOOK, then nothing is done. See `vip-add-hook'."
|
|
|
910 (defun vip-remove-hook (hook function)
|
|
|
911 (if (or (not (boundp hook)) ;unbound symbol, or
|
|
|
912 (null (symbol-value hook)) ;value is nil, or
|
|
|
913 (null function)) ;function is nil, then
|
|
|
914 nil ;Do nothing.
|
|
|
915 (let ((hook-value (symbol-value hook)))
|
|
|
916 (if (consp hook-value)
|
|
|
917 ;; don't side-effect the list
|
|
|
918 (setq hook-value (delete function (copy-sequence hook-value)))
|
|
|
919 (if (equal hook-value function)
|
|
|
920 (setq hook-value nil)))
|
|
|
921 (set hook hook-value))))
|
|
|
922
|
|
|
923
|
|
|
924
|
|
|
925 ;; like read-event, but in XEmacs also try to convert to char, if possible
|
|
|
926 (defun vip-read-event-convert-to-char ()
|
|
|
927 (let (event)
|
|
|
928 (if vip-emacs-p
|
|
|
929 (read-event)
|
|
|
930 (setq event (next-command-event))
|
|
|
931 (or (event-to-character event)
|
|
|
932 event))
|
|
|
933 ))
|
|
|
934
|
|
|
935 ;; This function lets function-key-map convert key sequences into logical
|
|
|
936 ;; keys. This does a better job than vip-read-event when it comes to kbd
|
|
70
|
937 ;; macros, since it enables certain macros to be shared between X and TTY
|
|
|
938 ;; modes.
|
|
0
|
939 (defun vip-read-key ()
|
|
14
|
940 (let ((overriding-local-map vip-overriding-map)
|
|
0
|
941 key)
|
|
|
942 (use-global-map vip-overriding-map)
|
|
|
943 (setq key (elt (read-key-sequence nil) 0))
|
|
|
944 (use-global-map global-map)
|
|
70
|
945 key))
|
|
0
|
946
|
|
|
947
|
|
|
948 ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil)
|
|
|
949 ;; instead of nil, if '(nil) was previously inadvertently assigned to
|
|
|
950 ;; unread-command-events
|
|
|
951 (defun vip-event-key (event)
|
|
|
952 (or (and event (eventp event))
|
|
|
953 (error "vip-event-key: Wrong type argument, eventp, %S" event))
|
|
70
|
954 (let ((mod (event-modifiers event))
|
|
|
955 basis)
|
|
|
956 (setq basis
|
|
|
957 (cond
|
|
|
958 (vip-xemacs-p
|
|
|
959 (cond ((key-press-event-p event)
|
|
|
960 (event-key event))
|
|
|
961 ((button-event-p event)
|
|
|
962 (concat "mouse-" (prin1-to-string (event-button event))))
|
|
|
963 (t
|
|
|
964 (error "vip-event-key: Unknown event, %S" event))))
|
|
|
965 (t
|
|
|
966 ;; Emacs doesn't handle capital letters correctly, since
|
|
|
967 ;; \S-a isn't considered the same as A (it behaves as
|
|
|
968 ;; plain `a' instead). So we take care of this here
|
|
|
969 (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z))
|
|
|
970 (setq mod nil
|
|
|
971 event event))
|
|
|
972 ;; Emacs has the oddity whereby characters 128+char
|
|
|
973 ;; represent M-char *if* this appears inside a string.
|
|
|
974 ;; So, we convert them manually to (meta char).
|
|
|
975 ((and (vip-characterp event) (< ?\C-? event) (<= event 255))
|
|
|
976 (setq mod '(meta)
|
|
|
977 event (- event ?\C-? 1)))
|
|
|
978 (t (event-basic-type event)))
|
|
|
979 )))
|
|
|
980 (if (vip-characterp basis)
|
|
|
981 (setq basis
|
|
|
982 (if (= basis ?\C-?)
|
|
|
983 (list 'control '\?) ; taking care of an emacs bug
|
|
|
984 (intern (char-to-string basis)))))
|
|
|
985 (if mod
|
|
|
986 (append mod (list basis))
|
|
|
987 basis)))
|
|
0
|
988
|
|
|
989 (defun vip-key-to-emacs-key (key)
|
|
|
990 (let (key-name char-p modifiers mod-char-list base-key base-key-name)
|
|
|
991 (cond (vip-xemacs-p key)
|
|
|
992 ((symbolp key)
|
|
|
993 (setq key-name (symbol-name key))
|
|
|
994 (if (= (length key-name) 1) ; character event
|
|
|
995 (string-to-char key-name)
|
|
|
996 key))
|
|
|
997 ((listp key)
|
|
|
998 (setq modifiers (subseq key 0 (1- (length key)))
|
|
|
999 base-key (vip-seq-last-elt key)
|
|
|
1000 base-key-name (symbol-name base-key)
|
|
|
1001 char-p (= (length base-key-name) 1))
|
|
|
1002 (setq mod-char-list
|
|
|
1003 (mapcar
|
|
|
1004 '(lambda (elt) (upcase (substring (symbol-name elt) 0 1)))
|
|
|
1005 modifiers))
|
|
|
1006 (if char-p
|
|
|
1007 (setq key-name
|
|
|
1008 (car (read-from-string
|
|
|
1009 (concat
|
|
|
1010 "?\\"
|
|
|
1011 (mapconcat 'identity mod-char-list "-\\")
|
|
|
1012 "-"
|
|
|
1013 base-key-name))))
|
|
|
1014 (setq key-name
|
|
|
1015 (intern
|
|
|
1016 (concat
|
|
|
1017 (mapconcat 'identity mod-char-list "-")
|
|
|
1018 "-"
|
|
|
1019 base-key-name))))))
|
|
|
1020 ))
|
|
|
1021
|
|
|
1022
|
|
|
1023 ;; Args can be a sequence of events, a string, or a Viper macro. Will try to
|
|
|
1024 ;; convert events to keys and, if all keys are regular printable
|
|
|
1025 ;; characters, will return a string. Otherwise, will return a string
|
|
|
1026 ;; representing a vector of converted events. If the input was a Viper macro,
|
|
|
1027 ;; will return a string that represents this macro as a vector.
|
|
|
1028 (defun vip-array-to-string (event-seq)
|
|
|
1029 (let (temp temp2)
|
|
|
1030 (cond ((stringp event-seq) event-seq)
|
|
|
1031 ((vip-event-vector-p event-seq)
|
|
|
1032 (setq temp (mapcar 'vip-event-key event-seq))
|
|
|
1033 (cond ((vip-char-symbol-sequence-p temp)
|
|
|
1034 (mapconcat 'symbol-name temp ""))
|
|
|
1035 ((and (vip-char-array-p
|
|
|
1036 (setq temp2 (mapcar 'vip-key-to-character temp))))
|
|
|
1037 (mapconcat 'char-to-string temp2 ""))
|
|
|
1038 (t (prin1-to-string (vconcat temp)))))
|
|
|
1039 ((vip-char-symbol-sequence-p event-seq)
|
|
|
1040 (mapconcat 'symbol-name event-seq ""))
|
|
|
1041 ((and (vectorp event-seq)
|
|
|
1042 (vip-char-array-p
|
|
|
1043 (setq temp (mapcar 'vip-key-to-character event-seq))))
|
|
|
1044 (mapconcat 'char-to-string temp ""))
|
|
|
1045 (t (prin1-to-string event-seq)))))
|
|
|
1046
|
|
|
1047 (defun vip-key-press-events-to-chars (events)
|
|
|
1048 (mapconcat (if vip-emacs-p
|
|
|
1049 'char-to-string
|
|
|
1050 (function
|
|
|
1051 (lambda (elt) (char-to-string (event-to-character elt)))))
|
|
|
1052 events
|
|
|
1053 ""))
|
|
|
1054
|
|
|
1055
|
|
|
1056 (defsubst vip-fast-keysequence-p ()
|
|
|
1057 (not (vip-sit-for-short vip-fast-keyseq-timeout t)))
|
|
|
1058
|
|
|
1059 (defun vip-read-char-exclusive ()
|
|
|
1060 (let (char
|
|
|
1061 (echo-keystrokes 1))
|
|
|
1062 (while (null char)
|
|
|
1063 (condition-case nil
|
|
|
1064 (setq char (read-char))
|
|
|
1065 (error
|
|
|
1066 ;; skip event if not char
|
|
|
1067 (vip-read-event))))
|
|
|
1068 char))
|
|
|
1069
|
|
|
1070 ;; key is supposed to be in viper's representation, e.g., (control l), a
|
|
|
1071 ;; character, etc.
|
|
|
1072 (defun vip-key-to-character (key)
|
|
|
1073 (cond ((eq key 'space) ?\ )
|
|
|
1074 ((eq key 'delete) ?\C-?)
|
|
|
1075 ((eq key 'backspace) ?\C-h)
|
|
|
1076 ((and (symbolp key)
|
|
|
1077 (= 1 (length (symbol-name key))))
|
|
|
1078 (string-to-char (symbol-name key)))
|
|
|
1079 ((and (listp key)
|
|
|
1080 (eq (car key) 'control)
|
|
|
1081 (symbol-name (nth 1 key))
|
|
|
1082 (= 1 (length (symbol-name (nth 1 key)))))
|
|
|
1083 (read (format "?\\C-%s" (symbol-name (nth 1 key)))))
|
|
|
1084 (t key)))
|
|
|
1085
|
|
|
1086
|
|
|
1087 (defun vip-setup-master-buffer (&rest other-files-or-buffers)
|
|
|
1088 "Set up the current buffer as a master buffer.
|
|
|
1089 Arguments become related buffers. This function should normally be used in
|
|
|
1090 the `Local variables' section of a file."
|
|
|
1091 (setq vip-related-files-and-buffers-ring
|
|
|
1092 (make-ring (1+ (length other-files-or-buffers))))
|
|
|
1093 (mapcar '(lambda (elt)
|
|
|
1094 (vip-ring-insert vip-related-files-and-buffers-ring elt))
|
|
|
1095 other-files-or-buffers)
|
|
|
1096 (vip-ring-insert vip-related-files-and-buffers-ring (buffer-name))
|
|
|
1097 )
|
|
|
1098
|
|
|
1099 ;;; Movement utilities
|
|
|
1100
|
|
|
1101 (defvar vip-syntax-preference 'strict-vi
|
|
|
1102 "*Syntax type characterizing Viper's alphanumeric symbols.
|
|
|
1103 `emacs' means only word constituents are considered to be alphanumeric.
|
|
|
1104 Word constituents are symbols specified as word constituents by the current
|
|
|
1105 syntax table.
|
|
|
1106 `extended' means word and symbol constituents.
|
|
|
1107 `reformed-vi' means Vi-ish behavior: word constituents and the symbol `_'.
|
|
|
1108 However, word constituents are determined according to Emacs syntax tables,
|
|
|
1109 which may be different from Vi in some major modes.
|
|
|
1110 `strict-vi' means Viper words are exactly as in Vi.")
|
|
|
1111
|
|
|
1112 (vip-deflocalvar vip-ALPHA-char-class "w"
|
|
|
1113 "String of syntax classes characterizing Viper's alphanumeric symbols.
|
|
|
1114 In addition, the symbol `_' may be considered alphanumeric if
|
|
|
1115 `vip-syntax-preference'is `reformed-vi'.")
|
|
|
1116
|
|
|
1117 (vip-deflocalvar vip-strict-ALPHA-chars "a-zA-Z0-9_"
|
|
|
1118 "Regexp matching the set of alphanumeric characters acceptable to strict
|
|
|
1119 Vi.")
|
|
|
1120 (vip-deflocalvar vip-strict-SEP-chars " \t\n"
|
|
|
1121 "Regexp matching the set of alphanumeric characters acceptable to strict
|
|
|
1122 Vi.")
|
|
|
1123
|
|
|
1124 (vip-deflocalvar vip-SEP-char-class " -"
|
|
|
1125 "String of syntax classes for Vi separators.
|
|
|
1126 Usually contains ` ', linefeed, TAB or formfeed.")
|
|
|
1127
|
|
|
1128 (defun vip-update-alphanumeric-class ()
|
|
70
|
1129 "Set the syntactic class of Viper alphanumeric symbols according to
|
|
|
1130 the variable `vip-ALPHA-char-class'. Should be called in order for changes to
|
|
|
1131 `vip-ALPHA-char-class' to take effect."
|
|
0
|
1132 (interactive)
|
|
|
1133 (setq-default
|
|
|
1134 vip-ALPHA-char-class
|
|
|
1135 (cond ((eq vip-syntax-preference 'emacs) "w") ; only word constituents
|
|
|
1136 ((eq vip-syntax-preference 'extended) "w_") ; word & symbol chars
|
|
|
1137 (t "w")))) ; vi syntax: word constituents and the symbol `_'
|
|
|
1138
|
|
|
1139 ;; addl-chars are characters to be temporarily considered as alphanumerical
|
|
|
1140 (defun vip-looking-at-alpha (&optional addl-chars)
|
|
|
1141 (or (stringp addl-chars) (setq addl-chars ""))
|
|
|
1142 (if (eq vip-syntax-preference 'reformed-vi)
|
|
|
1143 (setq addl-chars (concat addl-chars "_")))
|
|
|
1144 (let ((char (char-after (point))))
|
|
|
1145 (if char
|
|
|
1146 (if (eq vip-syntax-preference 'strict-vi)
|
|
|
1147 (looking-at (concat "[" vip-strict-ALPHA-chars addl-chars "]"))
|
|
|
1148 (or (memq char
|
|
|
1149 ;; convert string to list
|
|
|
1150 (append (vconcat addl-chars) nil))
|
|
|
1151 (memq (char-syntax char)
|
|
|
1152 (append (vconcat vip-ALPHA-char-class) nil)))))
|
|
|
1153 ))
|
|
|
1154
|
|
70
|
1155 (defsubst vip-looking-at-separator ()
|
|
0
|
1156 (let ((char (char-after (point))))
|
|
|
1157 (if char
|
|
|
1158 (or (eq char ?\n) ; RET is always a separator in Vi
|
|
|
1159 (memq (char-syntax char)
|
|
|
1160 (append (vconcat vip-SEP-char-class) nil))))))
|
|
|
1161
|
|
|
1162 (defsubst vip-looking-at-alphasep (&optional addl-chars)
|
|
|
1163 (or (vip-looking-at-separator) (vip-looking-at-alpha addl-chars)))
|
|
|
1164
|
|
70
|
1165 (defsubst vip-skip-alpha-forward (&optional addl-chars)
|
|
0
|
1166 (or (stringp addl-chars) (setq addl-chars ""))
|
|
|
1167 (vip-skip-syntax
|
|
|
1168 'forward
|
|
|
1169 (cond ((eq vip-syntax-preference 'strict-vi)
|
|
|
1170 "")
|
|
|
1171 (t vip-ALPHA-char-class ))
|
|
|
1172 (cond ((eq vip-syntax-preference 'strict-vi)
|
|
|
1173 (concat vip-strict-ALPHA-chars addl-chars))
|
|
|
1174 (t addl-chars))))
|
|
|
1175
|
|
70
|
1176 (defsubst vip-skip-alpha-backward (&optional addl-chars)
|
|
0
|
1177 (or (stringp addl-chars) (setq addl-chars ""))
|
|
|
1178 (vip-skip-syntax
|
|
|
1179 'backward
|
|
|
1180 (cond ((eq vip-syntax-preference 'strict-vi)
|
|
|
1181 "")
|
|
|
1182 (t vip-ALPHA-char-class ))
|
|
|
1183 (cond ((eq vip-syntax-preference 'strict-vi)
|
|
|
1184 (concat vip-strict-ALPHA-chars addl-chars))
|
|
|
1185 (t addl-chars))))
|
|
|
1186
|
|
|
1187 ;; weird syntax tables may confuse strict-vi style
|
|
|
1188 (defsubst vip-skip-all-separators-forward (&optional within-line)
|
|
|
1189 (vip-skip-syntax 'forward
|
|
|
1190 vip-SEP-char-class
|
|
|
1191 (or within-line "\n")
|
|
|
1192 (if within-line (vip-line-pos 'end))))
|
|
|
1193 (defsubst vip-skip-all-separators-backward (&optional within-line)
|
|
|
1194 (vip-skip-syntax 'backward
|
|
|
1195 vip-SEP-char-class
|
|
|
1196 (or within-line "\n")
|
|
|
1197 (if within-line (vip-line-pos 'start))))
|
|
|
1198 (defun vip-skip-nonseparators (direction)
|
|
|
1199 (let ((func (intern (format "skip-syntax-%S" direction))))
|
|
|
1200 (funcall func (concat "^" vip-SEP-char-class)
|
|
|
1201 (vip-line-pos (if (eq direction 'forward) 'end 'start)))))
|
|
|
1202
|
|
70
|
1203 (defsubst vip-skip-nonalphasep-forward ()
|
|
0
|
1204 (if (eq vip-syntax-preference 'strict-vi)
|
|
|
1205 (skip-chars-forward
|
|
|
1206 (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars))
|
|
|
1207 (skip-syntax-forward
|
|
|
1208 (concat
|
|
|
1209 "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'end))))
|
|
70
|
1210 (defsubst vip-skip-nonalphasep-backward ()
|
|
0
|
1211 (if (eq vip-syntax-preference 'strict-vi)
|
|
|
1212 (skip-chars-backward
|
|
|
1213 (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars))
|
|
|
1214 (skip-syntax-backward
|
|
|
1215 (concat
|
|
|
1216 "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'start))))
|
|
|
1217
|
|
|
1218 ;; Skip SYNTAX like skip-syntax-* and ADDL-CHARS like skip-chars-*
|
|
|
1219 ;; Return the number of chars traveled.
|
|
|
1220 ;; Either SYNTAX or ADDL-CHARS can be nil, in which case they are interpreted
|
|
|
1221 ;; as an empty string.
|
|
|
1222 (defun vip-skip-syntax (direction syntax addl-chars &optional limit)
|
|
|
1223 (let ((total 0)
|
|
|
1224 (local 1)
|
|
|
1225 (skip-chars-func (intern (format "skip-chars-%S" direction)))
|
|
|
1226 (skip-syntax-func (intern (format "skip-syntax-%S" direction))))
|
|
|
1227 (or (stringp addl-chars) (setq addl-chars ""))
|
|
|
1228 (or (stringp syntax) (setq syntax ""))
|
|
|
1229 (while (and (not (= local 0)) (not (eobp)))
|
|
|
1230 (setq local
|
|
|
1231 (+ (funcall skip-syntax-func syntax limit)
|
|
|
1232 (funcall skip-chars-func addl-chars limit)))
|
|
|
1233 (setq total (+ total local)))
|
|
|
1234 total
|
|
|
1235 ))
|
|
|
1236
|
|
|
1237
|
|
|
1238
|
|
|
1239
|
|
|
1240 (provide 'viper-util)
|
|
|
1241
|
|
|
1242 ;;; viper-util.el ends here
|
