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