Commit | Line | Data |
---|---|---|
4960e757 | 1 | ;;; viper-util.el --- Utilities used by viper.el |
b578f267 | 2 | |
5fd6d89f | 3 | ;; Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, |
114f9c96 | 4 | ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
d6fd318f | 5 | |
50a07e18 | 6 | ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> |
02f34c70 | 7 | |
6c2e12f4 KH |
8 | ;; This file is part of GNU Emacs. |
9 | ||
ed0f493f | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
6c2e12f4 | 11 | ;; it under the terms of the GNU General Public License as published by |
ed0f493f GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
6c2e12f4 KH |
14 | |
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
ed0f493f | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
6c2e12f4 | 22 | |
60370d40 | 23 | ;;; Commentary: |
03fc1246 | 24 | |
60370d40 | 25 | ;;; Code: |
03fc1246 | 26 | |
2d84cc27 MK |
27 | (provide 'viper-util) |
28 | ||
29 | ||
03fc1246 | 30 | ;; Compiler pacifier |
8626cfa2 | 31 | (defvar viper-overriding-map) |
03fc1246 | 32 | (defvar pm-color-alist) |
8626cfa2 MK |
33 | (defvar viper-minibuffer-current-face) |
34 | (defvar viper-minibuffer-insert-face) | |
35 | (defvar viper-minibuffer-vi-face) | |
36 | (defvar viper-minibuffer-emacs-face) | |
37 | (defvar viper-replace-overlay-face) | |
38 | (defvar viper-fast-keyseq-timeout) | |
9b70a748 MK |
39 | (defvar ex-unix-type-shell) |
40 | (defvar ex-unix-type-shell-options) | |
8626cfa2 | 41 | (defvar viper-ex-tmp-buf-name) |
34317da2 | 42 | (defvar viper-syntax-preference) |
50a07e18 | 43 | (defvar viper-saved-mark) |
9b70a748 | 44 | |
9b70a748 MK |
45 | (require 'ring) |
46 | ||
acb93bb2 MK |
47 | (eval-and-compile |
48 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | |
49 | ||
9b70a748 MK |
50 | ;; end pacifier |
51 | ||
52 | (require 'viper-init) | |
ae37fce9 | 53 | |
6c2e12f4 | 54 | |
6c2e12f4 | 55 | \f |
c7218216 | 56 | (defalias 'viper-overlay-p |
e83d1fe8 | 57 | (if (featurep 'xemacs) 'extentp 'overlayp)) |
c7218216 | 58 | (defalias 'viper-make-overlay |
e83d1fe8 | 59 | (if (featurep 'xemacs) 'make-extent 'make-overlay)) |
c7218216 | 60 | (defalias 'viper-overlay-live-p |
e83d1fe8 | 61 | (if (featurep 'xemacs) 'extent-live-p 'overlayp)) |
c7218216 | 62 | (defalias 'viper-move-overlay |
e83d1fe8 | 63 | (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay)) |
c7218216 | 64 | (defalias 'viper-overlay-start |
e83d1fe8 | 65 | (if (featurep 'xemacs) 'extent-start-position 'overlay-start)) |
c7218216 | 66 | (defalias 'viper-overlay-end |
e83d1fe8 | 67 | (if (featurep 'xemacs) 'extent-end-position 'overlay-end)) |
c7218216 | 68 | (defalias 'viper-overlay-get |
e83d1fe8 | 69 | (if (featurep 'xemacs) 'extent-property 'overlay-get)) |
c7218216 | 70 | (defalias 'viper-overlay-put |
e83d1fe8 | 71 | (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) |
c7218216 | 72 | (defalias 'viper-read-event |
e83d1fe8 | 73 | (if (featurep 'xemacs) 'next-command-event 'read-event)) |
c7218216 | 74 | (defalias 'viper-characterp |
e83d1fe8 | 75 | (if (featurep 'xemacs) 'characterp 'integerp)) |
c7218216 | 76 | (defalias 'viper-int-to-char |
e83d1fe8 | 77 | (if (featurep 'xemacs) 'int-to-char 'identity)) |
c7218216 | 78 | (defalias 'viper-get-face |
e83d1fe8 | 79 | (if (featurep 'xemacs) 'get-face 'internal-get-face)) |
c7218216 | 80 | (defalias 'viper-color-defined-p |
e83d1fe8 DN |
81 | (if (featurep 'xemacs) 'valid-color-name-p 'x-color-defined-p)) |
82 | (defalias 'viper-iconify | |
83 | (if (featurep 'xemacs) 'iconify-frame 'iconify-or-deiconify-frame)) | |
50a07e18 | 84 | |
4960e757 | 85 | |
7d027816 MK |
86 | ;; CHAR is supposed to be a char or an integer (positive or negative) |
87 | ;; LIST is a list of chars, nil, and negative numbers | |
4960e757 | 88 | ;; Check if CHAR is a member by trying to convert in characters, if necessary. |
7d027816 MK |
89 | ;; Introduced for compatibility with XEmacs, where integers are not the same as |
90 | ;; chars. | |
657f9cb8 | 91 | (defun viper-memq-char (char list) |
4960e757 MK |
92 | (cond ((and (integerp char) (>= char 0)) |
93 | (memq (viper-int-to-char char) list)) | |
7d027816 | 94 | ((memq char list)))) |
657f9cb8 | 95 | |
4960e757 MK |
96 | ;; Check if char-or-int and char are the same as characters |
97 | (defun viper-char-equal (char-or-int char) | |
98 | (cond ((and (integerp char-or-int) (>= char-or-int 0)) | |
99 | (= (viper-int-to-char char-or-int) char)) | |
100 | ((eq char-or-int char)))) | |
101 | ||
657f9cb8 MK |
102 | ;; Like =, but accommodates null and also is t for eq-objects |
103 | (defun viper= (char char1) | |
104 | (cond ((eq char char1) t) | |
105 | ((and (viper-characterp char) (viper-characterp char1)) | |
106 | (= char char1)) | |
107 | (t nil))) | |
108 | ||
8626cfa2 | 109 | (defsubst viper-color-display-p () |
c7218216 GM |
110 | (if (featurep 'xemacs) (eq (device-class (selected-device)) 'color) |
111 | (x-display-color-p))) | |
a1506d29 | 112 | |
83f49acb | 113 | (defun viper-get-cursor-color (&optional frame) |
c7218216 GM |
114 | (if (featurep 'xemacs) |
115 | (color-instance-name | |
116 | (frame-property (or frame (selected-frame)) 'cursor-color)) | |
117 | (cdr (assoc 'cursor-color (frame-parameters))))) | |
118 | ||
119 | (defmacro viper-frame-value (variable) | |
120 | "Return the value of VARIABLE local to the current frame, if there is one. | |
121 | Otherwise return the normal value." | |
122 | `(if (featurep 'xemacs) | |
123 | ,variable | |
124 | ;; Frame-local variables are obsolete from Emacs 22.2 onwards, | |
125 | ;; so we do it by hand instead. | |
aba08fe5 GM |
126 | ;; Buffer-local values take precedence over frame-local ones. |
127 | (if (local-variable-p ',variable) | |
128 | ,variable | |
129 | ;; Distinguish between no frame parameter and a frame parameter | |
130 | ;; with a value of nil. | |
131 | (let ((fp (assoc ',variable (frame-parameters)))) | |
132 | (if fp (cdr fp) | |
133 | ,variable))))) | |
ab124470 | 134 | |
6c2e12f4 | 135 | ;; OS/2 |
8626cfa2 MK |
136 | (cond ((eq (viper-device-type) 'pm) |
137 | (fset 'viper-color-defined-p | |
3af0304a | 138 | (lambda (color) (assoc color pm-color-alist))))) |
a1506d29 | 139 | |
d3e1167f MK |
140 | |
141 | ;; cursor colors | |
83f49acb | 142 | (defun viper-change-cursor-color (new-color &optional frame) |
8626cfa2 MK |
143 | (if (and (viper-window-display-p) (viper-color-display-p) |
144 | (stringp new-color) (viper-color-defined-p new-color) | |
145 | (not (string= new-color (viper-get-cursor-color)))) | |
c7218216 GM |
146 | (if (featurep 'xemacs) |
147 | (set-frame-property | |
148 | (or frame (selected-frame)) | |
149 | 'cursor-color (make-color-instance new-color)) | |
150 | (modify-frame-parameters | |
151 | (or frame (selected-frame)) | |
152 | (list (cons 'cursor-color new-color)))))) | |
153 | ||
154 | ;; Note that the colors this function uses might not be those | |
155 | ;; associated with FRAME, if there are frame-local values. | |
156 | ;; This was equally true before the advent of viper-frame-value. | |
157 | ;; Now it could be changed by passing frame to v-f-v. | |
83f49acb MK |
158 | (defun viper-set-cursor-color-according-to-state (&optional frame) |
159 | (cond ((eq viper-current-state 'replace-state) | |
c7218216 GM |
160 | (viper-change-cursor-color |
161 | (viper-frame-value viper-replace-overlay-cursor-color) | |
162 | frame)) | |
83f49acb | 163 | ((and (eq viper-current-state 'emacs-state) |
c7218216 GM |
164 | (viper-frame-value viper-emacs-state-cursor-color)) |
165 | (viper-change-cursor-color | |
166 | (viper-frame-value viper-emacs-state-cursor-color) | |
167 | frame)) | |
83f49acb | 168 | ((eq viper-current-state 'insert-state) |
c7218216 GM |
169 | (viper-change-cursor-color |
170 | (viper-frame-value viper-insert-state-cursor-color) | |
171 | frame)) | |
83f49acb | 172 | (t |
c7218216 GM |
173 | (viper-change-cursor-color |
174 | (viper-frame-value viper-vi-state-cursor-color) | |
175 | frame)))) | |
83f49acb | 176 | |
433d9ace | 177 | ;; By default, saves current frame cursor color before changing viper state |
3af0304a | 178 | (defun viper-save-cursor-color (before-which-mode) |
8626cfa2 MK |
179 | (if (and (viper-window-display-p) (viper-color-display-p)) |
180 | (let ((color (viper-get-cursor-color))) | |
181 | (if (and (stringp color) (viper-color-defined-p color) | |
433d9ace MK |
182 | ;; there is something fishy in that the color is not saved if |
183 | ;; it is the same as frames default cursor color. need to be | |
184 | ;; checked. | |
c7218216 GM |
185 | (not (string= color |
186 | (viper-frame-value | |
187 | viper-replace-overlay-cursor-color)))) | |
3af0304a MK |
188 | (modify-frame-parameters |
189 | (selected-frame) | |
190 | (list | |
191 | (cons | |
b6178721 MK |
192 | (cond ((eq before-which-mode 'before-replace-mode) |
193 | 'viper-saved-cursor-color-in-replace-mode) | |
194 | ((eq before-which-mode 'before-emacs-mode) | |
195 | 'viper-saved-cursor-color-in-emacs-mode) | |
196 | (t | |
197 | 'viper-saved-cursor-color-in-insert-mode)) | |
c7218216 | 198 | color))))))) |
a1506d29 | 199 | |
3af0304a | 200 | |
42acc581 | 201 | (defun viper-get-saved-cursor-color-in-replace-mode () |
3af0304a MK |
202 | (or |
203 | (funcall | |
e83d1fe8 | 204 | (if (featurep 'emacs) 'frame-parameter 'frame-property) |
3af0304a MK |
205 | (selected-frame) |
206 | 'viper-saved-cursor-color-in-replace-mode) | |
2ee00512 MK |
207 | (or (and (eq viper-current-state 'emacs-mode) |
208 | (viper-frame-value viper-emacs-state-cursor-color)) | |
209 | (viper-frame-value viper-vi-state-cursor-color)))) | |
3af0304a | 210 | |
42acc581 | 211 | (defun viper-get-saved-cursor-color-in-insert-mode () |
3af0304a MK |
212 | (or |
213 | (funcall | |
e83d1fe8 | 214 | (if (featurep 'emacs) 'frame-parameter 'frame-property) |
3af0304a MK |
215 | (selected-frame) |
216 | 'viper-saved-cursor-color-in-insert-mode) | |
2ee00512 MK |
217 | (or (and (eq viper-current-state 'emacs-mode) |
218 | (viper-frame-value viper-emacs-state-cursor-color)) | |
219 | (viper-frame-value viper-vi-state-cursor-color)))) | |
b6178721 | 220 | |
42acc581 | 221 | (defun viper-get-saved-cursor-color-in-emacs-mode () |
b6178721 MK |
222 | (or |
223 | (funcall | |
e83d1fe8 | 224 | (if (featurep 'emacs) 'frame-parameter 'frame-property) |
b6178721 MK |
225 | (selected-frame) |
226 | 'viper-saved-cursor-color-in-emacs-mode) | |
c7218216 | 227 | (viper-frame-value viper-vi-state-cursor-color))) |
a1506d29 | 228 | |
3af0304a MK |
229 | ;; restore cursor color from replace overlay |
230 | (defun viper-restore-cursor-color(after-which-mode) | |
231 | (if (viper-overlay-p viper-replace-overlay) | |
232 | (viper-change-cursor-color | |
b6178721 MK |
233 | (cond ((eq after-which-mode 'after-replace-mode) |
234 | (viper-get-saved-cursor-color-in-replace-mode)) | |
235 | ((eq after-which-mode 'after-emacs-mode) | |
236 | (viper-get-saved-cursor-color-in-emacs-mode)) | |
237 | (t (viper-get-saved-cursor-color-in-insert-mode))) | |
3af0304a | 238 | ))) |
a1506d29 | 239 | |
9b70a748 | 240 | \f |
6c2e12f4 KH |
241 | ;; Check the current version against the major and minor version numbers |
242 | ;; using op: cur-vers op major.minor If emacs-major-version or | |
243 | ;; emacs-minor-version are not defined, we assume that the current version | |
244 | ;; is hopelessly outdated. We assume that emacs-major-version and | |
245 | ;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the | |
246 | ;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value | |
247 | ;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be | |
3af0304a | 248 | ;; incorrect. However, this gives correct result in our cases, since we are |
6c2e12f4 | 249 | ;; testing for sufficiently high Emacs versions. |
8626cfa2 | 250 | (defun viper-check-version (op major minor &optional type-of-emacs) |
6c2e12f4 | 251 | (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version)) |
e83d1fe8 DN |
252 | (and (cond ((eq type-of-emacs 'xemacs) (featurep 'xemacs)) |
253 | ((eq type-of-emacs 'emacs) (featurep 'emacs)) | |
6c2e12f4 KH |
254 | (t t)) |
255 | (cond ((eq op '=) (and (= emacs-minor-version minor) | |
256 | (= emacs-major-version major))) | |
257 | ((memq op '(> >= < <=)) | |
258 | (and (or (funcall op emacs-major-version major) | |
259 | (= emacs-major-version major)) | |
260 | (if (= emacs-major-version major) | |
261 | (funcall op emacs-minor-version minor) | |
262 | t))) | |
263 | (t | |
8626cfa2 | 264 | (error "%S: Invalid op in viper-check-version" op)))) |
6c2e12f4 KH |
265 | (cond ((memq op '(= > >=)) nil) |
266 | ((memq op '(< <=)) t)))) | |
a1506d29 | 267 | |
6c2e12f4 | 268 | |
8626cfa2 | 269 | (defun viper-get-visible-buffer-window (wind) |
e83d1fe8 | 270 | (if (featurep 'xemacs) |
6c2e12f4 KH |
271 | (get-buffer-window wind t) |
272 | (get-buffer-window wind 'visible))) | |
a1506d29 JB |
273 | |
274 | ||
75551c46 KH |
275 | ;; Return line position. |
276 | ;; If pos is 'start then returns position of line start. | |
3af0304a | 277 | ;; If pos is 'end, returns line end. If pos is 'mid, returns line center. |
75551c46 | 278 | ;; Pos = 'indent returns beginning of indentation. |
3af0304a | 279 | ;; Otherwise, returns point. Current point is not moved in any case." |
8626cfa2 | 280 | (defun viper-line-pos (pos) |
6c2e12f4 KH |
281 | (let ((cur-pos (point)) |
282 | (result)) | |
283 | (cond | |
284 | ((equal pos 'start) | |
285 | (beginning-of-line)) | |
286 | ((equal pos 'end) | |
287 | (end-of-line)) | |
288 | ((equal pos 'mid) | |
8626cfa2 | 289 | (goto-char (+ (viper-line-pos 'start) (viper-line-pos 'end) 2))) |
6c2e12f4 KH |
290 | ((equal pos 'indent) |
291 | (back-to-indentation)) | |
292 | (t nil)) | |
293 | (setq result (point)) | |
294 | (goto-char cur-pos) | |
295 | result)) | |
296 | ||
f3eabcdf MK |
297 | ;; Emacs used to count each multibyte character as several positions in the buffer, |
298 | ;; so we had to use Emacs' chars-in-region to count characters. Since 20.3, | |
299 | ;; Emacs counts multibyte characters as 1 position. XEmacs has always been | |
300 | ;; counting each char as just one pos. So, now we can simply subtract beg from | |
301 | ;; end to determine the number of characters in a region. | |
34317da2 | 302 | (defun viper-chars-in-region (beg end &optional preserve-sign) |
f3eabcdf MK |
303 | ;;(let ((count (abs (if (fboundp 'chars-in-region) |
304 | ;; (chars-in-region beg end) | |
305 | ;; (- end beg))))) | |
306 | (let ((count (abs (- end beg)))) | |
34317da2 MK |
307 | (if (and (< end beg) preserve-sign) |
308 | (- count) | |
309 | count))) | |
310 | ||
311 | ;; Test if POS is between BEG and END | |
312 | (defsubst viper-pos-within-region (pos beg end) | |
313 | (and (>= pos (min beg end)) (>= (max beg end) pos))) | |
314 | ||
6c2e12f4 | 315 | |
75551c46 KH |
316 | ;; Like move-marker but creates a virgin marker if arg isn't already a marker. |
317 | ;; The first argument must eval to a variable name. | |
318 | ;; Arguments: (var-name position &optional buffer). | |
a1506d29 | 319 | ;; |
75551c46 KH |
320 | ;; This is useful for moving markers that are supposed to be local. |
321 | ;; For this, VAR-NAME should be made buffer-local with nil as a default. | |
8626cfa2 | 322 | ;; Then, each time this var is used in `viper-move-marker-locally' in a new |
75551c46 | 323 | ;; buffer, a new marker will be created. |
8626cfa2 | 324 | (defun viper-move-marker-locally (var pos &optional buffer) |
6c2e12f4 KH |
325 | (if (markerp (eval var)) |
326 | () | |
327 | (set var (make-marker))) | |
328 | (move-marker (eval var) pos buffer)) | |
329 | ||
330 | ||
75551c46 | 331 | ;; Print CONDITIONS as a message. |
8626cfa2 | 332 | (defun viper-message-conditions (conditions) |
6c2e12f4 KH |
333 | (let ((case (car conditions)) (msg (cdr conditions))) |
334 | (if (null msg) | |
335 | (message "%s" case) | |
336 | (message "%s: %s" case (mapconcat 'prin1-to-string msg " "))) | |
337 | (beep 1))) | |
338 | ||
75551c46 | 339 | |
6c2e12f4 KH |
340 | \f |
341 | ;;; List/alist utilities | |
a1506d29 | 342 | |
75551c46 | 343 | ;; Convert LIST to an alist |
8626cfa2 | 344 | (defun viper-list-to-alist (lst) |
6c2e12f4 KH |
345 | (let ((alist)) |
346 | (while lst | |
347 | (setq alist (cons (list (car lst)) alist)) | |
348 | (setq lst (cdr lst))) | |
a1506d29 | 349 | alist)) |
6c2e12f4 | 350 | |
75551c46 | 351 | ;; Convert ALIST to a list. |
8626cfa2 | 352 | (defun viper-alist-to-list (alst) |
6c2e12f4 KH |
353 | (let ((lst)) |
354 | (while alst | |
355 | (setq lst (cons (car (car alst)) lst)) | |
356 | (setq alst (cdr alst))) | |
357 | lst)) | |
358 | ||
3af0304a | 359 | ;; Filter ALIST using REGEXP. Return alist whose elements match the regexp. |
8626cfa2 | 360 | (defun viper-filter-alist (regexp alst) |
6c2e12f4 KH |
361 | (interactive "s x") |
362 | (let ((outalst) (inalst alst)) | |
363 | (while (car inalst) | |
364 | (if (string-match regexp (car (car inalst))) | |
365 | (setq outalst (cons (car inalst) outalst))) | |
366 | (setq inalst (cdr inalst))) | |
a1506d29 JB |
367 | outalst)) |
368 | ||
3af0304a | 369 | ;; Filter LIST using REGEXP. Return list whose elements match the regexp. |
8626cfa2 | 370 | (defun viper-filter-list (regexp lst) |
6c2e12f4 KH |
371 | (interactive "s x") |
372 | (let ((outlst) (inlst lst)) | |
373 | (while (car inlst) | |
374 | (if (string-match regexp (car inlst)) | |
375 | (setq outlst (cons (car inlst) outlst))) | |
376 | (setq inlst (cdr inlst))) | |
a1506d29 JB |
377 | outlst)) |
378 | ||
6c2e12f4 | 379 | |
6c2e12f4 KH |
380 | ;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1 |
381 | ;; LIS2 is modified by filtering it: deleting its members of the form | |
382 | ;; \(car elt\) such that (car elt') is in LIS1. | |
8626cfa2 | 383 | (defun viper-append-filter-alist (lis1 lis2) |
6c2e12f4 KH |
384 | (let ((temp lis1) |
385 | elt) | |
6c2e12f4 KH |
386 | ;;filter-append the second list |
387 | (while temp | |
388 | ;; delete all occurrences | |
389 | (while (setq elt (assoc (car (car temp)) lis2)) | |
390 | (setq lis2 (delq elt lis2))) | |
391 | (setq temp (cdr temp))) | |
a1506d29 | 392 | |
38685583 | 393 | (append lis1 lis2))) |
bbe6126c | 394 | |
4986c2c6 | 395 | |
bbe6126c | 396 | \f |
acb93bb2 | 397 | (declare-function viper-forward-Word "viper-cmd" (arg)) |
153ef845 | 398 | |
3af0304a | 399 | ;;; Support for :e, :r, :w file globbing |
bbe6126c | 400 | |
3af0304a | 401 | ;; Glob the file spec. |
7c2fb837 | 402 | ;; This function is designed to work under Unix. |
3af0304a | 403 | (defun viper-glob-unix-files (filespec) |
bbe6126c MK |
404 | (let ((gshell |
405 | (cond (ex-unix-type-shell shell-file-name) | |
bbe6126c MK |
406 | (t "sh"))) ; probably Unix anyway |
407 | (gshell-options | |
408 | ;; using cond in anticipation of further additions | |
409 | (cond (ex-unix-type-shell-options) | |
410 | )) | |
8626cfa2 | 411 | (command (cond (viper-ms-style-os-p (format "\"ls -1 -d %s\"" filespec)) |
ab124470 | 412 | (t (format "ls -1 -d %s" filespec)))) |
3af0304a | 413 | status) |
937e6a56 | 414 | (with-current-buffer (get-buffer-create viper-ex-tmp-buf-name) |
bbe6126c MK |
415 | (erase-buffer) |
416 | (setq status | |
417 | (if gshell-options | |
418 | (call-process gshell nil t nil | |
419 | gshell-options | |
420 | "-c" | |
421 | command) | |
422 | (call-process gshell nil t nil | |
423 | "-c" | |
424 | command))) | |
425 | (goto-char (point-min)) | |
426 | ;; Issue an error, if no match. | |
15502042 EZ |
427 | (unless (eq 0 status) |
428 | (save-excursion | |
429 | (skip-chars-forward " \t\n\j") | |
430 | (if (looking-at "ls:") | |
431 | (viper-forward-Word 1)) | |
432 | (error "%s: %s" | |
433 | (if (stringp gshell) | |
434 | gshell | |
435 | "shell") | |
436 | (buffer-substring (point) (viper-line-pos 'end))) | |
437 | )) | |
bbe6126c | 438 | (goto-char (point-min)) |
3af0304a | 439 | (viper-get-filenames-from-buffer 'one-per-line)) |
bbe6126c MK |
440 | )) |
441 | ||
442 | ||
443 | ;; Interpret the stuff in the buffer as a list of file names | |
444 | ;; return a list of file names listed in the buffer beginning at point | |
445 | ;; If optional arg is supplied, assume each filename is listed on a separate | |
446 | ;; line | |
8626cfa2 | 447 | (defun viper-get-filenames-from-buffer (&optional one-per-line) |
bbe6126c MK |
448 | (let ((skip-chars (if one-per-line "\t\n" " \t\n")) |
449 | result fname delim) | |
450 | (skip-chars-forward skip-chars) | |
451 | (while (not (eobp)) | |
452 | (if (cond ((looking-at "\"") | |
453 | (setq delim ?\") | |
454 | (re-search-forward "[^\"]+" nil t)) ; noerror | |
455 | ((looking-at "'") | |
456 | (setq delim ?') | |
457 | (re-search-forward "[^']+" nil t)) ; noerror | |
a1506d29 | 458 | (t |
bbe6126c MK |
459 | (re-search-forward |
460 | (concat "[^" skip-chars "]+") nil t))) ;noerror | |
461 | (setq fname | |
462 | (buffer-substring (match-beginning 0) (match-end 0)))) | |
463 | (if delim | |
464 | (forward-char 1)) | |
465 | (skip-chars-forward " \t\n") | |
466 | (setq result (cons fname result))) | |
467 | result)) | |
468 | ||
469 | ;; convert MS-DOS wildcards to regexp | |
8626cfa2 | 470 | (defun viper-wildcard-to-regexp (wcard) |
937e6a56 | 471 | (with-current-buffer (get-buffer-create viper-ex-tmp-buf-name) |
bbe6126c MK |
472 | (erase-buffer) |
473 | (insert wcard) | |
474 | (goto-char (point-min)) | |
475 | (while (not (eobp)) | |
476 | (skip-chars-forward "^*?.\\\\") | |
477 | (cond ((eq (char-after (point)) ?*) (insert ".")(forward-char 1)) | |
478 | ((eq (char-after (point)) ?.) (insert "\\")(forward-char 1)) | |
479 | ((eq (char-after (point)) ?\\) (insert "\\")(forward-char 1)) | |
480 | ((eq (char-after (point)) ??) (delete-char 1)(insert "."))) | |
481 | ) | |
482 | (buffer-string) | |
483 | )) | |
484 | ||
485 | ||
486 | ;; glob windows files | |
487 | ;; LIST is expected to be in reverse order | |
3af0304a MK |
488 | (defun viper-glob-mswindows-files (filespec) |
489 | (let ((case-fold-search t) | |
490 | tmp tmp2) | |
937e6a56 | 491 | (with-current-buffer (get-buffer-create viper-ex-tmp-buf-name) |
3af0304a MK |
492 | (erase-buffer) |
493 | (insert filespec) | |
494 | (goto-char (point-min)) | |
495 | (setq tmp (viper-get-filenames-from-buffer)) | |
496 | (while tmp | |
a1506d29 | 497 | (setq tmp2 (cons (directory-files |
3af0304a MK |
498 | ;; the directory part |
499 | (or (file-name-directory (car tmp)) | |
500 | "") | |
501 | t ; return full names | |
502 | ;; the regexp part: globs the file names | |
503 | (concat "^" | |
504 | (viper-wildcard-to-regexp | |
505 | (file-name-nondirectory (car tmp))) | |
506 | "$")) | |
507 | tmp2)) | |
508 | (setq tmp (cdr tmp))) | |
509 | (reverse (apply 'append tmp2))))) | |
bbe6126c | 510 | |
6c2e12f4 KH |
511 | \f |
512 | ;;; Insertion ring | |
513 | ||
3af0304a | 514 | ;; Rotate RING's index. DIRection can be positive or negative. |
8626cfa2 | 515 | (defun viper-ring-rotate1 (ring dir) |
6c2e12f4 KH |
516 | (if (and (ring-p ring) (> (ring-length ring) 0)) |
517 | (progn | |
518 | (setcar ring (cond ((> dir 0) | |
519 | (ring-plus1 (car ring) (ring-length ring))) | |
520 | ((< dir 0) | |
521 | (ring-minus1 (car ring) (ring-length ring))) | |
522 | ;; don't rotate if dir = 0 | |
523 | (t (car ring)))) | |
8626cfa2 | 524 | (viper-current-ring-item ring) |
6c2e12f4 | 525 | ))) |
a1506d29 | 526 | |
8626cfa2 MK |
527 | (defun viper-special-ring-rotate1 (ring dir) |
528 | (if (memq viper-intermediate-command | |
6c2e12f4 KH |
529 | '(repeating-display-destructive-command |
530 | repeating-insertion-from-ring)) | |
8626cfa2 | 531 | (viper-ring-rotate1 ring dir) |
6c2e12f4 | 532 | ;; don't rotate otherwise |
8626cfa2 | 533 | (viper-ring-rotate1 ring 0))) |
a1506d29 | 534 | |
6c2e12f4 KH |
535 | ;; current ring item; if N is given, then so many items back from the |
536 | ;; current | |
8626cfa2 | 537 | (defun viper-current-ring-item (ring &optional n) |
6c2e12f4 KH |
538 | (setq n (or n 0)) |
539 | (if (and (ring-p ring) (> (ring-length ring) 0)) | |
540 | (aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring))))) | |
a1506d29 | 541 | |
3af0304a | 542 | ;; Push item onto ring. The second argument is a ring-variable, not value. |
8626cfa2 | 543 | (defun viper-push-onto-ring (item ring-var) |
6c2e12f4 KH |
544 | (or (ring-p (eval ring-var)) |
545 | (set ring-var (make-ring (eval (intern (format "%S-size" ring-var)))))) | |
546 | (or (null item) ; don't push nil | |
547 | (and (stringp item) (string= item "")) ; or empty strings | |
8626cfa2 MK |
548 | (equal item (viper-current-ring-item (eval ring-var))) ; or old stuff |
549 | ;; Since viper-set-destructive-command checks if we are inside | |
550 | ;; viper-repeat, we don't check whether this-command-keys is a `.'. The | |
551 | ;; cmd viper-repeat makes a call to the current function only if `.' is | |
3af0304a | 552 | ;; executing a command from the command history. It doesn't call the |
8626cfa2 MK |
553 | ;; push-onto-ring function if `.' is simply repeating the last |
554 | ;; destructive command. We only check for ESC (which happens when we do | |
555 | ;; insert with a prefix argument, or if this-command-keys doesn't give | |
556 | ;; anything meaningful (in that case we don't know what to show to the | |
557 | ;; user). | |
558 | (and (eq ring-var 'viper-command-ring) | |
6c2e12f4 | 559 | (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)" |
8626cfa2 MK |
560 | (viper-array-to-string (this-command-keys)))) |
561 | (viper-ring-insert (eval ring-var) item)) | |
6c2e12f4 | 562 | ) |
a1506d29 | 563 | |
6c2e12f4 KH |
564 | |
565 | ;; removing elts from ring seems to break it | |
8626cfa2 | 566 | (defun viper-cleanup-ring (ring) |
6c2e12f4 | 567 | (or (< (ring-length ring) 2) |
8626cfa2 | 568 | (null (viper-current-ring-item ring)) |
6c2e12f4 | 569 | ;; last and previous equal |
8626cfa2 MK |
570 | (if (equal (viper-current-ring-item ring) |
571 | (viper-current-ring-item ring 1)) | |
572 | (viper-ring-pop ring)))) | |
a1506d29 | 573 | |
6c2e12f4 | 574 | ;; ring-remove seems to be buggy, so we concocted this for our purposes. |
8626cfa2 | 575 | (defun viper-ring-pop (ring) |
6c2e12f4 KH |
576 | (let* ((ln (ring-length ring)) |
577 | (vec (cdr (cdr ring))) | |
578 | (veclen (length vec)) | |
579 | (hd (car ring)) | |
580 | (idx (max 0 (ring-minus1 hd ln))) | |
581 | (top-elt (aref vec idx))) | |
a1506d29 | 582 | |
6c2e12f4 KH |
583 | ;; shift elements |
584 | (while (< (1+ idx) veclen) | |
585 | (aset vec idx (aref vec (1+ idx))) | |
586 | (setq idx (1+ idx))) | |
587 | (aset vec idx nil) | |
a1506d29 | 588 | |
6c2e12f4 KH |
589 | (setq hd (max 0 (ring-minus1 hd ln))) |
590 | (if (= hd (1- ln)) (setq hd 0)) | |
591 | (setcar ring hd) ; move head | |
592 | (setcar (cdr ring) (max 0 (1- ln))) ; adjust length | |
593 | top-elt | |
594 | )) | |
a1506d29 | 595 | |
8626cfa2 | 596 | (defun viper-ring-insert (ring item) |
6c2e12f4 KH |
597 | (let* ((ln (ring-length ring)) |
598 | (vec (cdr (cdr ring))) | |
599 | (veclen (length vec)) | |
600 | (hd (car ring)) | |
601 | (vecpos-after-hd (if (= hd 0) ln hd)) | |
602 | (idx ln)) | |
a1506d29 | 603 | |
6c2e12f4 KH |
604 | (if (= ln veclen) |
605 | (progn | |
606 | (aset vec hd item) ; hd is always 1+ the actual head index in vec | |
607 | (setcar ring (ring-plus1 hd ln))) | |
608 | (setcar (cdr ring) (1+ ln)) | |
609 | (setcar ring (ring-plus1 vecpos-after-hd (1+ ln))) | |
610 | (while (and (>= idx vecpos-after-hd) (> ln 0)) | |
611 | (aset vec idx (aref vec (1- idx))) | |
612 | (setq idx (1- idx))) | |
613 | (aset vec vecpos-after-hd item)) | |
614 | item)) | |
a1506d29 | 615 | |
6c2e12f4 KH |
616 | \f |
617 | ;;; String utilities | |
618 | ||
619 | ;; If STRING is longer than MAX-LEN, truncate it and print ...... instead | |
620 | ;; PRE-STRING is a string to prepend to the abbrev string. | |
621 | ;; POST-STRING is a string to append to the abbrev string. | |
622 | ;; ABBREV_SIGN is a string to be inserted before POST-STRING | |
a1506d29 | 623 | ;; if the orig string was truncated. |
8626cfa2 | 624 | (defun viper-abbreviate-string (string max-len |
6c2e12f4 KH |
625 | pre-string post-string abbrev-sign) |
626 | (let (truncated-str) | |
627 | (setq truncated-str | |
a1506d29 | 628 | (if (stringp string) |
6c2e12f4 KH |
629 | (substring string 0 (min max-len (length string))))) |
630 | (cond ((null truncated-str) "") | |
631 | ((> (length string) max-len) | |
632 | (format "%s%s%s%s" | |
633 | pre-string truncated-str abbrev-sign post-string)) | |
634 | (t (format "%s%s%s" pre-string truncated-str post-string))))) | |
c8085774 KH |
635 | |
636 | ;; tells if we are over a whitespace-only line | |
8626cfa2 | 637 | (defsubst viper-over-whitespace-line () |
c8085774 KH |
638 | (save-excursion |
639 | (beginning-of-line) | |
640 | (looking-at "^[ \t]*$"))) | |
a1506d29 | 641 | |
6c2e12f4 KH |
642 | \f |
643 | ;;; Saving settings in custom file | |
644 | ||
75551c46 KH |
645 | ;; Save the current setting of VAR in CUSTOM-FILE. |
646 | ;; If given, MESSAGE is a message to be displayed after that. | |
647 | ;; This message is erased after 2 secs, if erase-msg is non-nil. | |
648 | ;; Arguments: var message custom-file &optional erase-message | |
8626cfa2 | 649 | (defun viper-save-setting (var message custom-file &optional erase-msg) |
6c2e12f4 KH |
650 | (let* ((var-name (symbol-name var)) |
651 | (var-val (if (boundp var) (eval var))) | |
652 | (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name)) | |
653 | (buf (find-file-noselect (substitute-in-file-name custom-file))) | |
654 | ) | |
274f1353 | 655 | (message "%s" (or message "")) |
937e6a56 | 656 | (with-current-buffer buf |
6c2e12f4 KH |
657 | (goto-char (point-min)) |
658 | (if (re-search-forward regexp nil t) | |
659 | (let ((reg-end (1- (match-end 0)))) | |
660 | (search-backward var-name) | |
661 | (delete-region (match-beginning 0) reg-end) | |
662 | (goto-char (match-beginning 0)) | |
663 | (insert (format "%s '%S" var-name var-val))) | |
664 | (goto-char (point-max)) | |
665 | (if (not (bolp)) (insert "\n")) | |
666 | (insert (format "(setq %s '%S)\n" var-name var-val))) | |
667 | (save-buffer)) | |
668 | (kill-buffer buf) | |
669 | (if erase-msg | |
670 | (progn | |
671 | (sit-for 2) | |
672 | (message ""))) | |
673 | )) | |
a1506d29 | 674 | |
3af0304a | 675 | ;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that |
6c2e12f4 | 676 | ;; match this pattern. |
8626cfa2 | 677 | (defun viper-save-string-in-file (string custom-file &optional pattern) |
6c2e12f4 | 678 | (let ((buf (find-file-noselect (substitute-in-file-name custom-file)))) |
937e6a56 | 679 | (with-current-buffer buf |
2eb4bdca MK |
680 | (let (buffer-read-only) |
681 | (goto-char (point-min)) | |
682 | (if pattern (delete-matching-lines pattern)) | |
683 | (goto-char (point-max)) | |
684 | (if string (insert string)) | |
685 | (save-buffer))) | |
6c2e12f4 KH |
686 | (kill-buffer buf) |
687 | )) | |
2eb4bdca MK |
688 | |
689 | ||
2eb4bdca MK |
690 | ;; This is a simple-minded check for whether a file is under version control. |
691 | ;; If file,v exists but file doesn't, this file is considered to be not checked | |
692 | ;; in and not checked out for the purpose of patching (since patch won't be | |
693 | ;; able to read such a file anyway). | |
694 | ;; FILE is a string representing file name | |
695 | ;;(defun viper-file-under-version-control (file) | |
696 | ;; (let* ((filedir (file-name-directory file)) | |
697 | ;; (file-nondir (file-name-nondirectory file)) | |
698 | ;; (trial (concat file-nondir ",v")) | |
699 | ;; (full-trial (concat filedir trial)) | |
700 | ;; (full-rcs-trial (concat filedir "RCS/" trial))) | |
701 | ;; (and (stringp file) | |
702 | ;; (file-exists-p file) | |
703 | ;; (or | |
704 | ;; (and | |
705 | ;; (file-exists-p full-trial) | |
706 | ;; ;; in FAT FS, `file,v' and `file' may turn out to be the same! | |
707 | ;; ;; don't be fooled by this! | |
708 | ;; (not (equal (file-attributes file) | |
709 | ;; (file-attributes full-trial)))) | |
710 | ;; ;; check if a version is in RCS/ directory | |
711 | ;; (file-exists-p full-rcs-trial))) | |
712 | ;; )) | |
713 | ||
714 | ||
715 | (defsubst viper-file-checked-in-p (file) | |
3af0304a MK |
716 | (and (featurep 'vc-hooks) |
717 | ;; CVS files are considered not checked in | |
e83d1fe8 | 718 | ;; FIXME: Should this deal with more than CVS? |
3af0304a | 719 | (not (memq (vc-backend file) '(nil CVS))) |
4960e757 | 720 | (if (fboundp 'vc-state) |
23f46f6f | 721 | (and |
4960e757 MK |
722 | (not (memq (vc-state file) '(edited needs-merge))) |
723 | (not (stringp (vc-state file)))) | |
724 | ;; XEmacs has no vc-state | |
c7218216 | 725 | (if (featurep 'xemacs) (not (vc-locking-user file)))))) |
3af0304a | 726 | |
2eb4bdca MK |
727 | ;; checkout if visited file is checked in |
728 | (defun viper-maybe-checkout (buf) | |
729 | (let ((file (expand-file-name (buffer-file-name buf))) | |
730 | (checkout-function (key-binding "\C-x\C-q"))) | |
731 | (if (and (viper-file-checked-in-p file) | |
732 | (or (beep 1) t) | |
733 | (y-or-n-p | |
734 | (format | |
3af0304a | 735 | "File %s is checked in. Check it out? " |
2eb4bdca MK |
736 | (viper-abbreviate-file-name file)))) |
737 | (with-current-buffer buf | |
738 | (command-execute checkout-function))))) | |
2eb4bdca | 739 | |
a1506d29 JB |
740 | |
741 | ||
6c2e12f4 KH |
742 | \f |
743 | ;;; Overlays | |
d35bee0e MK |
744 | (defun viper-put-on-search-overlay (beg end) |
745 | (if (viper-overlay-p viper-search-overlay) | |
746 | (viper-move-overlay viper-search-overlay beg end) | |
747 | (setq viper-search-overlay (viper-make-overlay beg end (current-buffer))) | |
748 | (viper-overlay-put | |
749 | viper-search-overlay 'priority viper-search-overlay-priority)) | |
750 | (viper-overlay-put viper-search-overlay 'face viper-search-face)) | |
6c2e12f4 KH |
751 | |
752 | ;; Search | |
753 | ||
8626cfa2 | 754 | (defun viper-flash-search-pattern () |
d35bee0e MK |
755 | (if (not (viper-has-face-support-p)) |
756 | nil | |
757 | (viper-put-on-search-overlay (match-beginning 0) (match-end 0)) | |
758 | (sit-for 2) | |
759 | (viper-overlay-put viper-search-overlay 'face nil))) | |
760 | ||
761 | (defun viper-hide-search-overlay () | |
762 | (if (not (viper-overlay-p viper-search-overlay)) | |
6c2e12f4 | 763 | (progn |
d35bee0e | 764 | (setq viper-search-overlay |
657f9cb8 | 765 | (viper-make-overlay (point-min) (point-min) (current-buffer))) |
d35bee0e MK |
766 | (viper-overlay-put |
767 | viper-search-overlay 'priority viper-search-overlay-priority))) | |
768 | (viper-overlay-put viper-search-overlay 'face nil)) | |
ab124470 | 769 | |
6c2e12f4 KH |
770 | ;; Replace state |
771 | ||
8626cfa2 MK |
772 | (defsubst viper-move-replace-overlay (beg end) |
773 | (viper-move-overlay viper-replace-overlay beg end)) | |
a1506d29 | 774 | |
8626cfa2 | 775 | (defun viper-set-replace-overlay (beg end) |
55d7ff38 | 776 | (if (viper-overlay-live-p viper-replace-overlay) |
8626cfa2 MK |
777 | (viper-move-replace-overlay beg end) |
778 | (setq viper-replace-overlay (viper-make-overlay beg end (current-buffer))) | |
03fc1246 | 779 | ;; never detach |
8626cfa2 | 780 | (viper-overlay-put |
e83d1fe8 | 781 | viper-replace-overlay (if (featurep 'emacs) 'evaporate 'detachable) nil) |
a1506d29 | 782 | (viper-overlay-put |
8626cfa2 | 783 | viper-replace-overlay 'priority viper-replace-overlay-priority) |
9b70a748 | 784 | ;; If Emacs will start supporting overlay maps, as it currently supports |
8626cfa2 | 785 | ;; text-property maps, we could do away with viper-replace-minor-mode and |
9b70a748 | 786 | ;; just have keymap attached to replace overlay. |
8626cfa2 MK |
787 | ;;(viper-overlay-put |
788 | ;; viper-replace-overlay | |
e83d1fe8 | 789 | ;; (if (featurep 'xemacs) 'keymap 'local-map) |
8626cfa2 | 790 | ;; viper-replace-map) |
a1506d29 | 791 | ) |
8626cfa2 MK |
792 | (if (viper-has-face-support-p) |
793 | (viper-overlay-put | |
794 | viper-replace-overlay 'face viper-replace-overlay-face)) | |
3af0304a | 795 | (viper-save-cursor-color 'before-replace-mode) |
c7218216 GM |
796 | (viper-change-cursor-color |
797 | (viper-frame-value viper-replace-overlay-cursor-color))) | |
a1506d29 JB |
798 | |
799 | ||
8626cfa2 | 800 | (defun viper-set-replace-overlay-glyphs (before-glyph after-glyph) |
55d7ff38 MK |
801 | (or (viper-overlay-live-p viper-replace-overlay) |
802 | (viper-set-replace-overlay (point-min) (point-min))) | |
8626cfa2 MK |
803 | (if (or (not (viper-has-face-support-p)) |
804 | viper-use-replace-region-delimiters) | |
e83d1fe8 DN |
805 | (let ((before-name (if (featurep 'xemacs) 'begin-glyph 'before-string)) |
806 | (after-name (if (featurep 'xemacs) 'end-glyph 'after-string))) | |
8626cfa2 MK |
807 | (viper-overlay-put viper-replace-overlay before-name before-glyph) |
808 | (viper-overlay-put viper-replace-overlay after-name after-glyph)))) | |
a1506d29 | 809 | |
8626cfa2 MK |
810 | (defun viper-hide-replace-overlay () |
811 | (viper-set-replace-overlay-glyphs nil nil) | |
3af0304a MK |
812 | (viper-restore-cursor-color 'after-replace-mode) |
813 | (viper-restore-cursor-color 'after-insert-mode) | |
8626cfa2 MK |
814 | (if (viper-has-face-support-p) |
815 | (viper-overlay-put viper-replace-overlay 'face nil))) | |
6c2e12f4 | 816 | |
a1506d29 | 817 | |
8626cfa2 MK |
818 | (defsubst viper-replace-start () |
819 | (viper-overlay-start viper-replace-overlay)) | |
820 | (defsubst viper-replace-end () | |
821 | (viper-overlay-end viper-replace-overlay)) | |
a1506d29 | 822 | |
6c2e12f4 KH |
823 | |
824 | ;; Minibuffer | |
825 | ||
8626cfa2 MK |
826 | (defun viper-set-minibuffer-overlay () |
827 | (viper-check-minibuffer-overlay) | |
c7218216 GM |
828 | (when (viper-has-face-support-p) |
829 | (viper-overlay-put | |
830 | viper-minibuffer-overlay 'face viper-minibuffer-current-face) | |
831 | (viper-overlay-put | |
832 | viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority) | |
833 | ;; never detach | |
834 | (viper-overlay-put | |
835 | viper-minibuffer-overlay | |
836 | (if (featurep 'emacs) 'evaporate 'detachable) | |
837 | nil) | |
838 | ;; make viper-minibuffer-overlay open-ended | |
839 | ;; In emacs, it is made open ended at creation time | |
840 | (when (featurep 'xemacs) | |
841 | (viper-overlay-put viper-minibuffer-overlay 'start-open nil) | |
842 | (viper-overlay-put viper-minibuffer-overlay 'end-open nil)))) | |
a1506d29 | 843 | |
8626cfa2 | 844 | (defun viper-check-minibuffer-overlay () |
50a07e18 MK |
845 | (if (viper-overlay-live-p viper-minibuffer-overlay) |
846 | (viper-move-overlay | |
847 | viper-minibuffer-overlay | |
848 | (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) | |
849 | (1+ (buffer-size))) | |
850 | (setq viper-minibuffer-overlay | |
e83d1fe8 | 851 | (if (featurep 'xemacs) |
50a07e18 MK |
852 | (viper-make-overlay 1 (1+ (buffer-size)) (current-buffer)) |
853 | ;; make overlay open-ended | |
854 | (viper-make-overlay | |
855 | (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) | |
856 | (1+ (buffer-size)) | |
c7218216 | 857 | (current-buffer) nil 'rear-advance))))) |
d3e1167f | 858 | |
6c2e12f4 | 859 | |
8626cfa2 | 860 | (defsubst viper-is-in-minibuffer () |
2eb4bdca MK |
861 | (save-match-data |
862 | (string-match "\*Minibuf-" (buffer-name)))) | |
a1506d29 | 863 | |
6c2e12f4 KH |
864 | |
865 | \f | |
866 | ;;; XEmacs compatibility | |
ae37fce9 | 867 | |
8626cfa2 | 868 | (defun viper-abbreviate-file-name (file) |
c7218216 GM |
869 | (if (featurep 'xemacs) |
870 | (abbreviate-file-name file t) ; XEmacs requires addl argument | |
871 | (abbreviate-file-name file))) | |
a1506d29 JB |
872 | |
873 | ;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg | |
75551c46 | 874 | ;; in sit-for, so this function smoothes out the differences. |
8626cfa2 | 875 | (defsubst viper-sit-for-short (val &optional nodisp) |
ac64a728 | 876 | (sit-for (/ val 1000.0) nodisp)) |
6c2e12f4 KH |
877 | |
878 | ;; EVENT may be a single event of a sequence of events | |
8626cfa2 | 879 | (defsubst viper-ESC-event-p (event) |
6c2e12f4 | 880 | (let ((ESC-keys '(?\e (control \[) escape)) |
8626cfa2 | 881 | (key (viper-event-key event))) |
6c2e12f4 | 882 | (member key ESC-keys))) |
9b70a748 MK |
883 | |
884 | ;; checks if object is a marker, has a buffer, and points to within that buffer | |
8626cfa2 | 885 | (defun viper-valid-marker (marker) |
9b70a748 MK |
886 | (if (and (markerp marker) (marker-buffer marker)) |
887 | (let ((buf (marker-buffer marker)) | |
888 | (pos (marker-position marker))) | |
937e6a56 | 889 | (with-current-buffer buf |
9b70a748 | 890 | (and (<= pos (point-max)) (<= (point-min) pos)))))) |
a1506d29 | 891 | |
8626cfa2 | 892 | (defsubst viper-mark-marker () |
c7218216 GM |
893 | (if (featurep 'xemacs) (mark-marker t) |
894 | (mark-marker))) | |
03fc1246 MK |
895 | |
896 | ;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring) | |
897 | ;; is the same as (mark t). | |
8626cfa2 MK |
898 | (defsubst viper-set-mark-if-necessary () |
899 | (setq mark-ring (delete (viper-mark-marker) mark-ring)) | |
3af0304a MK |
900 | (set-mark-command nil) |
901 | (setq viper-saved-mark (point))) | |
a1506d29 | 902 | |
6c2e12f4 | 903 | ;; In transient mark mode (zmacs mode), it is annoying when regions become |
3af0304a | 904 | ;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless |
6c2e12f4 | 905 | ;; the user explicitly wants highlighting, e.g., by hitting '' or `` |
8626cfa2 | 906 | (defun viper-deactivate-mark () |
c7218216 GM |
907 | (if (featurep 'xemacs) |
908 | (zmacs-deactivate-region) | |
909 | (deactivate-mark))) | |
6c2e12f4 | 910 | |
8626cfa2 | 911 | (defsubst viper-leave-region-active () |
c7218216 | 912 | (if (featurep 'xemacs) (setq zmacs-region-stays t))) |
dd7c19d4 | 913 | |
9b70a748 MK |
914 | ;; Check if arg is a valid character for register |
915 | ;; TYPE is a list that can contain `letter', `Letter', and `digit'. | |
916 | ;; Letter means lowercase letters, Letter means uppercase letters, and | |
917 | ;; digit means digits from 1 to 9. | |
918 | ;; If TYPE is nil, then down/uppercase letters and digits are allowed. | |
8626cfa2 | 919 | (defun viper-valid-register (reg &optional type) |
9b70a748 MK |
920 | (or type (setq type '(letter Letter digit))) |
921 | (or (if (memq 'letter type) | |
922 | (and (<= ?a reg) (<= reg ?z))) | |
923 | (if (memq 'digit type) | |
924 | (and (<= ?1 reg) (<= reg ?9))) | |
925 | (if (memq 'Letter type) | |
926 | (and (<= ?A reg) (<= reg ?Z))) | |
927 | )) | |
928 | ||
a1506d29 JB |
929 | |
930 | ||
9b70a748 MK |
931 | ;; it is suggested that an event must be copied before it is assigned to |
932 | ;; last-command-event in XEmacs | |
8626cfa2 | 933 | (defun viper-copy-event (event) |
c7218216 GM |
934 | (if (featurep 'xemacs) (copy-event event) |
935 | event)) | |
a1506d29 | 936 | |
50a07e18 | 937 | ;; Uses different timeouts for ESC-sequences and others |
42acc581 | 938 | (defun viper-fast-keysequence-p () |
a1506d29 | 939 | (not (viper-sit-for-short |
50a07e18 | 940 | (if (viper-ESC-event-p last-input-event) |
42acc581 | 941 | (viper-ESC-keyseq-timeout) |
50a07e18 MK |
942 | viper-fast-keyseq-timeout) |
943 | t))) | |
a1506d29 | 944 | |
6c2e12f4 | 945 | ;; like read-event, but in XEmacs also try to convert to char, if possible |
8626cfa2 | 946 | (defun viper-read-event-convert-to-char () |
6c2e12f4 | 947 | (let (event) |
c7218216 GM |
948 | (if (featurep 'xemacs) |
949 | (progn | |
950 | (setq event (next-command-event)) | |
951 | (or (event-to-character event) | |
952 | event)) | |
953 | (read-event)))) | |
6c2e12f4 | 954 | |
50a07e18 MK |
955 | ;; Viperized read-key-sequence |
956 | (defun viper-read-key-sequence (prompt &optional continue-echo) | |
957 | (let (inhibit-quit event keyseq) | |
958 | (setq keyseq (read-key-sequence prompt continue-echo)) | |
e83d1fe8 | 959 | (setq event (if (featurep 'xemacs) |
50a07e18 MK |
960 | (elt keyseq 0) ; XEmacs returns vector of events |
961 | (elt (listify-key-sequence keyseq) 0))) | |
962 | (if (viper-ESC-event-p event) | |
963 | (let (unread-command-events) | |
50a07e18 MK |
964 | (if (viper-fast-keysequence-p) |
965 | (let ((viper-vi-global-user-minor-mode nil) | |
966 | (viper-vi-local-user-minor-mode nil) | |
8bdd0bf7 MK |
967 | (viper-vi-intercept-minor-mode nil) |
968 | (viper-insert-intercept-minor-mode nil) | |
50a07e18 MK |
969 | (viper-replace-minor-mode nil) ; actually unnecessary |
970 | (viper-insert-global-user-minor-mode nil) | |
971 | (viper-insert-local-user-minor-mode nil)) | |
8bdd0bf7 MK |
972 | ;; Note: set unread-command-events only after testing for fast |
973 | ;; keysequence. Otherwise, viper-fast-keysequence-p will be | |
974 | ;; always t -- whether there is anything after ESC or not | |
975 | (viper-set-unread-command-events keyseq) | |
a1506d29 | 976 | (setq keyseq (read-key-sequence nil))) |
8bdd0bf7 MK |
977 | (viper-set-unread-command-events keyseq) |
978 | (setq keyseq (read-key-sequence nil))))) | |
50a07e18 MK |
979 | keyseq)) |
980 | ||
981 | ||
4702a420 | 982 | ;; This function lets function-key-map convert key sequences into logical |
3af0304a | 983 | ;; keys. This does a better job than viper-read-event when it comes to kbd |
20626291 | 984 | ;; macros, since it enables certain macros to be shared between X and TTY modes |
2ee00512 | 985 | ;; by correctly mapping key sequences for Left/Right/... (on an ascii |
20626291 | 986 | ;; terminal) into logical keys left, right, etc. |
a1506d29 JB |
987 | (defun viper-read-key () |
988 | (let ((overriding-local-map viper-overriding-map) | |
20626291 | 989 | (inhibit-quit t) |
a1506d29 JB |
990 | help-char key) |
991 | (use-global-map viper-overriding-map) | |
41497c90 | 992 | (unwind-protect |
a1506d29 | 993 | (setq key (elt (viper-read-key-sequence nil) 0)) |
41497c90 | 994 | (use-global-map global-map)) |
20626291 | 995 | key)) |
4702a420 | 996 | |
6c2e12f4 | 997 | |
75551c46 | 998 | ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil) |
f8169b5e | 999 | ;; instead of nil, if '(nil) was previously inadvertently assigned to |
6c2e12f4 | 1000 | ;; unread-command-events |
8626cfa2 | 1001 | (defun viper-event-key (event) |
6c2e12f4 | 1002 | (or (and event (eventp event)) |
8626cfa2 | 1003 | (error "viper-event-key: Wrong type argument, eventp, %S" event)) |
c7218216 | 1004 | (when (if (featurep 'xemacs) |
50a07e18 MK |
1005 | (or (key-press-event-p event) (mouse-event-p event)) ; xemacs |
1006 | t ; emacs | |
1007 | ) | |
9b70a748 MK |
1008 | (let ((mod (event-modifiers event)) |
1009 | basis) | |
1010 | (setq basis | |
c7218216 | 1011 | (if (featurep 'xemacs) |
50a07e18 MK |
1012 | ;; XEmacs |
1013 | (cond ((key-press-event-p event) | |
1014 | (event-key event)) | |
1015 | ((button-event-p event) | |
1016 | (concat "mouse-" (prin1-to-string (event-button event)))) | |
a1506d29 | 1017 | (t |
50a07e18 MK |
1018 | (error "viper-event-key: Unknown event, %S" event))) |
1019 | ;; Emacs doesn't handle capital letters correctly, since | |
1020 | ;; \S-a isn't considered the same as A (it behaves as | |
1021 | ;; plain `a' instead). So we take care of this here | |
1022 | (cond ((and (viper-characterp event) (<= ?A event) (<= event ?Z)) | |
1023 | (setq mod nil | |
1024 | event event)) | |
1025 | ;; Emacs has the oddity whereby characters 128+char | |
1026 | ;; represent M-char *if* this appears inside a string. | |
1027 | ;; So, we convert them manually to (meta char). | |
1028 | ((and (viper-characterp event) | |
1029 | (< ?\C-? event) (<= event 255)) | |
1030 | (setq mod '(meta) | |
1031 | event (- event ?\C-? 1))) | |
1032 | ((and (null mod) (eq event 'return)) | |
1033 | (setq event ?\C-m)) | |
1034 | ((and (null mod) (eq event 'space)) | |
1035 | (setq event ?\ )) | |
1036 | ((and (null mod) (eq event 'delete)) | |
1037 | (setq event ?\C-?)) | |
1038 | ((and (null mod) (eq event 'backspace)) | |
1039 | (setq event ?\C-h)) | |
1040 | (t (event-basic-type event))) | |
c7218216 | 1041 | ) ; (featurep 'xemacs) |
50a07e18 | 1042 | ) |
8626cfa2 | 1043 | (if (viper-characterp basis) |
9b70a748 | 1044 | (setq basis |
657f9cb8 | 1045 | (if (viper= basis ?\C-?) |
9b70a748 MK |
1046 | (list 'control '\?) ; taking care of an emacs bug |
1047 | (intern (char-to-string basis))))) | |
1048 | (if mod | |
1049 | (append mod (list basis)) | |
1050 | basis)))) | |
a1506d29 | 1051 | |
433d9ace MK |
1052 | (defun viper-last-command-char () |
1053 | (if (featurep 'xemacs) | |
1054 | (event-to-character last-command-event) | |
1055 | last-command-event)) | |
1056 | ||
8626cfa2 | 1057 | (defun viper-key-to-emacs-key (key) |
6c2e12f4 | 1058 | (let (key-name char-p modifiers mod-char-list base-key base-key-name) |
e83d1fe8 | 1059 | (cond ((featurep 'xemacs) key) |
1e70790f | 1060 | |
6c2e12f4 KH |
1061 | ((symbolp key) |
1062 | (setq key-name (symbol-name key)) | |
1e70790f MK |
1063 | (cond ((= (length key-name) 1) ; character event |
1064 | (string-to-char key-name)) | |
1065 | ;; Emacs doesn't recognize `return' and `escape' as events on | |
1066 | ;; dumb terminals, so we translate them into characters | |
e83d1fe8 | 1067 | ((and (featurep 'emacs) (not (viper-window-display-p)) |
1e70790f MK |
1068 | (string= key-name "return")) |
1069 | ?\C-m) | |
e83d1fe8 | 1070 | ((and (featurep 'emacs) (not (viper-window-display-p)) |
1e70790f MK |
1071 | (string= key-name "escape")) |
1072 | ?\e) | |
1073 | ;; pass symbol-event as is | |
1074 | (t key))) | |
1075 | ||
6c2e12f4 | 1076 | ((listp key) |
8ea74b0e | 1077 | (setq modifiers (viper-subseq key 0 (1- (length key))) |
8626cfa2 | 1078 | base-key (viper-seq-last-elt key) |
6c2e12f4 KH |
1079 | base-key-name (symbol-name base-key) |
1080 | char-p (= (length base-key-name) 1)) | |
1081 | (setq mod-char-list | |
1082 | (mapcar | |
1083 | '(lambda (elt) (upcase (substring (symbol-name elt) 0 1))) | |
1084 | modifiers)) | |
1085 | (if char-p | |
1086 | (setq key-name | |
1087 | (car (read-from-string | |
1088 | (concat | |
1089 | "?\\" | |
1090 | (mapconcat 'identity mod-char-list "-\\") | |
1091 | "-" | |
1092 | base-key-name)))) | |
1093 | (setq key-name | |
1094 | (intern | |
1095 | (concat | |
1096 | (mapconcat 'identity mod-char-list "-") | |
1097 | "-" | |
1098 | base-key-name)))))) | |
1099 | )) | |
1100 | ||
1101 | ||
50a07e18 MK |
1102 | ;; LIS is assumed to be a list of events of characters |
1103 | (defun viper-eventify-list-xemacs (lis) | |
e83d1fe8 DN |
1104 | (if (featurep 'xemacs) |
1105 | (mapcar | |
1106 | (lambda (elt) | |
1107 | (cond ((viper-characterp elt) (character-to-event elt)) | |
1108 | ((eventp elt) elt) | |
1109 | (t (error | |
1110 | "viper-eventify-list-xemacs: can't convert to event, %S" | |
1111 | elt)))) | |
1112 | lis))) | |
a1506d29 | 1113 | |
50a07e18 MK |
1114 | |
1115 | ;; Smoothes out the difference between Emacs' unread-command-events | |
1116 | ;; and XEmacs unread-command-event. Arg is a character, an event, a list of | |
1117 | ;; events or a sequence of keys. | |
1118 | ;; | |
1119 | ;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event | |
1120 | ;; symbol in unread-command-events list may cause Emacs to turn this symbol | |
1121 | ;; into an event. Below, we delete nil from event lists, since nil is the most | |
1122 | ;; common symbol that might appear in this wrong context. | |
1123 | (defun viper-set-unread-command-events (arg) | |
e83d1fe8 | 1124 | (if (featurep 'emacs) |
50a07e18 MK |
1125 | (setq |
1126 | unread-command-events | |
1127 | (let ((new-events | |
1128 | (cond ((eventp arg) (list arg)) | |
1129 | ((listp arg) arg) | |
1130 | ((sequencep arg) | |
1131 | (listify-key-sequence arg)) | |
1132 | (t (error | |
1133 | "viper-set-unread-command-events: Invalid argument, %S" | |
1134 | arg))))) | |
1135 | (if (not (eventp nil)) | |
1136 | (setq new-events (delq nil new-events))) | |
1137 | (append new-events unread-command-events))) | |
1138 | ;; XEmacs | |
1139 | (setq | |
1140 | unread-command-events | |
1141 | (append | |
1142 | (cond ((viper-characterp arg) (list (character-to-event arg))) | |
1143 | ((eventp arg) (list arg)) | |
1144 | ((stringp arg) (mapcar 'character-to-event arg)) | |
1145 | ((vectorp arg) (append arg nil)) ; turn into list | |
1146 | ((listp arg) (viper-eventify-list-xemacs arg)) | |
1147 | (t (error | |
1148 | "viper-set-unread-command-events: Invalid argument, %S" arg))) | |
1149 | unread-command-events)))) | |
1150 | ||
1151 | ||
1152 | ;; Check if vec is a vector of key-press events representing characters | |
1153 | ;; XEmacs only | |
1154 | (defun viper-event-vector-p (vec) | |
1155 | (and (vectorp vec) | |
1156 | (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec))))) | |
1157 | ||
a1506d29 | 1158 | |
50a07e18 MK |
1159 | ;; check if vec is a vector of character symbols |
1160 | (defun viper-char-symbol-sequence-p (vec) | |
1161 | (and | |
1162 | (sequencep vec) | |
1163 | (eval | |
1164 | (cons 'and | |
1165 | (mapcar (lambda (elt) | |
1166 | (and (symbolp elt) (= (length (symbol-name elt)) 1))) | |
1167 | vec))))) | |
a1506d29 JB |
1168 | |
1169 | ||
50a07e18 MK |
1170 | (defun viper-char-array-p (array) |
1171 | (eval (cons 'and (mapcar 'viper-characterp array)))) | |
1172 | ||
1173 | ||
6c2e12f4 KH |
1174 | ;; Args can be a sequence of events, a string, or a Viper macro. Will try to |
1175 | ;; convert events to keys and, if all keys are regular printable | |
3af0304a MK |
1176 | ;; characters, will return a string. Otherwise, will return a string |
1177 | ;; representing a vector of converted events. If the input was a Viper macro, | |
6c2e12f4 | 1178 | ;; will return a string that represents this macro as a vector. |
8626cfa2 | 1179 | (defun viper-array-to-string (event-seq) |
bbe6126c | 1180 | (let (temp temp2) |
6c2e12f4 | 1181 | (cond ((stringp event-seq) event-seq) |
8626cfa2 MK |
1182 | ((viper-event-vector-p event-seq) |
1183 | (setq temp (mapcar 'viper-event-key event-seq)) | |
1184 | (cond ((viper-char-symbol-sequence-p temp) | |
bbe6126c | 1185 | (mapconcat 'symbol-name temp "")) |
8626cfa2 MK |
1186 | ((and (viper-char-array-p |
1187 | (setq temp2 (mapcar 'viper-key-to-character temp)))) | |
bbe6126c MK |
1188 | (mapconcat 'char-to-string temp2 "")) |
1189 | (t (prin1-to-string (vconcat temp))))) | |
8626cfa2 | 1190 | ((viper-char-symbol-sequence-p event-seq) |
6c2e12f4 | 1191 | (mapconcat 'symbol-name event-seq "")) |
a1506d29 | 1192 | ((and (vectorp event-seq) |
8626cfa2 MK |
1193 | (viper-char-array-p |
1194 | (setq temp (mapcar 'viper-key-to-character event-seq)))) | |
bbe6126c | 1195 | (mapconcat 'char-to-string temp "")) |
6c2e12f4 | 1196 | (t (prin1-to-string event-seq))))) |
e0c82342 | 1197 | |
8626cfa2 | 1198 | (defun viper-key-press-events-to-chars (events) |
c7218216 | 1199 | (mapconcat (if (featurep 'xemacs) |
2ee00512 MK |
1200 | (lambda (elt) (char-to-string (event-to-character elt))) ; xemacs |
1201 | 'char-to-string ; emacs | |
1202 | ) | |
e0c82342 MK |
1203 | events |
1204 | "")) | |
a1506d29 JB |
1205 | |
1206 | ||
8626cfa2 | 1207 | (defun viper-read-char-exclusive () |
6c2e12f4 KH |
1208 | (let (char |
1209 | (echo-keystrokes 1)) | |
1210 | (while (null char) | |
1211 | (condition-case nil | |
1212 | (setq char (read-char)) | |
1213 | (error | |
1214 | ;; skip event if not char | |
8626cfa2 | 1215 | (viper-read-event)))) |
6c2e12f4 KH |
1216 | char)) |
1217 | ||
bbe6126c MK |
1218 | ;; key is supposed to be in viper's representation, e.g., (control l), a |
1219 | ;; character, etc. | |
8626cfa2 | 1220 | (defun viper-key-to-character (key) |
bbe6126c MK |
1221 | (cond ((eq key 'space) ?\ ) |
1222 | ((eq key 'delete) ?\C-?) | |
8626cfa2 | 1223 | ((eq key 'return) ?\C-m) |
bbe6126c MK |
1224 | ((eq key 'backspace) ?\C-h) |
1225 | ((and (symbolp key) | |
1226 | (= 1 (length (symbol-name key)))) | |
1227 | (string-to-char (symbol-name key))) | |
1228 | ((and (listp key) | |
1229 | (eq (car key) 'control) | |
1230 | (symbol-name (nth 1 key)) | |
1231 | (= 1 (length (symbol-name (nth 1 key))))) | |
1232 | (read (format "?\\C-%s" (symbol-name (nth 1 key))))) | |
1233 | (t key))) | |
a1506d29 JB |
1234 | |
1235 | ||
8626cfa2 | 1236 | (defun viper-setup-master-buffer (&rest other-files-or-buffers) |
6c2e12f4 | 1237 | "Set up the current buffer as a master buffer. |
3af0304a | 1238 | Arguments become related buffers. This function should normally be used in |
6c2e12f4 | 1239 | the `Local variables' section of a file." |
a1506d29 | 1240 | (setq viper-related-files-and-buffers-ring |
6c2e12f4 | 1241 | (make-ring (1+ (length other-files-or-buffers)))) |
4fee0f87 JB |
1242 | (mapc '(lambda (elt) |
1243 | (viper-ring-insert viper-related-files-and-buffers-ring elt)) | |
1244 | other-files-or-buffers) | |
8626cfa2 | 1245 | (viper-ring-insert viper-related-files-and-buffers-ring (buffer-name)) |
6c2e12f4 | 1246 | ) |
e0c82342 MK |
1247 | |
1248 | ;;; Movement utilities | |
1249 | ||
34317da2 MK |
1250 | ;; Characters that should not be considered as part of the word, in reformed-vi |
1251 | ;; syntax mode. | |
54b171c7 MK |
1252 | ;; Note: \\ (quoted \) must appear before `-' because this string is listified |
1253 | ;; into characters at some point and then put back to string. The result is | |
1254 | ;; used in skip-chars-forward, which treats - specially. Here we achieve the | |
1255 | ;; effect of quoting - and preventing it from being special. | |
34317da2 | 1256 | (defconst viper-non-word-characters-reformed-vi |
54b171c7 | 1257 | "!@#$%^&*()\\-+=|\\~`{}[];:'\",<.>/?") |
34317da2 MK |
1258 | ;; These are characters that are not to be considered as parts of a word in |
1259 | ;; Viper. | |
1260 | ;; Set each time state changes and at loading time | |
1261 | (viper-deflocalvar viper-non-word-characters nil) | |
e0c82342 | 1262 | |
34317da2 | 1263 | ;; must be buffer-local |
8626cfa2 | 1264 | (viper-deflocalvar viper-ALPHA-char-class "w" |
e0c82342 MK |
1265 | "String of syntax classes characterizing Viper's alphanumeric symbols. |
1266 | In addition, the symbol `_' may be considered alphanumeric if | |
34317da2 | 1267 | `viper-syntax-preference' is `strict-vi' or `reformed-vi'.") |
e0c82342 | 1268 | |
34317da2 MK |
1269 | (defconst viper-strict-ALPHA-chars "a-zA-Z0-9_" |
1270 | "Regexp matching the set of alphanumeric characters acceptable to strict | |
1271 | Vi.") | |
1272 | (defconst viper-strict-SEP-chars " \t\n" | |
e0c82342 MK |
1273 | "Regexp matching the set of alphanumeric characters acceptable to strict |
1274 | Vi.") | |
34317da2 | 1275 | (defconst viper-strict-SEP-chars-sans-newline " \t" |
e0c82342 MK |
1276 | "Regexp matching the set of alphanumeric characters acceptable to strict |
1277 | Vi.") | |
1278 | ||
34317da2 | 1279 | (defconst viper-SEP-char-class " -" |
e0c82342 MK |
1280 | "String of syntax classes for Vi separators. |
1281 | Usually contains ` ', linefeed, TAB or formfeed.") | |
1282 | ||
34317da2 MK |
1283 | |
1284 | ;; Set Viper syntax classes and related variables according to | |
a1506d29 | 1285 | ;; `viper-syntax-preference'. |
34317da2 MK |
1286 | (defun viper-update-syntax-classes (&optional set-default) |
1287 | (let ((preference (cond ((eq viper-syntax-preference 'emacs) | |
1288 | "w") ; Viper words have only Emacs word chars | |
1289 | ((eq viper-syntax-preference 'extended) | |
1290 | "w_") ; Viper words have Emacs word & symbol chars | |
1291 | (t "w"))) ; Viper words are Emacs words plus `_' | |
1292 | (non-word-chars (cond ((eq viper-syntax-preference 'reformed-vi) | |
1293 | (viper-string-to-list | |
1294 | viper-non-word-characters-reformed-vi)) | |
1295 | (t nil)))) | |
1296 | (if set-default | |
1297 | (setq-default viper-ALPHA-char-class preference | |
1298 | viper-non-word-characters non-word-chars) | |
1299 | (setq viper-ALPHA-char-class preference | |
1300 | viper-non-word-characters non-word-chars)) | |
1301 | )) | |
1302 | ||
1303 | ;; SYMBOL is used because customize requires it, but it is ignored, unless it | |
3af0304a | 1304 | ;; is `nil'. If nil, use setq. |
34317da2 MK |
1305 | (defun viper-set-syntax-preference (&optional symbol value) |
1306 | "Set Viper syntax preference. | |
1307 | If called interactively or if SYMBOL is nil, sets syntax preference in current | |
3af0304a | 1308 | buffer. If called non-interactively, preferably via the customization widget, |
34317da2 | 1309 | sets the default value." |
e0c82342 | 1310 | (interactive) |
34317da2 MK |
1311 | (or value |
1312 | (setq value | |
1313 | (completing-read | |
1314 | "Viper syntax preference: " | |
1315 | '(("strict-vi") ("reformed-vi") ("extended") ("emacs")) | |
1316 | nil 'require-match))) | |
1317 | (if (stringp value) (setq value (intern value))) | |
1318 | (or (memq value '(strict-vi reformed-vi extended emacs)) | |
1319 | (error "Invalid Viper syntax preference, %S" value)) | |
1320 | (if symbol | |
1321 | (setq-default viper-syntax-preference value) | |
1322 | (setq viper-syntax-preference value)) | |
1323 | (viper-update-syntax-classes)) | |
1324 | ||
1325 | (defcustom viper-syntax-preference 'reformed-vi | |
1326 | "*Syntax type characterizing Viper's alphanumeric symbols. | |
1327 | Affects movement and change commands that deal with Vi-style words. | |
1328 | Works best when set in the hooks to various major modes. | |
1329 | ||
1330 | `strict-vi' means Viper words are (hopefully) exactly as in Vi. | |
1331 | ||
1332 | `reformed-vi' means Viper words are like Emacs words \(as determined using | |
1333 | Emacs syntax tables, which are different for different major modes\) with two | |
1334 | exceptions: the symbol `_' is always part of a word and typical Vi non-word | |
1335 | symbols, such as `,',:,\",),{, etc., are excluded. | |
1336 | This behaves very close to `strict-vi', but also works well with non-ASCII | |
1337 | characters from various alphabets. | |
1338 | ||
1339 | `extended' means Viper word constituents are symbols that are marked as being | |
1340 | parts of words OR symbols in Emacs syntax tables. | |
1341 | This is most appropriate for major modes intended for editing programs. | |
1342 | ||
1343 | `emacs' means Viper words are the same as Emacs words as specified by Emacs | |
1344 | syntax tables. | |
1345 | This option is appropriate if you like Emacs-style words." | |
a1506d29 | 1346 | :type '(radio (const strict-vi) (const reformed-vi) |
34317da2 MK |
1347 | (const extended) (const emacs)) |
1348 | :set 'viper-set-syntax-preference | |
1349 | :group 'viper) | |
1350 | (make-variable-buffer-local 'viper-syntax-preference) | |
1351 | ||
e0c82342 MK |
1352 | |
1353 | ;; addl-chars are characters to be temporarily considered as alphanumerical | |
8626cfa2 | 1354 | (defun viper-looking-at-alpha (&optional addl-chars) |
e0c82342 | 1355 | (or (stringp addl-chars) (setq addl-chars "")) |
8626cfa2 | 1356 | (if (eq viper-syntax-preference 'reformed-vi) |
e0c82342 MK |
1357 | (setq addl-chars (concat addl-chars "_"))) |
1358 | (let ((char (char-after (point)))) | |
1359 | (if char | |
8626cfa2 MK |
1360 | (if (eq viper-syntax-preference 'strict-vi) |
1361 | (looking-at (concat "[" viper-strict-ALPHA-chars addl-chars "]")) | |
34317da2 MK |
1362 | (or |
1363 | ;; or one of the additional chars being asked to include | |
657f9cb8 | 1364 | (viper-memq-char char (viper-string-to-list addl-chars)) |
34317da2 | 1365 | (and |
657f9cb8 MK |
1366 | ;; not one of the excluded word chars (note: |
1367 | ;; viper-non-word-characters is a list) | |
1368 | (not (viper-memq-char char viper-non-word-characters)) | |
34317da2 | 1369 | ;; char of the Viper-word syntax class |
657f9cb8 MK |
1370 | (viper-memq-char (char-syntax char) |
1371 | (viper-string-to-list viper-ALPHA-char-class)))))) | |
e0c82342 MK |
1372 | )) |
1373 | ||
8626cfa2 | 1374 | (defun viper-looking-at-separator () |
e0c82342 MK |
1375 | (let ((char (char-after (point)))) |
1376 | (if char | |
34317da2 | 1377 | (if (eq viper-syntax-preference 'strict-vi) |
657f9cb8 | 1378 | (viper-memq-char char (viper-string-to-list viper-strict-SEP-chars)) |
34317da2 | 1379 | (or (eq char ?\n) ; RET is always a separator in Vi |
657f9cb8 MK |
1380 | (viper-memq-char (char-syntax char) |
1381 | (viper-string-to-list viper-SEP-char-class))))) | |
34317da2 | 1382 | )) |
e0c82342 | 1383 | |
8626cfa2 MK |
1384 | (defsubst viper-looking-at-alphasep (&optional addl-chars) |
1385 | (or (viper-looking-at-separator) (viper-looking-at-alpha addl-chars))) | |
e0c82342 | 1386 | |
8626cfa2 | 1387 | (defun viper-skip-alpha-forward (&optional addl-chars) |
e0c82342 | 1388 | (or (stringp addl-chars) (setq addl-chars "")) |
8626cfa2 | 1389 | (viper-skip-syntax |
a1506d29 | 1390 | 'forward |
8626cfa2 | 1391 | (cond ((eq viper-syntax-preference 'strict-vi) |
e0c82342 | 1392 | "") |
985d0dad | 1393 | (t viper-ALPHA-char-class)) |
8626cfa2 MK |
1394 | (cond ((eq viper-syntax-preference 'strict-vi) |
1395 | (concat viper-strict-ALPHA-chars addl-chars)) | |
e0c82342 MK |
1396 | (t addl-chars)))) |
1397 | ||
8626cfa2 | 1398 | (defun viper-skip-alpha-backward (&optional addl-chars) |
e0c82342 | 1399 | (or (stringp addl-chars) (setq addl-chars "")) |
8626cfa2 | 1400 | (viper-skip-syntax |
a1506d29 | 1401 | 'backward |
8626cfa2 | 1402 | (cond ((eq viper-syntax-preference 'strict-vi) |
e0c82342 | 1403 | "") |
985d0dad | 1404 | (t viper-ALPHA-char-class)) |
8626cfa2 MK |
1405 | (cond ((eq viper-syntax-preference 'strict-vi) |
1406 | (concat viper-strict-ALPHA-chars addl-chars)) | |
e0c82342 MK |
1407 | (t addl-chars)))) |
1408 | ||
1409 | ;; weird syntax tables may confuse strict-vi style | |
8626cfa2 | 1410 | (defsubst viper-skip-all-separators-forward (&optional within-line) |
34317da2 | 1411 | (if (eq viper-syntax-preference 'strict-vi) |
a1506d29 | 1412 | (if within-line |
34317da2 MK |
1413 | (skip-chars-forward viper-strict-SEP-chars-sans-newline) |
1414 | (skip-chars-forward viper-strict-SEP-chars)) | |
1415 | (viper-skip-syntax 'forward | |
1416 | viper-SEP-char-class | |
1417 | (or within-line "\n") | |
1418 | (if within-line (viper-line-pos 'end))))) | |
15c77b9e | 1419 | |
8626cfa2 | 1420 | (defsubst viper-skip-all-separators-backward (&optional within-line) |
34317da2 | 1421 | (if (eq viper-syntax-preference 'strict-vi) |
a1506d29 | 1422 | (if within-line |
34317da2 MK |
1423 | (skip-chars-backward viper-strict-SEP-chars-sans-newline) |
1424 | (skip-chars-backward viper-strict-SEP-chars)) | |
1425 | (viper-skip-syntax 'backward | |
1426 | viper-SEP-char-class | |
1427 | (or within-line "\n") | |
1428 | (if within-line (viper-line-pos 'start))))) | |
8626cfa2 | 1429 | (defun viper-skip-nonseparators (direction) |
34317da2 MK |
1430 | (viper-skip-syntax |
1431 | direction | |
1432 | (concat "^" viper-SEP-char-class) | |
1433 | nil | |
1434 | (viper-line-pos (if (eq direction 'forward) 'end 'start)))) | |
1435 | ||
e0c82342 | 1436 | |
34317da2 | 1437 | ;; skip over non-word constituents and non-separators |
8626cfa2 MK |
1438 | (defun viper-skip-nonalphasep-forward () |
1439 | (if (eq viper-syntax-preference 'strict-vi) | |
e0c82342 | 1440 | (skip-chars-forward |
8626cfa2 | 1441 | (concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars)) |
34317da2 MK |
1442 | (viper-skip-syntax |
1443 | 'forward | |
1444 | (concat "^" viper-ALPHA-char-class viper-SEP-char-class) | |
1445 | ;; Emacs may consider some of these as words, but we don't want them | |
a1506d29 | 1446 | viper-non-word-characters |
34317da2 | 1447 | (viper-line-pos 'end)))) |
15c77b9e | 1448 | |
8626cfa2 MK |
1449 | (defun viper-skip-nonalphasep-backward () |
1450 | (if (eq viper-syntax-preference 'strict-vi) | |
e0c82342 | 1451 | (skip-chars-backward |
8626cfa2 | 1452 | (concat "^" viper-strict-SEP-chars viper-strict-ALPHA-chars)) |
34317da2 MK |
1453 | (viper-skip-syntax |
1454 | 'backward | |
1455 | (concat "^" viper-ALPHA-char-class viper-SEP-char-class) | |
1456 | ;; Emacs may consider some of these as words, but we don't want them | |
1457 | viper-non-word-characters | |
8626cfa2 | 1458 | (viper-line-pos 'start)))) |
e0c82342 MK |
1459 | |
1460 | ;; Skip SYNTAX like skip-syntax-* and ADDL-CHARS like skip-chars-* | |
1461 | ;; Return the number of chars traveled. | |
34317da2 MK |
1462 | ;; Both SYNTAX or ADDL-CHARS can be strings or lists of characters. |
1463 | ;; When SYNTAX is "w", then viper-non-word-characters are not considered to be | |
1464 | ;; words, even if Emacs syntax table says they are. | |
8626cfa2 | 1465 | (defun viper-skip-syntax (direction syntax addl-chars &optional limit) |
e0c82342 MK |
1466 | (let ((total 0) |
1467 | (local 1) | |
34317da2 MK |
1468 | (skip-chars-func |
1469 | (if (eq direction 'forward) | |
1470 | 'skip-chars-forward 'skip-chars-backward)) | |
1471 | (skip-syntax-func | |
1472 | (if (eq direction 'forward) | |
1473 | 'viper-forward-char-carefully 'viper-backward-char-carefully)) | |
1474 | char-looked-at syntax-of-char-looked-at negated-syntax) | |
1475 | (setq addl-chars | |
1476 | (cond ((listp addl-chars) (viper-charlist-to-string addl-chars)) | |
1477 | ((stringp addl-chars) addl-chars) | |
1478 | (t ""))) | |
1479 | (setq syntax | |
1480 | (cond ((listp syntax) syntax) | |
1481 | ((stringp syntax) (viper-string-to-list syntax)) | |
1482 | (t nil))) | |
1483 | (if (memq ?^ syntax) (setq negated-syntax t)) | |
1484 | ||
a1506d29 JB |
1485 | (while (and (not (= local 0)) |
1486 | (cond ((eq direction 'forward) | |
63b98362 KH |
1487 | (not (eobp))) |
1488 | (t (not (bobp))))) | |
34317da2 MK |
1489 | (setq char-looked-at (viper-char-at-pos direction) |
1490 | ;; if outside the range, set to nil | |
1491 | syntax-of-char-looked-at (if char-looked-at | |
1492 | (char-syntax char-looked-at))) | |
e0c82342 | 1493 | (setq local |
34317da2 MK |
1494 | (+ (if (and |
1495 | (cond ((and limit (eq direction 'forward)) | |
1496 | (< (point) limit)) | |
1497 | (limit ; backward & limit | |
1498 | (> (point) limit)) | |
1499 | (t t)) ; no limit | |
1500 | ;; char under/before cursor has appropriate syntax | |
1501 | (if negated-syntax | |
1502 | (not (memq syntax-of-char-looked-at syntax)) | |
1503 | (memq syntax-of-char-looked-at syntax)) | |
1504 | ;; if char-syntax class is "word", make sure it is not one | |
1505 | ;; of the excluded characters | |
1506 | (if (and (eq syntax-of-char-looked-at ?w) | |
1507 | (not negated-syntax)) | |
657f9cb8 MK |
1508 | (not (viper-memq-char |
1509 | char-looked-at viper-non-word-characters)) | |
34317da2 MK |
1510 | t)) |
1511 | (funcall skip-syntax-func 1) | |
1512 | 0) | |
e0c82342 MK |
1513 | (funcall skip-chars-func addl-chars limit))) |
1514 | (setq total (+ total local))) | |
1515 | total | |
1516 | )) | |
e0c82342 | 1517 | |
15c77b9e MK |
1518 | ;; tells when point is at the beginning of field |
1519 | (defun viper-beginning-of-field () | |
1520 | (or (bobp) | |
1521 | (not (eq (get-char-property (point) 'field) | |
1522 | (get-char-property (1- (point)) 'field))))) | |
1523 | ||
a1506d29 | 1524 | |
8ea74b0e MK |
1525 | ;; this is copied from cl-extra.el |
1526 | ;; Return the subsequence of SEQ from START to END. | |
1527 | ;; If END is omitted, it defaults to the length of the sequence. | |
1528 | ;; If START or END is negative, it counts from the end. | |
1529 | (defun viper-subseq (seq start &optional end) | |
1530 | (if (stringp seq) (substring seq start end) | |
1531 | (let (len) | |
1532 | (and end (< end 0) (setq end (+ end (setq len (length seq))))) | |
1533 | (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) | |
1534 | (cond ((listp seq) | |
1535 | (if (> start 0) (setq seq (nthcdr start seq))) | |
1536 | (if end | |
1537 | (let ((res nil)) | |
1538 | (while (>= (setq end (1- end)) start) | |
1539 | (push (pop seq) res)) | |
1540 | (nreverse res)) | |
1541 | (copy-sequence seq))) | |
1542 | (t | |
1543 | (or end (setq end (or len (length seq)))) | |
1544 | (let ((res (make-vector (max (- end start) 0) nil)) | |
1545 | (i 0)) | |
1546 | (while (< start end) | |
1547 | (aset res i (aref seq start)) | |
1548 | (setq i (1+ i) start (1+ start))) | |
1549 | res)))))) | |
1550 | ||
1551 | ||
a1506d29 | 1552 | |
fa043571 SM |
1553 | ;; Local Variables: |
1554 | ;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) | |
1555 | ;; End: | |
6c2e12f4 | 1556 | |
cbee283d | 1557 | ;; arch-tag: 7f023fd5-dd9e-4378-a397-9c179553b0e3 |
60370d40 | 1558 | ;;; viper-util.el ends here |