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