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