Mercurial > emacs
annotate lisp/emulation/viper-util.el @ 12702:b0355a012c1d
(ada-imenu-generic-expression): Var defined.
(ada-mode): Set imenu-generic-expression.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Fri, 28 Jul 1995 00:18:42 +0000 |
parents | 321b2ad48a9c |
children | e0dfd3c3837e |
rev | line source |
---|---|
10789 | 1 ;;; viper-util.el --- Utilities used by viper.el |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
2 ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. |
11288 | 3 |
10789 | 4 ;; This file is part of GNU Emacs. |
5 | |
6 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
7 ;; it under the terms of the GNU General Public License as published by | |
8 ;; the Free Software Foundation; either version 2, or (at your option) | |
9 ;; any later version. | |
10 | |
11 ;; GNU Emacs is distributed in the hope that it will be useful, | |
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 ;; GNU General Public License for more details. | |
15 | |
16 ;; You should have received a copy of the GNU General Public License | |
17 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
19 | |
20 (require 'ring) | |
21 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
22 ;; Whether it is XEmacs or not |
12204
a7bd91d4af97
(vip-over-whitespace-line): new function.
Karl Heuer <kwzh@gnu.org>
parents:
12139
diff
changeset
|
23 (defconst vip-xemacs-p (string-match "\\(Lucid\\|XEmacs\\)" emacs-version)) |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
24 ;; Whether it is Emacs or not |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
25 (defconst vip-emacs-p (not vip-xemacs-p)) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
26 ;; Tell whether we are running as a window application or on a TTY |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
27 (defsubst vip-device-type () |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
28 (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
|
29 window-system |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
30 (device-type (selected-device)))) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
31 ;; in XEmacs: device-type is tty on tty and stream in batch. |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
32 (defsubst 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
|
33 (and (vip-device-type) (not (memq (vip-device-type) '(tty stream))))) |
10789 | 34 |
35 | |
36 ;;; Macros | |
37 | |
38 (defmacro vip-deflocalvar (var default-value &optional documentation) | |
39 (` (progn | |
40 (defvar (, var) (, default-value) | |
41 (, (format "%s\n\(buffer local\)" documentation))) | |
42 (make-variable-buffer-local '(, var)) | |
43 ))) | |
44 | |
45 (defmacro vip-loop (count body) | |
46 "(vip-loop COUNT BODY) Execute BODY COUNT times." | |
47 (list 'let (list (list 'count count)) | |
48 (list 'while '(> count 0) | |
49 body | |
50 '(setq count (1- count)) | |
51 ))) | |
52 | |
53 (defmacro vip-buffer-live-p (buf) | |
54 (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf)))))) | |
55 | |
56 ;; return buffer-specific macro definition, given a full macro definition | |
57 (defmacro vip-kbd-buf-alist (macro-elt) | |
58 (` (nth 1 (, macro-elt)))) | |
59 ;; get a pair: (curr-buffer . macro-definition) | |
60 (defmacro vip-kbd-buf-pair (macro-elt) | |
61 (` (assoc (buffer-name) (vip-kbd-buf-alist (, macro-elt))))) | |
62 ;; get macro definition for current buffer | |
63 (defmacro vip-kbd-buf-definition (macro-elt) | |
64 (` (cdr (vip-kbd-buf-pair (, macro-elt))))) | |
65 | |
66 ;; return mode-specific macro definitions, given a full macro definition | |
67 (defmacro vip-kbd-mode-alist (macro-elt) | |
68 (` (nth 2 (, macro-elt)))) | |
69 ;; get a pair: (major-mode . macro-definition) | |
70 (defmacro vip-kbd-mode-pair (macro-elt) | |
71 (` (assoc major-mode (vip-kbd-mode-alist (, macro-elt))))) | |
72 ;; get macro definition for the current major mode | |
73 (defmacro vip-kbd-mode-definition (macro-elt) | |
74 (` (cdr (vip-kbd-mode-pair (, macro-elt))))) | |
75 | |
76 ;; return global macro definition, given a full macro definition | |
77 (defmacro vip-kbd-global-pair (macro-elt) | |
78 (` (nth 3 (, macro-elt)))) | |
79 ;; get global macro definition from an elt of macro-alist | |
80 (defmacro vip-kbd-global-definition (macro-elt) | |
81 (` (cdr (vip-kbd-global-pair (, macro-elt))))) | |
82 | |
83 ;; last elt of a sequence | |
84 (defsubst vip-seq-last-elt (seq) | |
85 (elt seq (1- (length seq)))) | |
86 | |
87 ;; Check if arg is a valid character for register | |
88 ;; TYPE is a list that can contain `letter', `Letter', and `digit'. | |
89 ;; Letter means lowercase letters, Letter means uppercase letters, and | |
90 ;; digit means digits from 1 to 9. | |
91 ;; If TYPE is nil, then down/uppercase letters and digits are allowed. | |
92 (defun vip-valid-register (reg &optional type) | |
93 (or type (setq type '(letter Letter digit))) | |
94 (or (if (memq 'letter type) | |
95 (and (<= ?a reg) (<= reg ?z))) | |
96 (if (memq 'digit type) | |
97 (and (<= ?1 reg) (<= reg ?9))) | |
98 (if (memq 'Letter type) | |
99 (and (<= ?A reg) (<= reg ?Z))) | |
100 )) | |
101 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
102 ;; checks if object is a marker, has a buffer, and points to within that buffer |
10789 | 103 (defun vip-valid-marker (marker) |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
104 (if (and (markerp marker) (marker-buffer marker)) |
10789 | 105 (let ((buf (marker-buffer marker)) |
106 (pos (marker-position marker))) | |
107 (save-excursion | |
108 (set-buffer buf) | |
109 (and (<= pos (point-max)) (<= (point-min) pos)))))) | |
110 | |
111 | |
112 (defvar vip-minibuffer-overlay-priority 300) | |
113 (defvar vip-replace-overlay-priority 400) | |
114 (defvar vip-search-overlay-priority 500) | |
115 | |
116 | |
117 ;;; XEmacs support | |
118 | |
119 (if vip-xemacs-p | |
120 (progn | |
121 (fset 'vip-read-event (symbol-function 'next-command-event)) | |
122 (fset 'vip-make-overlay (symbol-function 'make-extent)) | |
123 (fset 'vip-overlay-start (symbol-function 'extent-start-position)) | |
124 (fset 'vip-overlay-end (symbol-function 'extent-end-position)) | |
125 (fset 'vip-overlay-put (symbol-function 'set-extent-property)) | |
126 (fset 'vip-overlay-p (symbol-function 'extentp)) | |
127 (fset 'vip-overlay-get (symbol-function 'extent-property)) | |
128 (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
|
129 (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
|
130 (fset 'vip-iconify (symbol-function 'iconify-frame))) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
131 (cond ((vip-window-display-p) |
10789 | 132 (fset 'vip-get-face (symbol-function 'get-face)) |
133 (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
|
134 (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
|
135 ))) |
10789 | 136 (fset 'vip-read-event (symbol-function 'read-event)) |
137 (fset 'vip-make-overlay (symbol-function 'make-overlay)) | |
138 (fset 'vip-overlay-start (symbol-function 'overlay-start)) | |
139 (fset 'vip-overlay-end (symbol-function 'overlay-end)) | |
140 (fset 'vip-overlay-put (symbol-function 'overlay-put)) | |
141 (fset 'vip-overlay-p (symbol-function 'overlayp)) | |
142 (fset 'vip-overlay-get (symbol-function 'overlay-get)) | |
143 (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
|
144 (if (vip-window-display-p) |
10789 | 145 (fset 'vip-iconify (symbol-function 'iconify-or-deiconify-frame))) |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
146 (cond ((vip-window-display-p) |
10789 | 147 (fset 'vip-get-face (symbol-function 'internal-get-face)) |
148 (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
|
149 ))) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
150 |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
151 (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
|
152 (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
|
153 (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
|
154 (eq (device-class (selected-device)) 'color))) |
10789 | 155 |
156 ;; OS/2 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
157 (cond ((eq (vip-device-type) 'pm) |
10789 | 158 (fset 'vip-color-defined-p |
159 (function (lambda (color) (assoc color pm-color-alist)))))) | |
160 | |
161 ;; needed to smooth out the difference between Emacs and XEmacs | |
162 (defsubst vip-italicize-face (face) | |
163 (if vip-xemacs-p | |
164 (make-face-italic face) | |
165 (make-face-italic face nil 'noerror))) | |
166 | |
167 ;; test if display is color and the colors are defined | |
168 (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
|
169 (if (vip-color-display-p) |
10789 | 170 (not (memq nil (mapcar 'vip-color-defined-p colors))) |
171 )) | |
172 | |
173 ;; currently doesn't work for XEmacs | |
174 (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
|
175 (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
|
176 (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
|
177 (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
|
178 (modify-frame-parameters |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
179 (selected-frame) (list (cons 'cursor-color new-color))))) |
10789 | 180 |
181 (defsubst 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
|
182 (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
|
183 (let ((color (vip-get-cursor-color))) |
10789 | 184 (if (and (stringp color) (vip-color-defined-p color) |
185 (not (string= color vip-replace-overlay-cursor-color))) | |
186 (vip-overlay-put vip-replace-overlay 'vip-cursor-color color))))) | |
187 | |
188 (defsubst vip-restore-cursor-color () | |
189 (vip-change-cursor-color | |
190 (vip-overlay-get vip-replace-overlay 'vip-cursor-color))) | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
191 |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
192 (defsubst 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
|
193 (cdr (assoc 'cursor-color (frame-parameters)))) |
10789 | 194 |
195 | |
196 ;; Check the current version against the major and minor version numbers | |
197 ;; using op: cur-vers op major.minor If emacs-major-version or | |
198 ;; emacs-minor-version are not defined, we assume that the current version | |
199 ;; is hopelessly outdated. We assume that emacs-major-version and | |
200 ;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the | |
201 ;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value | |
202 ;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be | |
203 ;; incorrect. However, this gives correct result in our cases, since we are | |
204 ;; testing for sufficiently high Emacs versions. | |
205 (defun vip-check-version (op major minor &optional type-of-emacs) | |
206 (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version)) | |
207 (and (cond ((eq type-of-emacs 'xemacs) vip-xemacs-p) | |
208 ((eq type-of-emacs 'emacs) vip-emacs-p) | |
209 (t t)) | |
210 (cond ((eq op '=) (and (= emacs-minor-version minor) | |
211 (= emacs-major-version major))) | |
212 ((memq op '(> >= < <=)) | |
213 (and (or (funcall op emacs-major-version major) | |
214 (= emacs-major-version major)) | |
215 (if (= emacs-major-version major) | |
216 (funcall op emacs-minor-version minor) | |
217 t))) | |
218 (t | |
219 (error "%S: Invalid op in vip-check-version" op)))) | |
220 (cond ((memq op '(= > >=)) nil) | |
221 ((memq op '(< <=)) t)))) | |
12693
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
222 |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
223 ;;;; warn if it is a wrong version of emacs |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
224 ;;(if (or (vip-check-version '< 19 29 'emacs) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
225 ;; (vip-check-version '< 19 12 'xemacs)) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
226 ;; (progn |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
227 ;; (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
|
228 ;; (switch-to-buffer " *vip-info*") |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
229 ;; (insert |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
230 ;; (format " |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
231 ;; |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
232 ;;This version of Viper requires |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
233 ;; |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
234 ;;\t Emacs 19.29 and higher |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
235 ;;\t OR |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
236 ;;\t XEmacs 19.12 and higher |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
237 ;; |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
238 ;;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
|
239 ;;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
|
240 ;; |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
241 ;; (if noninteractive |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
242 ;; () |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
243 ;; (beep 1) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
244 ;; (beep 1) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
245 ;; (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
|
246 ;; (vip-read-event))) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
247 ;; (kill-buffer " *vip-info*"))) |
10789 | 248 |
249 | |
250 (defun vip-get-visible-buffer-window (wind) | |
251 (if vip-xemacs-p | |
252 (get-buffer-window wind t) | |
253 (get-buffer-window wind 'visible))) | |
254 | |
255 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
256 ;; Return line position. |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
257 ;; 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
|
258 ;; 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
|
259 ;; 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
|
260 ;; Otherwise, returns point. Current point is not moved in any case." |
10789 | 261 (defun vip-line-pos (pos) |
262 (let ((cur-pos (point)) | |
263 (result)) | |
264 (cond | |
265 ((equal pos 'start) | |
266 (beginning-of-line)) | |
267 ((equal pos 'end) | |
268 (end-of-line)) | |
269 ((equal pos 'mid) | |
270 (goto-char (+ (vip-line-pos 'start) (vip-line-pos 'end) 2))) | |
271 ((equal pos 'indent) | |
272 (back-to-indentation)) | |
273 (t nil)) | |
274 (setq result (point)) | |
275 (goto-char cur-pos) | |
276 result)) | |
277 | |
278 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
279 ;; 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
|
280 ;; 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
|
281 ;; 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
|
282 ;; |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
283 ;; 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
|
284 ;; 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
|
285 ;; 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
|
286 ;; buffer, a new marker will be created. |
10789 | 287 (defun vip-move-marker-locally (var pos &optional buffer) |
288 (if (markerp (eval var)) | |
289 () | |
290 (set var (make-marker))) | |
291 (move-marker (eval var) pos buffer)) | |
292 | |
293 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
294 ;; Print CONDITIONS as a message. |
10789 | 295 (defun vip-message-conditions (conditions) |
296 (let ((case (car conditions)) (msg (cdr conditions))) | |
297 (if (null msg) | |
298 (message "%s" case) | |
299 (message "%s: %s" case (mapconcat 'prin1-to-string msg " "))) | |
300 (beep 1))) | |
301 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
302 |
10789 | 303 |
304 ;;; List/alist utilities | |
305 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
306 ;; Convert LIST to an alist |
10789 | 307 (defun vip-list-to-alist (lst) |
308 (let ((alist)) | |
309 (while lst | |
310 (setq alist (cons (list (car lst)) alist)) | |
311 (setq lst (cdr lst))) | |
312 alist)) | |
313 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
314 ;; Convert ALIST to a list. |
10789 | 315 (defun vip-alist-to-list (alst) |
316 (let ((lst)) | |
317 (while alst | |
318 (setq lst (cons (car (car alst)) lst)) | |
319 (setq alst (cdr alst))) | |
320 lst)) | |
321 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
322 ;; Filter ALIST using REGEXP. Return alist whose elements match the regexp. |
10789 | 323 (defun vip-filter-alist (regexp alst) |
324 (interactive "s x") | |
325 (let ((outalst) (inalst alst)) | |
326 (while (car inalst) | |
327 (if (string-match regexp (car (car inalst))) | |
328 (setq outalst (cons (car inalst) outalst))) | |
329 (setq inalst (cdr inalst))) | |
330 outalst)) | |
331 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
332 ;; Filter LIST using REGEXP. Return list whose elements match the regexp. |
10789 | 333 (defun vip-filter-list (regexp lst) |
334 (interactive "s x") | |
335 (let ((outlst) (inlst lst)) | |
336 (while (car inlst) | |
337 (if (string-match regexp (car inlst)) | |
338 (setq outlst (cons (car inlst) outlst))) | |
339 (setq inlst (cdr inlst))) | |
340 outlst)) | |
341 | |
342 | |
343 ;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1 | |
344 ;; LIS2 is modified by filtering it: deleting its members of the form | |
345 ;; \(car elt\) such that (car elt') is in LIS1. | |
346 (defun vip-append-filter-alist (lis1 lis2) | |
347 (let ((temp lis1) | |
348 elt) | |
349 | |
350 ;;filter-append the second list | |
351 (while temp | |
352 ;; delete all occurrences | |
353 (while (setq elt (assoc (car (car temp)) lis2)) | |
354 (setq lis2 (delq elt lis2))) | |
355 (setq temp (cdr temp))) | |
356 | |
357 (nconc lis1 lis2))) | |
358 | |
359 | |
360 | |
361 | |
362 ;;; Insertion ring | |
363 | |
364 ;; Rotate RING's index. DIRection can be positive or negative. | |
365 (defun vip-ring-rotate1 (ring dir) | |
366 (if (and (ring-p ring) (> (ring-length ring) 0)) | |
367 (progn | |
368 (setcar ring (cond ((> dir 0) | |
369 (ring-plus1 (car ring) (ring-length ring))) | |
370 ((< dir 0) | |
371 (ring-minus1 (car ring) (ring-length ring))) | |
372 ;; don't rotate if dir = 0 | |
373 (t (car ring)))) | |
374 (vip-current-ring-item ring) | |
375 ))) | |
376 | |
377 (defun vip-special-ring-rotate1 (ring dir) | |
378 (if (memq vip-intermediate-command | |
379 '(repeating-display-destructive-command | |
380 repeating-insertion-from-ring)) | |
381 (vip-ring-rotate1 ring dir) | |
382 ;; don't rotate otherwise | |
383 (vip-ring-rotate1 ring 0))) | |
384 | |
385 ;; current ring item; if N is given, then so many items back from the | |
386 ;; current | |
387 (defun vip-current-ring-item (ring &optional n) | |
388 (setq n (or n 0)) | |
389 (if (and (ring-p ring) (> (ring-length ring) 0)) | |
390 (aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring))))) | |
391 | |
392 ;; push item onto ring. the second argument is a ring-variable, not value. | |
393 (defun vip-push-onto-ring (item ring-var) | |
394 (or (ring-p (eval ring-var)) | |
395 (set ring-var (make-ring (eval (intern (format "%S-size" ring-var)))))) | |
396 (or (null item) ; don't push nil | |
397 (and (stringp item) (string= item "")) ; or empty strings | |
398 (equal item (vip-current-ring-item (eval ring-var))) ; or old stuff | |
399 ;; Since vip-set-destructive-command checks if we are inside vip-repeat, | |
400 ;; we don't check whether this-command-keys is a `.'. | |
401 ;; The cmd vip-repeat makes a call to the current function only if | |
402 ;; `.' is executing a command from the command history. It doesn't | |
403 ;; call the push-onto-ring function if `.' is simply repeating the | |
404 ;; last destructive command. | |
405 ;; We only check for ESC (which happens when we do insert with a | |
406 ;; prefix argument, or if this-command-keys doesn't give anything | |
407 ;; meaningful (in that case we don't know what to show to the user). | |
408 (and (eq ring-var 'vip-command-ring) | |
409 (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)" | |
410 (vip-array-to-string (this-command-keys)))) | |
411 (vip-ring-insert (eval ring-var) item)) | |
412 ) | |
413 | |
414 | |
415 ;; removing elts from ring seems to break it | |
416 (defun vip-cleanup-ring (ring) | |
417 (or (< (ring-length ring) 2) | |
418 (null (vip-current-ring-item ring)) | |
419 ;; last and previous equal | |
420 (if (equal (vip-current-ring-item ring) (vip-current-ring-item ring 1)) | |
421 (vip-ring-pop ring)))) | |
422 | |
423 ;; ring-remove seems to be buggy, so we concocted this for our purposes. | |
424 (defun vip-ring-pop (ring) | |
425 (let* ((ln (ring-length ring)) | |
426 (vec (cdr (cdr ring))) | |
427 (veclen (length vec)) | |
428 (hd (car ring)) | |
429 (idx (max 0 (ring-minus1 hd ln))) | |
430 (top-elt (aref vec idx))) | |
431 | |
432 ;; shift elements | |
433 (while (< (1+ idx) veclen) | |
434 (aset vec idx (aref vec (1+ idx))) | |
435 (setq idx (1+ idx))) | |
436 (aset vec idx nil) | |
437 | |
438 (setq hd (max 0 (ring-minus1 hd ln))) | |
439 (if (= hd (1- ln)) (setq hd 0)) | |
440 (setcar ring hd) ; move head | |
441 (setcar (cdr ring) (max 0 (1- ln))) ; adjust length | |
442 top-elt | |
443 )) | |
444 | |
445 (defun vip-ring-insert (ring item) | |
446 (let* ((ln (ring-length ring)) | |
447 (vec (cdr (cdr ring))) | |
448 (veclen (length vec)) | |
449 (hd (car ring)) | |
450 (vecpos-after-hd (if (= hd 0) ln hd)) | |
451 (idx ln)) | |
452 | |
453 (if (= ln veclen) | |
454 (progn | |
455 (aset vec hd item) ; hd is always 1+ the actual head index in vec | |
456 (setcar ring (ring-plus1 hd ln))) | |
457 (setcar (cdr ring) (1+ ln)) | |
458 (setcar ring (ring-plus1 vecpos-after-hd (1+ ln))) | |
459 (while (and (>= idx vecpos-after-hd) (> ln 0)) | |
460 (aset vec idx (aref vec (1- idx))) | |
461 (setq idx (1- idx))) | |
462 (aset vec vecpos-after-hd item)) | |
463 item)) | |
464 | |
465 | |
466 ;;; String utilities | |
467 | |
468 ;; If STRING is longer than MAX-LEN, truncate it and print ...... instead | |
469 ;; PRE-STRING is a string to prepend to the abbrev string. | |
470 ;; POST-STRING is a string to append to the abbrev string. | |
471 ;; ABBREV_SIGN is a string to be inserted before POST-STRING | |
472 ;; if the orig string was truncated. | |
473 (defun vip-abbreviate-string (string max-len | |
474 pre-string post-string abbrev-sign) | |
475 (let (truncated-str) | |
476 (setq truncated-str | |
477 (if (stringp string) | |
478 (substring string 0 (min max-len (length string))))) | |
479 (cond ((null truncated-str) "") | |
480 ((> (length string) max-len) | |
481 (format "%s%s%s%s" | |
482 pre-string truncated-str abbrev-sign post-string)) | |
483 (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
|
484 |
a7bd91d4af97
(vip-over-whitespace-line): new function.
Karl Heuer <kwzh@gnu.org>
parents:
12139
diff
changeset
|
485 ;; 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
|
486 (defsubst vip-over-whitespace-line () |
a7bd91d4af97
(vip-over-whitespace-line): new function.
Karl Heuer <kwzh@gnu.org>
parents:
12139
diff
changeset
|
487 (save-excursion |
a7bd91d4af97
(vip-over-whitespace-line): new function.
Karl Heuer <kwzh@gnu.org>
parents:
12139
diff
changeset
|
488 (beginning-of-line) |
a7bd91d4af97
(vip-over-whitespace-line): new function.
Karl Heuer <kwzh@gnu.org>
parents:
12139
diff
changeset
|
489 (looking-at "^[ \t]*$"))) |
10789 | 490 |
491 | |
492 ;;; Saving settings in custom file | |
493 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
494 ;; 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
|
495 ;; 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
|
496 ;; 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
|
497 ;; Arguments: var message custom-file &optional erase-message |
10789 | 498 (defun vip-save-setting (var message custom-file &optional erase-msg) |
499 (let* ((var-name (symbol-name var)) | |
500 (var-val (if (boundp var) (eval var))) | |
501 (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name)) | |
502 (buf (find-file-noselect (substitute-in-file-name custom-file))) | |
503 ) | |
504 (message message) | |
505 (save-excursion | |
506 (set-buffer buf) | |
507 (goto-char (point-min)) | |
508 (if (re-search-forward regexp nil t) | |
509 (let ((reg-end (1- (match-end 0)))) | |
510 (search-backward var-name) | |
511 (delete-region (match-beginning 0) reg-end) | |
512 (goto-char (match-beginning 0)) | |
513 (insert (format "%s '%S" var-name var-val))) | |
514 (goto-char (point-max)) | |
515 (if (not (bolp)) (insert "\n")) | |
516 (insert (format "(setq %s '%S)\n" var-name var-val))) | |
517 (save-buffer)) | |
518 (kill-buffer buf) | |
519 (if erase-msg | |
520 (progn | |
521 (sit-for 2) | |
522 (message ""))) | |
523 )) | |
524 | |
525 ;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that | |
526 ;; match this pattern. | |
527 (defun vip-save-string-in-file (string custom-file &optional pattern) | |
528 (let ((buf (find-file-noselect (substitute-in-file-name custom-file)))) | |
529 (save-excursion | |
530 (set-buffer buf) | |
531 (goto-char (point-min)) | |
532 (if pattern (delete-matching-lines pattern)) | |
533 (goto-char (point-max)) | |
534 (if string (insert string)) | |
535 (save-buffer)) | |
536 (kill-buffer buf) | |
537 )) | |
538 | |
539 | |
540 ;;; Overlays | |
541 | |
542 ;; Search | |
543 | |
544 (defun vip-flash-search-pattern () | |
545 (if (vip-overlay-p vip-search-overlay) | |
546 (vip-move-overlay vip-search-overlay (match-beginning 0) (match-end 0)) | |
547 (setq vip-search-overlay | |
548 (vip-make-overlay | |
549 (match-beginning 0) (match-end 0) (current-buffer)))) | |
550 | |
551 (vip-overlay-put vip-search-overlay 'priority vip-search-overlay-priority) | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
552 (if (vip-window-display-p) |
10789 | 553 (progn |
554 (vip-overlay-put vip-search-overlay 'face vip-search-face) | |
555 (sit-for 2) | |
556 (vip-overlay-put vip-search-overlay 'face nil)))) | |
557 | |
558 ;; Replace state | |
559 | |
560 (defun vip-set-replace-overlay (beg end) | |
561 (if (vip-overlay-p vip-replace-overlay) | |
562 (vip-move-replace-overlay beg end) | |
563 (setq vip-replace-overlay (vip-make-overlay beg end (current-buffer))) | |
564 (vip-overlay-put vip-replace-overlay | |
565 'vip-start | |
566 (move-marker (make-marker) | |
567 (vip-overlay-start vip-replace-overlay))) | |
568 (vip-overlay-put vip-replace-overlay | |
569 'vip-end | |
570 (move-marker (make-marker) | |
571 (vip-overlay-end vip-replace-overlay))) | |
572 (vip-overlay-put | |
573 vip-replace-overlay 'priority vip-replace-overlay-priority)) | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
574 (if (vip-window-display-p) |
10789 | 575 (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face)) |
576 (vip-save-cursor-color) | |
577 (vip-change-cursor-color vip-replace-overlay-cursor-color) | |
578 ) | |
579 | |
580 | |
581 (defsubst vip-hide-replace-overlay () | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
582 (vip-set-replace-overlay-glyphs nil nil) |
10789 | 583 (vip-restore-cursor-color) |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
584 (if (vip-window-display-p) |
10789 | 585 (vip-overlay-put vip-replace-overlay 'face nil))) |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
586 |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
587 (defsubst vip-set-replace-overlay-glyphs (before-glyph after-glyph) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
588 (if (or (not (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
|
589 vip-use-replace-region-delimiters) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
590 (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
|
591 (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
|
592 (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
|
593 (vip-overlay-put vip-replace-overlay after-name after-glyph)))) |
10789 | 594 |
595 | |
596 (defsubst vip-replace-start () | |
597 (vip-overlay-get vip-replace-overlay 'vip-start)) | |
598 (defsubst vip-replace-end () | |
599 (vip-overlay-get vip-replace-overlay 'vip-end)) | |
600 | |
601 (defsubst vip-move-replace-overlay (beg end) | |
602 (vip-move-overlay vip-replace-overlay beg end) | |
603 (move-marker (vip-replace-start) (vip-overlay-start vip-replace-overlay)) | |
604 (move-marker (vip-replace-end) (vip-overlay-end vip-replace-overlay))) | |
605 | |
606 | |
607 ;; Minibuffer | |
608 | |
609 (defun vip-set-minibuffer-overlay () | |
610 (vip-check-minibuffer-overlay) | |
611 ;; We always move the minibuffer overlay, since in XEmacs | |
612 ;; this overlay may get detached. Moving will reattach it. | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
613 ;; This overlay is also moved via the vip-post-command-hook, |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
614 ;; to insure that it covers the whole minibuffer. |
10789 | 615 (vip-move-minibuffer-overlay) |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
616 (if (vip-window-display-p) |
10789 | 617 (progn |
618 (vip-overlay-put | |
619 vip-minibuffer-overlay 'face vip-minibuffer-current-face) | |
620 (vip-overlay-put | |
621 vip-minibuffer-overlay 'priority vip-minibuffer-overlay-priority)) | |
622 )) | |
623 | |
624 (defun vip-check-minibuffer-overlay () | |
625 (if (vip-overlay-p vip-minibuffer-overlay) | |
626 () | |
627 (setq vip-minibuffer-overlay | |
628 (vip-make-overlay 1 (1+ (buffer-size)) (current-buffer))))) | |
629 | |
630 ;; arguments to this function are dummies. they are needed just because | |
631 ;; it is used as a insert-in-front-hook to vip-minibuffer-overlay, and such | |
632 ;; hooks require 3 arguments. | |
633 (defun vip-move-minibuffer-overlay (&optional overl beg end) | |
634 (if (vip-is-in-minibuffer) | |
635 (progn | |
636 (vip-check-minibuffer-overlay) | |
637 (vip-move-overlay vip-minibuffer-overlay 1 (1+ (buffer-size)))))) | |
638 | |
639 (defsubst vip-is-in-minibuffer () | |
640 (string-match "\*Minibuf-" (buffer-name))) | |
641 | |
642 | |
643 | |
644 ;;; XEmacs compatibility | |
645 | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
646 ;; Sit for VAL miliseconds. XEmacs doesn't support the millisecond arg |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
647 ;; in sit-for, so this function smoothes out the differences. |
10789 | 648 (defsubst vip-sit-for-short (val &optional nodisp) |
649 (if vip-xemacs-p | |
650 (sit-for (/ val 1000.0) nodisp) | |
651 (sit-for 0 val nodisp))) | |
652 | |
653 ;; EVENT may be a single event of a sequence of events | |
654 (defsubst vip-ESC-event-p (event) | |
655 (let ((ESC-keys '(?\e (control \[) escape)) | |
656 (key (vip-event-key event))) | |
657 (member key ESC-keys))) | |
658 | |
659 ;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring) | |
660 ;; is the same as (mark t). | |
661 (defsubst vip-set-mark-if-necessary () | |
662 (setq mark-ring (delete (vip-mark-marker) mark-ring)) | |
663 (set-mark-command nil)) | |
664 | |
665 (defsubst vip-mark-marker () | |
666 (if vip-xemacs-p | |
667 (mark-marker t) | |
668 (mark-marker))) | |
669 | |
670 ;; In transient mark mode (zmacs mode), it is annoying when regions become | |
671 ;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless | |
672 ;; the user explicitly wants highlighting, e.g., by hitting '' or `` | |
673 (defun vip-deactivate-mark () | |
674 (if vip-xemacs-p | |
675 (zmacs-deactivate-region) | |
676 (deactivate-mark))) | |
677 | |
678 | |
679 (defsubst vip-events-to-keys (events) | |
680 (cond (vip-xemacs-p (events-to-keys events)) | |
681 (t events))) | |
682 | |
683 | |
684 (defun vip-eval-after-load (file form) | |
685 (if vip-emacs-p | |
686 (eval-after-load file form) | |
687 (or (assoc file after-load-alist) | |
688 (setq after-load-alist (cons (list file) after-load-alist))) | |
689 (let ((elt (assoc file after-load-alist))) | |
690 (or (member form (cdr elt)) | |
691 (setq elt (nconc elt (list form))))) | |
692 form | |
693 )) | |
12693
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
694 |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
695 ;; 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
|
696 ;; |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
697 ;;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
|
698 ;;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
|
699 ;;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
|
700 ;;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
|
701 ;;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
|
702 ;; |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
703 ;;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
|
704 ;;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
|
705 ;;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
|
706 (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
|
707 (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
|
708 ;; 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
|
709 (let ((old (symbol-value hook))) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
710 (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
|
711 (setq old (list old))) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
712 (if (member function old) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
713 nil |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
714 (set hook (if append |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
715 (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
|
716 (cons function old)))))) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
717 |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
718 ;; 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
|
719 ;; 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
|
720 ;; |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
721 ;; 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
|
722 ;; 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
|
723 ;; 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
|
724 ;; 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
|
725 (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
|
726 (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
|
727 (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
|
728 (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
|
729 nil ;Do nothing. |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
730 (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
|
731 (if (consp hook-value) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
732 ;; 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
|
733 (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
|
734 (if (equal hook-value function) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
735 (setq hook-value nil))) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
736 (set hook hook-value)))) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
737 |
10789 | 738 |
739 | |
740 ;; like read-event, but in XEmacs also try to convert to char, if possible | |
741 (defun vip-read-event-convert-to-char () | |
742 (let (event) | |
743 (if vip-emacs-p | |
744 (read-event) | |
745 (setq event (next-command-event)) | |
746 (or (event-to-character event) | |
747 event)) | |
748 )) | |
749 | |
12693
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
750 ;; 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
|
751 ;; keys. This does a better job than vip-read-event when it comes to kbd |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
752 ;; macros, since it enables certain macros to be shared between X and TTY |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
753 ;; modes. |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
754 (defun vip-read-key () |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
755 (let ((overriding-local-map vip-overriding-map) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
756 key) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
757 (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
|
758 (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
|
759 (use-global-map global-map) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
760 key)) |
321b2ad48a9c
(vip-add-hook,vip-remove-hook): new functions.
Michael Kifer <kifer@cs.stonybrook.edu>
parents:
12212
diff
changeset
|
761 |
10789 | 762 |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
763 ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil) |
10789 | 764 ;; instead of nil, if '(nil) was previously inadvertantly assigned to |
765 ;; unread-command-events | |
766 (defun vip-event-key (event) | |
767 (or (and event (eventp event)) | |
768 (error "vip-event-key: Wrong type argument, eventp, %S" event)) | |
769 (let ((mod (event-modifiers event)) | |
770 basis) | |
771 (setq basis | |
772 (cond | |
773 (vip-xemacs-p | |
774 (cond ((key-press-event-p event) | |
775 (event-key event)) | |
776 ((button-event-p event) | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
777 (concat "mouse-" (prin1-to-string (event-button event)))) |
10789 | 778 (t |
779 (error "vip-event-key: Unknown event, %S" event)))) | |
780 (t | |
781 ;; Emacs doesn't handle capital letters correctly, since | |
782 ;; \S-a isn't considered the same as A (it behaves as | |
783 ;; plain `a' instead). So we take care of this here | |
12139
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
784 (cond ((and (numberp event) (<= ?A event) (<= event ?Z)) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
785 (setq mod nil |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
786 event event)) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
787 ;; Emacs has the oddity whereby characters 128+char |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
788 ;; represent M-char *if* this appears inside a string. |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
789 ;; So, we convert them manually into (mata char). |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
790 ((and (numberp event) (< ?\C-? event) (<= event 255)) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
791 (setq mod '(meta) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
792 event (- event ?\C-? 1))) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
793 (t (event-basic-type event))) |
e16c06646396
(vip-event-key): now handles keys 128--255 as meta-chars.
Karl Heuer <kwzh@gnu.org>
parents:
11288
diff
changeset
|
794 ))) |
10789 | 795 |
796 (if (numberp basis) | |
797 (setq basis | |
798 (if (= basis ?\C-?) | |
799 (list 'control '\?) ; taking care of an emacs bug | |
800 (intern (char-to-string basis))))) | |
801 | |
802 (if mod | |
803 (append mod (list basis)) | |
804 basis) | |
805 )) | |
806 | |
807 (defun vip-key-to-emacs-key (key) | |
808 (let (key-name char-p modifiers mod-char-list base-key base-key-name) | |
809 (cond (vip-xemacs-p key) | |
810 ((symbolp key) | |
811 (setq key-name (symbol-name key)) | |
812 (if (= (length key-name) 1) ; character event | |
813 (string-to-char key-name) | |
814 key)) | |
815 ((listp key) | |
816 (setq modifiers (subseq key 0 (1- (length key))) | |
817 base-key (vip-seq-last-elt key) | |
818 base-key-name (symbol-name base-key) | |
819 char-p (= (length base-key-name) 1)) | |
820 (setq mod-char-list | |
821 (mapcar | |
822 '(lambda (elt) (upcase (substring (symbol-name elt) 0 1))) | |
823 modifiers)) | |
824 (if char-p | |
825 (setq key-name | |
826 (car (read-from-string | |
827 (concat | |
828 "?\\" | |
829 (mapconcat 'identity mod-char-list "-\\") | |
830 "-" | |
831 base-key-name)))) | |
832 (setq key-name | |
833 (intern | |
834 (concat | |
835 (mapconcat 'identity mod-char-list "-") | |
836 "-" | |
837 base-key-name)))))) | |
838 )) | |
839 | |
840 | |
841 ;; Args can be a sequence of events, a string, or a Viper macro. Will try to | |
842 ;; convert events to keys and, if all keys are regular printable | |
843 ;; characters, will return a string. Otherwise, will return a string | |
844 ;; representing a vector of converted events. If the input was a Viper macro, | |
845 ;; will return a string that represents this macro as a vector. | |
846 (defun vip-array-to-string (event-seq &optional representation) | |
847 (let (temp) | |
848 (cond ((stringp event-seq) event-seq) | |
849 ((vip-event-vector-p event-seq) | |
850 (setq temp (mapcar 'vip-event-key event-seq)) | |
851 (if (vip-char-symbol-sequence-p temp) | |
852 (mapconcat 'symbol-name temp "") | |
853 (prin1-to-string (vconcat temp)))) | |
854 ((vip-char-symbol-sequence-p event-seq) | |
855 (mapconcat 'symbol-name event-seq "")) | |
856 (t (prin1-to-string event-seq))))) | |
857 | |
858 | |
859 (defsubst vip-fast-keysequence-p () | |
860 (not (vip-sit-for-short vip-fast-keyseq-timeout t))) | |
861 | |
862 (defun vip-read-char-exclusive () | |
863 (let (char | |
864 (echo-keystrokes 1)) | |
865 (while (null char) | |
866 (condition-case nil | |
867 (setq char (read-char)) | |
868 (error | |
869 ;; skip event if not char | |
870 (vip-read-event)))) | |
871 char)) | |
872 | |
873 | |
874 | |
875 (defun vip-setup-master-buffer (&rest other-files-or-buffers) | |
876 "Set up the current buffer as a master buffer. | |
877 Arguments become related buffers. This function should normally be used in | |
878 the `Local variables' section of a file." | |
879 (setq vip-related-files-and-buffers-ring | |
880 (make-ring (1+ (length other-files-or-buffers)))) | |
881 (mapcar '(lambda (elt) | |
882 (vip-ring-insert vip-related-files-and-buffers-ring elt)) | |
883 other-files-or-buffers) | |
884 (vip-ring-insert vip-related-files-and-buffers-ring (buffer-name)) | |
885 ) | |
886 | |
887 | |
888 (provide 'viper-util) | |
889 | |
890 ;;; viper-util.el ends here |