annotate lisp/emulation/viper-util.el @ 12693:321b2ad48a9c

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