Mercurial > emacs

comparison lisp/emulation/viper-mous.el @ 19079:dfbef8117c6a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
new version
author Michael Kifer <kifer@cs.stonybrook.edu>
date Sat, 02 Aug 1997 07:40:22 +0000
parents 1405083241e8
children 58c50205001d
comparison
equal deleted inserted replaced
19078:46326a66c27c 19079:dfbef8117c6a
24 (provide 'viper-mous) 24 (provide 'viper-mous)
25 25
26 ;; compiler pacifier 26 ;; compiler pacifier
27 (defvar double-click-time) 27 (defvar double-click-time)
28 (defvar mouse-track-multi-click-time) 28 (defvar mouse-track-multi-click-time)
29 (defvar vip-search-start-marker) 29 (defvar viper-search-start-marker)
30 (defvar vip-local-search-start-marker) 30 (defvar viper-local-search-start-marker)
31 (defvar vip-search-history) 31 (defvar viper-search-history)
32 (defvar vip-s-string) 32 (defvar viper-s-string)
33 (defvar vip-re-search) 33 (defvar viper-re-search)
34 34
35 ;; loading happens only in non-interactive compilation 35 ;; loading happens only in non-interactive compilation
36 ;; in order to spare non-viperized emacs from being viperized 36 ;; in order to spare non-viperized emacs from being viperized
37 (if noninteractive 37 (if noninteractive
38 (eval-when-compile 38 (eval-when-compile
47 (require 'viper-util) 47 (require 'viper-util)
48 48
49 49
50 (defgroup viper-mouse nil 50 (defgroup viper-mouse nil
51 "Support for Viper special mouse-bound commands" 51 "Support for Viper special mouse-bound commands"
52 :prefix "vip-" 52 :prefix "viper-"
53 :group 'viper) 53 :group 'viper)
54 54
55 55
56 ;;; Variables 56 ;;; Variables
57 57
58 ;; Variable used for catching the switch-frame event. 58 ;; Variable used for catching the switch-frame event.
59 ;; If non-nil, indicates that previous-frame should be the selected 59 ;; If non-nil, indicates that previous-frame should be the selected
60 ;; one. Used by vip-mouse-click-get-word. Not a user option. 60 ;; one. Used by viper-mouse-click-get-word. Not a user option.
61 (defvar vip-frame-of-focus nil) 61 (defvar viper-frame-of-focus nil)
62 62
63 ;; Frame that was selected before the switch-frame event. 63 ;; Frame that was selected before the switch-frame event.
64 (defconst vip-current-frame-saved (selected-frame)) 64 (defconst viper-current-frame-saved (selected-frame))
65 65
66 (defcustom vip-surrounding-word-function 'vip-surrounding-word 66 (defcustom viper-surrounding-word-function 'viper-surrounding-word
67 "*Function that determines what constitutes a word for clicking events. 67 "*Function that determines what constitutes a word for clicking events.
68 Takes two parameters: a COUNT, indicating how many words to return, 68 Takes two parameters: a COUNT, indicating how many words to return,
69 and CLICK-COUNT, telling whether this is the first click, a double-click, 69 and CLICK-COUNT, telling whether this is the first click, a double-click,
70 or a tripple-click." 70 or a tripple-click."
71 :type 'boolean 71 :type 'boolean
72 :group 'viper-mouse) 72 :group 'viper-mouse)
73 73
74 ;; time interval in millisecond within which successive clicks are 74 ;; time interval in millisecond within which successive clicks are
75 ;; considered related 75 ;; considered related
76 (defcustom vip-multiclick-timeout (if (vip-window-display-p) 76 (defcustom viper-multiclick-timeout (if (viper-window-display-p)
77 (if vip-xemacs-p 77 (if viper-xemacs-p
78 mouse-track-multi-click-time 78 mouse-track-multi-click-time
79 double-click-time) 79 double-click-time)
80 500) 80 500)
81 "*Time interval in millisecond within which successive mouse clicks are 81 "*Time interval in millisecond within which successive mouse clicks are
82 considered related." 82 considered related."
83 :type 'integer 83 :type 'integer
84 :group 'viper-mouse) 84 :group 'viper-mouse)
85 85
86 ;; current event click count; XEmacs only 86 ;; current event click count; XEmacs only
87 (defvar vip-current-click-count 0) 87 (defvar viper-current-click-count 0)
88 ;; time stamp of the last click event; XEmacs only 88 ;; time stamp of the last click event; XEmacs only
89 (defvar vip-last-click-event-timestamp 0) 89 (defvar viper-last-click-event-timestamp 0)
90 90
91 ;; Local variable used to toggle wraparound search on click. 91 ;; Local variable used to toggle wraparound search on click.
92 (vip-deflocalvar vip-mouse-click-search-noerror t) 92 (viper-deflocalvar viper-mouse-click-search-noerror t)
93 93
94 ;; Local variable used to delimit search after wraparound. 94 ;; Local variable used to delimit search after wraparound.
95 (vip-deflocalvar vip-mouse-click-search-limit nil) 95 (viper-deflocalvar viper-mouse-click-search-limit nil)
96 96
97 ;; remembers prefix argument to pass along to commands invoked by second 97 ;; remembers prefix argument to pass along to commands invoked by second
98 ;; click. 98 ;; click.
99 ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg 99 ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg
100 ;; causes Emacs to count the second click as if it was a single click 100 ;; causes Emacs to count the second click as if it was a single click
101 (defvar vip-global-prefix-argument nil) 101 (defvar viper-global-prefix-argument nil)
102
103
104 ;; same keys, but parsed
105 (defvar viper-mouse-up-search-key-parsed nil)
106 (defvar viper-mouse-down-search-key-parsed nil)
107 (defvar viper-mouse-up-insert-key-parsed nil)
108 (defvar viper-mouse-down-insert-key-parsed nil)
109
102 110
103 111
104 112
105 ;;; Code 113 ;;; Code
106 114
107 (defsubst vip-multiclick-p () 115 (defsubst viper-multiclick-p ()
108 (not (vip-sit-for-short vip-multiclick-timeout t))) 116 (not (viper-sit-for-short viper-multiclick-timeout t)))
109 117
110 ;; Returns window where click occurs 118 ;; Returns window where click occurs
111 (defsubst vip-mouse-click-window (click) 119 (defsubst viper-mouse-click-window (click)
112 (if vip-xemacs-p 120 (if viper-xemacs-p
113 (event-window click) 121 (event-window click)
114 (posn-window (event-start click)))) 122 (posn-window (event-start click))))
115 123
116 ;; Returns window where click occurs 124 ;; Returns window where click occurs
117 (defsubst vip-mouse-click-frame (click) 125 (defsubst viper-mouse-click-frame (click)
118 (window-frame (vip-mouse-click-window click))) 126 (window-frame (viper-mouse-click-window click)))
119 127
120 ;; Returns the buffer of the window where click occurs 128 ;; Returns the buffer of the window where click occurs
121 (defsubst vip-mouse-click-window-buffer (click) 129 (defsubst viper-mouse-click-window-buffer (click)
122 (window-buffer (vip-mouse-click-window click))) 130 (window-buffer (viper-mouse-click-window click)))
123 131
124 ;; Returns the name of the buffer in the window where click occurs 132 ;; Returns the name of the buffer in the window where click occurs
125 (defsubst vip-mouse-click-window-buffer-name (click) 133 (defsubst viper-mouse-click-window-buffer-name (click)
126 (buffer-name (vip-mouse-click-window-buffer click))) 134 (buffer-name (viper-mouse-click-window-buffer click)))
127 135
128 ;; Returns position of a click 136 ;; Returns position of a click
129 (defsubst vip-mouse-click-posn (click) 137 (defsubst viper-mouse-click-posn (click)
130 (if vip-xemacs-p 138 (if viper-xemacs-p
131 (event-point click) 139 (event-point click)
132 (posn-point (event-start click)))) 140 (posn-point (event-start click))))
133 141
134 142
135 (defun vip-surrounding-word (count click-count) 143 (defun viper-surrounding-word (count click-count)
136 "Returns word surrounding point according to a heuristic. 144 "Returns word surrounding point according to a heuristic.
137 COUNT indicates how many regions to return. 145 COUNT indicates how many regions to return.
138 If CLICK-COUNT is 1, `word' is a word in Vi sense. 146 If CLICK-COUNT is 1, `word' is a word in Vi sense.
139 If CLICK-COUNT is 2,then `word' is a Word in Vi sense. 147 If CLICK-COUNT is 2,then `word' is a Word in Vi sense.
140 If the character clicked on is a non-separator and is non-alphanumeric but 148 If the character clicked on is a non-separator and is non-alphanumeric but
151 beg skip-flag result 159 beg skip-flag result
152 word-beg) 160 word-beg)
153 (if (> click-count 2) 161 (if (> click-count 2)
154 (save-excursion 162 (save-excursion
155 (beginning-of-line) 163 (beginning-of-line)
156 (vip-skip-all-separators-forward 'within-line) 164 (viper-skip-all-separators-forward 'within-line)
157 (setq beg (point)) 165 (setq beg (point))
158 (end-of-line) 166 (end-of-line)
159 (setq result (buffer-substring beg (point)))) 167 (setq result (buffer-substring beg (point))))
160 168
161 (if (and (not (vip-looking-at-alphasep)) 169 (if (and (not (viper-looking-at-alphasep))
162 (or (save-excursion (vip-backward-char-carefully) 170 (or (save-excursion (viper-backward-char-carefully)
163 (vip-looking-at-alpha)) 171 (viper-looking-at-alpha))
164 (save-excursion (vip-forward-char-carefully) 172 (save-excursion (viper-forward-char-carefully)
165 (vip-looking-at-alpha)))) 173 (viper-looking-at-alpha))))
166 (setq modifiers 174 (setq modifiers
167 (cond ((looking-at "\\\\") "\\\\") 175 (cond ((looking-at "\\\\") "\\\\")
168 ((looking-at "-") "C-C-") 176 ((looking-at "-") "C-C-")
169 ((looking-at "[][]") "][") 177 ((looking-at "[][]") "][")
170 ((looking-at "[()]") ")(") 178 ((looking-at "[()]") ")(")
171 ((looking-at "[{}]") "{}") 179 ((looking-at "[{}]") "{}")
172 ((looking-at "[<>]") "<>") 180 ((looking-at "[<>]") "<>")
173 ((looking-at "[`']") "`'") 181 ((looking-at "[`']") "`'")
174 ((looking-at "\\^") "\\^") 182 ((looking-at "\\^") "\\^")
175 ((vip-looking-at-separator) "") 183 ((viper-looking-at-separator) "")
176 (t (char-to-string (following-char)))) 184 (t (char-to-string (following-char))))
177 )) 185 ))
178 186
179 ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp 187 ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp
180 (or (looking-at "-") 188 (or (looking-at "-")
181 (not (string-match "lisp" (symbol-name major-mode))) 189 (not (string-match "lisp" (symbol-name major-mode)))
182 (setq modifiers (concat modifiers "C-C-"))) 190 (setq modifiers (concat modifiers "C-C-")))
183 191
184 192
185 (save-excursion 193 (save-excursion
186 (cond ((> click-count 1) (vip-skip-nonseparators 'backward)) 194 (cond ((> click-count 1) (viper-skip-nonseparators 'backward))
187 ((vip-looking-at-alpha modifiers) 195 ((viper-looking-at-alpha modifiers)
188 (vip-skip-alpha-backward modifiers)) 196 (viper-skip-alpha-backward modifiers))
189 ((not (vip-looking-at-alphasep modifiers)) 197 ((not (viper-looking-at-alphasep modifiers))
190 (vip-skip-nonalphasep-backward)) 198 (viper-skip-nonalphasep-backward))
191 (t (if (> click-count 1) 199 (t (if (> click-count 1)
192 (vip-skip-nonseparators 'backward) 200 (viper-skip-nonseparators 'backward)
193 (vip-skip-alpha-backward modifiers)))) 201 (viper-skip-alpha-backward modifiers))))
194 202
195 (setq word-beg (point)) 203 (setq word-beg (point))
196 204
197 (setq skip-flag nil) ; don't move 1 char forw the first time 205 (setq skip-flag nil) ; don't move 1 char forw the first time
198 (while (> count 0) 206 (while (> count 0)
199 (if skip-flag (vip-forward-char-carefully 1)) 207 (if skip-flag (viper-forward-char-carefully 1))
200 (setq skip-flag t) ; now always move 1 char forward 208 (setq skip-flag t) ; now always move 1 char forward
201 (if (> click-count 1) 209 (if (> click-count 1)
202 (vip-skip-nonseparators 'forward) 210 (viper-skip-nonseparators 'forward)
203 (vip-skip-alpha-forward modifiers)) 211 (viper-skip-alpha-forward modifiers))
204 (setq count (1- count))) 212 (setq count (1- count)))
205 213
206 (setq result (buffer-substring word-beg (point)))) 214 (setq result (buffer-substring word-beg (point))))
207 ) ; if 215 ) ; if
208 ;; XEmacs doesn't have set-text-properties, but there buffer-substring 216 ;; XEmacs doesn't have set-text-properties, but there buffer-substring
209 ;; doesn't return properties together with the string, so it's not needed. 217 ;; doesn't return properties together with the string, so it's not needed.
210 (if vip-emacs-p 218 (if viper-emacs-p
211 (set-text-properties 0 (length result) nil result)) 219 (set-text-properties 0 (length result) nil result))
212 result 220 result
213 )) 221 ))
214 222
215 223
216 (defun vip-mouse-click-get-word (click count click-count) 224 (defun viper-mouse-click-get-word (click count click-count)
217 "Returns word surrounding the position of a mouse click. 225 "Returns word surrounding the position of a mouse click.
218 Click may be in another window. Current window and buffer isn't changed. 226 Click may be in another window. Current window and buffer isn't changed.
219 On single or double click, returns the word as determined by 227 On single or double click, returns the word as determined by
220 `vip-surrounding-word-function'." 228 `viper-surrounding-word-function'."
221 229
222 (let ((click-word "") 230 (let ((click-word "")
223 (click-pos (vip-mouse-click-posn click)) 231 (click-pos (viper-mouse-click-posn click))
224 (click-buf (vip-mouse-click-window-buffer click))) 232 (click-buf (viper-mouse-click-window-buffer click)))
225 (or (natnump count) (setq count 1)) 233 (or (natnump count) (setq count 1))
226 (or (natnump click-count) (setq click-count 1)) 234 (or (natnump click-count) (setq click-count 1))
227 235
228 (save-excursion 236 (save-excursion
229 (save-window-excursion 237 (save-window-excursion
231 (progn 239 (progn
232 (set-buffer click-buf) 240 (set-buffer click-buf)
233 241
234 (goto-char click-pos) 242 (goto-char click-pos)
235 (setq click-word 243 (setq click-word
236 (funcall vip-surrounding-word-function count click-count))) 244 (funcall viper-surrounding-word-function count click-count)))
237 (error "Click must be over a window.")) 245 (error "Click must be over a window."))
238 click-word)))) 246 click-word))))
239 247
240 248
241 (defun vip-mouse-click-insert-word (click arg) 249 (defun viper-mouse-click-insert-word (click arg)
242 "Insert word clicked or double-clicked on. 250 "Insert word clicked or double-clicked on.
243 With prefix argument, N, insert that many words. 251 With prefix argument, N, insert that many words.
244 This command must be bound to a mouse click. 252 This command must be bound to a mouse click.
245 The double-click action of the same mouse button must not be bound 253 The double-click action of the same mouse button must not be bound
246 \(or it must be bound to the same function\). 254 \(or it must be bound to the same function\).
247 See `vip-surrounding-word' for the definition of a word in this case." 255 See `viper-surrounding-word' for the definition of a word in this case."
248 (interactive "e\nP") 256 (interactive "e\nP")
249 (if vip-frame-of-focus ;; to handle clicks in another frame 257 (if viper-frame-of-focus ;; to handle clicks in another frame
250 (select-frame vip-frame-of-focus)) 258 (select-frame viper-frame-of-focus))
251 259
252 ;; turn arg into a number 260 ;; turn arg into a number
253 (cond ((integerp arg) nil) 261 (cond ((integerp arg) nil)
254 ;; prefix arg is a list when one hits C-u then command 262 ;; prefix arg is a list when one hits C-u then command
255 ((and (listp arg) (integerp (car arg))) 263 ((and (listp arg) (integerp (car arg)))
256 (setq arg (car arg))) 264 (setq arg (car arg)))
257 (t (setq arg 1))) 265 (t (setq arg 1)))
258 266
259 (let (click-count interrupting-event) 267 (if (not (eq (key-binding viper-mouse-down-insert-key-parsed)
260 (if (and 268 'viper-mouse-catch-frame-switch))
261 (vip-multiclick-p) 269 () ; do nothing
262 ;; This trick checks if there is a pending mouse event 270 (let (click-count interrupting-event)
263 ;; if so, we use this latter event and discard the current mouse click 271 (if (and
264 ;; If the next pending event is not a mouse event, we execute 272 (viper-multiclick-p)
265 ;; the current mouse event 273 ;; This trick checks if there is a pending mouse event if so, we use
266 (progn 274 ;; this latter event and discard the current mouse click If the next
267 (setq interrupting-event (vip-read-event)) 275 ;; pending event is not a mouse event, we execute the current mouse
268 (vip-mouse-event-p last-input-event))) 276 ;; event
269 (progn ;; interrupted wait 277 (progn
270 (setq vip-global-prefix-argument arg) 278 (setq interrupting-event (viper-read-event))
271 ;; count this click for XEmacs 279 (viper-mouse-event-p last-input-event)))
272 (vip-event-click-count click)) 280 (progn ; interrupted wait
273 ;; uninterrupted wait or the interrupting event wasn't a mouse event 281 (setq viper-global-prefix-argument arg)
274 (setq click-count (vip-event-click-count click)) 282 ;; count this click for XEmacs
275 (if (> click-count 1) 283 (viper-event-click-count click))
276 (setq arg vip-global-prefix-argument 284 ;; uninterrupted wait or the interrupting event wasn't a mouse event
277 vip-global-prefix-argument nil)) 285 (setq click-count (viper-event-click-count click))
278 (insert (vip-mouse-click-get-word click arg click-count)) 286 (if (> click-count 1)
279 (if (and interrupting-event 287 (setq arg viper-global-prefix-argument
280 (eventp interrupting-event) 288 viper-global-prefix-argument nil))
281 (not (vip-mouse-event-p interrupting-event))) 289 (insert (viper-mouse-click-get-word click arg click-count))
282 (vip-set-unread-command-events interrupting-event)) 290 (if (and interrupting-event
283 ))) 291 (eventp interrupting-event)
292 (not (viper-mouse-event-p interrupting-event)))
293 (viper-set-unread-command-events interrupting-event))
294 ))))
284 295
285 ;; arg is an event. accepts symbols and numbers, too 296 ;; arg is an event. accepts symbols and numbers, too
286 (defun vip-mouse-event-p (event) 297 (defun viper-mouse-event-p (event)
287 (if (eventp event) 298 (if (eventp event)
288 (string-match "\\(mouse-\\|frame\\|screen\\|track\\)" 299 (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
289 (prin1-to-string (vip-event-key event))))) 300 (prin1-to-string (viper-event-key event)))))
290 301
291 ;; XEmacs has no double-click events. So, we must simulate. 302 ;; XEmacs has no double-click events. So, we must simulate.
292 ;; So, we have to simulate event-click-count. 303 ;; So, we have to simulate event-click-count.
293 (defun vip-event-click-count (click) 304 (defun viper-event-click-count (click)
294 (if vip-xemacs-p 305 (if viper-xemacs-p
295 (progn 306 (progn
296 ;; if more than 1 second 307 ;; if more than 1 second
297 (if (> (- (event-timestamp click) vip-last-click-event-timestamp) 308 (if (> (- (event-timestamp click) viper-last-click-event-timestamp)
298 vip-multiclick-timeout) 309 viper-multiclick-timeout)
299 (setq vip-current-click-count 0)) 310 (setq viper-current-click-count 0))
300 (setq vip-last-click-event-timestamp (event-timestamp click) 311 (setq viper-last-click-event-timestamp (event-timestamp click)
301 vip-current-click-count (1+ vip-current-click-count))) 312 viper-current-click-count (1+ viper-current-click-count)))
302 (event-click-count click))) 313 (event-click-count click)))
303 314
304 315
305 316
306 (defun vip-mouse-click-search-word (click arg) 317 (defun viper-mouse-click-search-word (click arg)
307 "Find the word clicked or double-clicked on. Word may be in another window. 318 "Find the word clicked or double-clicked on. Word may be in another window.
308 With prefix argument, N, search for N-th occurrence. 319 With prefix argument, N, search for N-th occurrence.
309 This command must be bound to a mouse click. The double-click action of the 320 This command must be bound to a mouse click. The double-click action of the
310 same button must not be bound \(or it must be bound to the same function\). 321 same button must not be bound \(or it must be bound to the same function\).
311 See `vip-surrounding-word' for the details on what constitutes a word for 322 See `viper-surrounding-word' for the details on what constitutes a word for
312 this command." 323 this command."
313 (interactive "e\nP") 324 (interactive "e\nP")
314 (if vip-frame-of-focus ;; to handle clicks in another frame 325 (if viper-frame-of-focus ;; to handle clicks in another frame
315 (select-frame vip-frame-of-focus)) 326 (select-frame viper-frame-of-focus))
316 (let (click-word click-count 327 (if (not (eq (key-binding viper-mouse-down-search-key-parsed)
317 (previous-search-string vip-s-string)) 328 'viper-mouse-catch-frame-switch))
329 () ; do nothing
330 (let ((previous-search-string viper-s-string)
331 click-word click-count)
318 332
319 (if (and 333 (if (and
320 (vip-multiclick-p) 334 (viper-multiclick-p)
321 ;; This trick checks if there is a pending mouse event 335 ;; This trick checks if there is a pending mouse event if so, we use
322 ;; if so, we use this latter event and discard the current mouse click 336 ;; this latter event and discard the current mouse click If the next
323 ;; If the next pending event is not a mouse event, we execute 337 ;; pending event is not a mouse event, we execute the current mouse
324 ;; the current mouse event 338 ;; event
325 (progn 339 (progn
326 (vip-read-event) 340 (viper-read-event)
327 (vip-mouse-event-p last-input-event))) 341 (viper-mouse-event-p last-input-event)))
328 (progn ;; interrupted wait 342 (progn ; interrupted wait
329 (setq vip-global-prefix-argument 343 (setq viper-global-prefix-argument
330 (or vip-global-prefix-argument arg)) 344 (or viper-global-prefix-argument arg))
331 ;; remember command that was before the multiclick 345 ;; remember command that was before the multiclick
332 (setq this-command last-command) 346 (setq this-command last-command)
333 ;; make sure we counted this event---needed for XEmacs only 347 ;; make sure we counted this event---needed for XEmacs only
334 (vip-event-click-count click)) 348 (viper-event-click-count click))
335 ;; uninterrupted wait 349 ;; uninterrupted wait
336 (setq click-count (vip-event-click-count click)) 350 (setq click-count (viper-event-click-count click))
337 (setq click-word (vip-mouse-click-get-word click nil click-count)) 351 (setq click-word (viper-mouse-click-get-word click nil click-count))
338 352
339 (if (> click-count 1) 353 (if (> click-count 1)
340 (setq arg vip-global-prefix-argument 354 (setq arg viper-global-prefix-argument
341 vip-global-prefix-argument nil)) 355 viper-global-prefix-argument nil))
342 (setq arg (or arg 1)) 356 (setq arg (or arg 1))
343 357
344 (vip-deactivate-mark) 358 (viper-deactivate-mark)
345 (if (or (not (string= click-word vip-s-string)) 359 (if (or (not (string= click-word viper-s-string))
346 (not (markerp vip-search-start-marker)) 360 (not (markerp viper-search-start-marker))
347 (not (equal (marker-buffer vip-search-start-marker) 361 (not (equal (marker-buffer viper-search-start-marker)
348 (current-buffer))) 362 (current-buffer)))
349 (not (eq last-command 'vip-mouse-click-search-word))) 363 (not (eq last-command 'viper-mouse-click-search-word)))
350 (progn
351 (setq vip-search-start-marker (point-marker)
352 vip-local-search-start-marker vip-search-start-marker
353 vip-mouse-click-search-noerror t
354 vip-mouse-click-search-limit nil)
355
356 ;; make search string known to Viper
357 (setq vip-s-string (if vip-re-search
358 (regexp-quote click-word)
359 click-word))
360 (if (not (string= vip-s-string (car vip-search-history)))
361 (setq vip-search-history
362 (cons vip-s-string vip-search-history)))
363 ))
364
365 (push-mark nil t)
366 (while (> arg 0)
367 (vip-forward-word 1)
368 (condition-case nil
369 (progn 364 (progn
370 (if (not (search-forward click-word vip-mouse-click-search-limit 365 (setq viper-search-start-marker (point-marker)
371 vip-mouse-click-search-noerror)) 366 viper-local-search-start-marker viper-search-start-marker
372 (progn 367 viper-mouse-click-search-noerror t
373 (setq vip-mouse-click-search-noerror nil) 368 viper-mouse-click-search-limit nil)
374 (setq vip-mouse-click-search-limit 369
375 (save-excursion 370 ;; make search string known to Viper
376 (if (and 371 (setq viper-s-string (if viper-re-search
377 (markerp vip-local-search-start-marker) 372 (regexp-quote click-word)
378 (marker-buffer vip-local-search-start-marker)) 373 click-word))
379 (goto-char vip-local-search-start-marker)) 374 (if (not (string= viper-s-string (car viper-search-history)))
380 (vip-line-pos 'end))) 375 (setq viper-search-history
381 376 (cons viper-s-string viper-search-history)))
382 (goto-char (point-min)) 377 ))
383 (search-forward click-word 378
384 vip-mouse-click-search-limit nil))) 379 (push-mark nil t)
385 (goto-char (match-beginning 0)) 380 (while (> arg 0)
386 (message "Searching for: %s" vip-s-string) 381 (viper-forward-word 1)
387 (if (<= arg 1) ; found the right occurrence of the pattern 382 (condition-case nil
388 (progn 383 (progn
389 (vip-adjust-window) 384 (if (not (search-forward
390 (vip-flash-search-pattern))) 385 click-word viper-mouse-click-search-limit
391 ) 386 viper-mouse-click-search-noerror))
392 (error (beep 1) 387 (progn
393 (if (or (not (string= click-word previous-search-string)) 388 (setq viper-mouse-click-search-noerror nil)
394 (not (eq last-command 'vip-mouse-click-search-word))) 389 (setq viper-mouse-click-search-limit
395 (message "`%s': String not found in %s" 390 (save-excursion
396 vip-s-string (buffer-name (current-buffer))) 391 (if (and
397 (message 392 (markerp viper-local-search-start-marker)
398 "`%s': Last occurrence in %s. Back to beginning of search" 393 (marker-buffer viper-local-search-start-marker))
399 click-word (buffer-name (current-buffer))) 394 (goto-char viper-local-search-start-marker))
400 (setq arg 1) ;; to terminate the loop 395 (viper-line-pos 'end)))
401 (sit-for 2)) 396
402 (setq vip-mouse-click-search-noerror t) 397 (goto-char (point-min))
403 (setq vip-mouse-click-search-limit nil) 398 (search-forward click-word
404 (if (and (markerp vip-local-search-start-marker) 399 viper-mouse-click-search-limit nil)))
405 (marker-buffer vip-local-search-start-marker)) 400 (goto-char (match-beginning 0))
406 (goto-char vip-local-search-start-marker)))) 401 (message "Searching for: %s" viper-s-string)
407 (setq arg (1- arg))) 402 (if (<= arg 1) ; found the right occurrence of the pattern
408 ))) 403 (progn
404 (viper-adjust-window)
405 (viper-flash-search-pattern)))
406 )
407 (error (beep 1)
408 (if (or (not (string= click-word previous-search-string))
409 (not (eq last-command 'viper-mouse-click-search-word)))
410 (message "`%s': String not found in %s"
411 viper-s-string (buffer-name (current-buffer)))
412 (message
413 "`%s': Last occurrence in %s. Back to beginning of search"
414 click-word (buffer-name (current-buffer)))
415 (setq arg 1) ;; to terminate the loop
416 (sit-for 2))
417 (setq viper-mouse-click-search-noerror t)
418 (setq viper-mouse-click-search-limit nil)
419 (if (and (markerp viper-local-search-start-marker)
420 (marker-buffer viper-local-search-start-marker))
421 (goto-char viper-local-search-start-marker))))
422 (setq arg (1- arg)))
423 ))))
409 424
410 (defun vip-mouse-catch-frame-switch (event arg) 425 (defun viper-mouse-catch-frame-switch (event arg)
411 "Catch the event of switching frame. 426 "Catch the event of switching frame.
412 Usually is bound to a 'down-mouse' event to work properly. See sample 427 Usually is bound to a 'down-mouse' event to work properly. See sample
413 bindings in the Viper manual." 428 bindings in the Viper manual."
414 (interactive "e\nP") 429 (interactive "e\nP")
415 (setq vip-frame-of-focus nil) 430 (setq viper-frame-of-focus nil)
416 ;; pass prefix arg along to vip-mouse-click-search/insert-word 431 ;; pass prefix arg along to viper-mouse-click-search/insert-word
417 (setq prefix-arg arg) 432 (setq prefix-arg arg)
418 (if (eq last-command 'handle-switch-frame) 433 (if (eq last-command 'handle-switch-frame)
419 (setq vip-frame-of-focus vip-current-frame-saved)) 434 (setq viper-frame-of-focus viper-current-frame-saved))
420 ;; make Emacs forget that it executed vip-mouse-catch-frame-switch 435 ;; make Emacs forget that it executed viper-mouse-catch-frame-switch
421 (setq this-command last-command)) 436 (setq this-command last-command))
422 437
423 ;; Called just before switching frames. Saves the old selected frame. 438 ;; Called just before switching frames. Saves the old selected frame.
424 ;; Sets last-command to handle-switch-frame (this is done automatically in 439 ;; Sets last-command to handle-switch-frame (this is done automatically in
425 ;; Emacs. 440 ;; Emacs.
429 ;; In XEmacs, input will go to frame A. This may be a bug in one of the 444 ;; In XEmacs, input will go to frame A. This may be a bug in one of the
430 ;; Emacsen, but also may be a design decision. 445 ;; Emacsen, but also may be a design decision.
431 ;; Also, in Emacs sending input to frame B generates handle-switch-frame 446 ;; Also, in Emacs sending input to frame B generates handle-switch-frame
432 ;; event, while in XEmacs it doesn't. 447 ;; event, while in XEmacs it doesn't.
433 ;; All this accounts for the difference in the behavior of 448 ;; All this accounts for the difference in the behavior of
434 ;; vip-mouse-click-* commands when you click in a frame other than the one 449 ;; viper-mouse-click-* commands when you click in a frame other than the one
435 ;; that was the last to receive input. In Emacs, focus will be in frame A 450 ;; that was the last to receive input. In Emacs, focus will be in frame A
436 ;; until you do something other than vip-mouse-click-* command. 451 ;; until you do something other than viper-mouse-click-* command.
437 ;; In XEmacs, you have to manually select frame B (with the mouse click) in 452 ;; In XEmacs, you have to manually select frame B (with the mouse click) in
438 ;; order to shift focus to frame B. 453 ;; order to shift focus to frame B.
439 (defsubst vip-remember-current-frame (frame) 454 (defsubst viper-remember-current-frame (frame)
440 (setq last-command 'handle-switch-frame 455 (setq last-command 'handle-switch-frame
441 vip-current-frame-saved (selected-frame))) 456 viper-current-frame-saved (selected-frame)))
457
458
459 ;; The key is of the form (MODIFIER ... BUTTON-NUMBER)
460 ;; Converts into a valid mouse button spec for the appropriate version of
461 ;; Emacs. EVENT-TYPE is either `up' or `down'. Up returns button-up key; down
462 ;; returns button-down key.
463 (defun viper-parse-mouse-key (key-var event-type)
464 (let ((key (eval key-var))
465 button-spec meta-spec shift-spec control-spec key-spec)
466 (if (null key)
467 ;; just return nil
468 ()
469 (setq button-spec
470 (cond ((memq 1 key)
471 (if viper-emacs-p
472 (if (eq 'up event-type)
473 "mouse-1" "down-mouse-1")
474 (if (eq 'up event-type)
475 'button1up 'button1)))
476 ((memq 2 key)
477 (if viper-emacs-p
478 (if (eq 'up event-type)
479 "mouse-2" "down-mouse-2")
480 (if (eq 'up event-type)
481 'button2up 'button2)))
482 ((memq 3 key)
483 (if viper-emacs-p
484 (if (eq 'up event-type)
485 "mouse-3" "down-mouse-3")
486 (if (eq 'up event-type)
487 'button3up 'button3)))
488 (t (error
489 "%S: invalid button number, %S" key-var key)))
490 meta-spec
491 (if (memq 'meta key)
492 (if viper-emacs-p "M-" 'meta)
493 (if viper-emacs-p "" nil))
494 shift-spec
495 (if (memq 'shift key)
496 (if viper-emacs-p "S-" 'shift)
497 (if viper-emacs-p "" nil))
498 control-spec
499 (if (memq 'control key)
500 (if viper-emacs-p "C-" 'control)
501 (if viper-emacs-p "" nil)))
502
503 (setq key-spec (if viper-emacs-p
504 (vector
505 (intern
506 (concat
507 control-spec meta-spec shift-spec button-spec)))
508 (vector
509 (delq
510 nil
511 (list
512 control-spec meta-spec shift-spec button-spec)))))
513 )))
514
515 (defun viper-unbind-mouse-search-key ()
516 (if viper-mouse-up-search-key-parsed
517 (global-unset-key viper-mouse-up-search-key-parsed))
518 (if viper-mouse-down-search-key-parsed
519 (global-unset-key viper-mouse-down-search-key-parsed))
520 (setq viper-mouse-up-search-key-parsed nil
521 viper-mouse-down-search-key-parsed nil))
522
523 (defun viper-unbind-mouse-insert-key ()
524 (if viper-mouse-up-insert-key-parsed
525 (global-unset-key viper-mouse-up-insert-key-parsed))
526 (if viper-mouse-down-insert-key-parsed
527 (global-unset-key viper-mouse-down-insert-key-parsed))
528 (setq viper-mouse-up-insert-key-parsed nil
529 viper-mouse-down-insert-key-parsed nil))
530
531 ;; If FORCE, bind even if this mouse action is already bound to something else
532 (defun viper-bind-mouse-search-key (&optional force)
533 (setq viper-mouse-up-search-key-parsed
534 (viper-parse-mouse-key 'viper-mouse-search-key 'up)
535 viper-mouse-down-search-key-parsed
536 (viper-parse-mouse-key 'viper-mouse-search-key 'down))
537 (cond ((or (null viper-mouse-up-search-key-parsed)
538 (null viper-mouse-down-search-key-parsed))
539 nil) ; just quit
540 ((and (null force)
541 (key-binding viper-mouse-up-search-key-parsed)
542 (not (eq (key-binding viper-mouse-up-search-key-parsed)
543 'viper-mouse-click-search-word)))
544 (message
545 "%S already bound to a mouse event. Viper mouse-search feature disabled"
546 viper-mouse-up-search-key-parsed))
547 ((and (null force)
548 (key-binding viper-mouse-down-search-key-parsed)
549 (not (eq (key-binding viper-mouse-down-search-key-parsed)
550 'viper-mouse-catch-frame-switch)))
551 (message
552 "%S already bound to a mouse event. Viper mouse-search feature disabled"
553 viper-mouse-down-search-key-parsed))
554 (t
555 (global-set-key viper-mouse-up-search-key-parsed
556 'viper-mouse-click-search-word)
557 (global-set-key viper-mouse-down-search-key-parsed
558 'viper-mouse-catch-frame-switch))))
559
560 ;; If FORCE, bind even if this mouse action is already bound to something else
561 (defun viper-bind-mouse-insert-key (&optional force)
562 (setq viper-mouse-up-insert-key-parsed
563 (viper-parse-mouse-key 'viper-mouse-insert-key 'up)
564 viper-mouse-down-insert-key-parsed
565 (viper-parse-mouse-key 'viper-mouse-insert-key 'down))
566 (cond ((or (null viper-mouse-up-insert-key-parsed)
567 (null viper-mouse-down-insert-key-parsed))
568 nil) ; just quit
569 ((and (null force)
570 (key-binding viper-mouse-up-insert-key-parsed)
571 (not (eq (key-binding viper-mouse-up-insert-key-parsed)
572 'viper-mouse-click-insert-word)))
573 (message
574 "%S already bound to a mouse event. Viper mouse-insert feature disabled"
575 viper-mouse-up-insert-key-parsed))
576 ((and (null force)
577 (key-binding viper-mouse-down-insert-key-parsed)
578 (not (eq (key-binding viper-mouse-down-insert-key-parsed)
579 'viper-mouse-catch-frame-switch)))
580 (message
581 "%S already bound to a mouse event. Viper mouse-insert feature disabled"
582 viper-mouse-down-insert-key-parsed))
583 (t
584 (global-set-key viper-mouse-up-insert-key-parsed
585 'viper-mouse-click-insert-word)
586 (global-set-key viper-mouse-down-insert-key-parsed
587 'viper-mouse-catch-frame-switch))))
588
589 (defun viper-reset-mouse-search-key (symb val)
590 (viper-unbind-mouse-search-key)
591 (set symb val)
592 (viper-bind-mouse-search-key 'force))
593
594 (defun viper-reset-mouse-insert-key (symb val)
595 (viper-unbind-mouse-insert-key)
596 (set symb val)
597 (viper-bind-mouse-insert-key 'force))
598
599
600 (defcustom viper-mouse-search-key '(meta shift 1)
601 "*Key used to click-search in Viper.
602 Must be a list that specifies the mouse button and modifiers. The supported
603 modifiers are `meta', `shift', and `control'. For instance, `(meta shift 1)'
604 means that holding the meta and shift keys down and clicking on a word with
605 mouse button 1 will initiate search for that word in the buffer that was
606 current just before the click. This buffer may be different from the one where
607 the click occurred."
608 :type 'list
609 :set 'viper-reset-mouse-search-key
610 :group 'viper-mouse)
611
612 (defcustom viper-mouse-insert-key '(meta shift 2)
613 "*Key used to click-insert in Viper.
614 Must be a list that specifies the mouse button and modifiers. The supported
615 modifiers are `meta', `shift', and `control'. For instance, `(meta shift 2)'
616 means that holding the meta and shift keys down and clicking on a word with
617 mouse button 2 will insert that word at the cursor in the buffer that was
618 current just before the click. This buffer may be different from the one where
619 the click occurred."
620 :type 'list
621 :set 'viper-reset-mouse-insert-key
622 :group 'viper-mouse)
623
442 624
443 625
444 ;;; Local Variables: 626 ;;; Local Variables:
445 ;;; eval: (put 'vip-deflocalvar 'lisp-indent-hook 'defun) 627 ;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun)
446 ;;; End: 628 ;;; End:
447 629
448 630
449 ;;; viper-mous.el ends here 631 ;;; viper-mous.el ends here