annotate lisp/viper/viper-util.el @ 26:441bb1e64a06 r19-15b96

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