|
0
|
1 ;;; Mouse related functions and commands
|
|
98
|
2 ;;; Copyright (C) 1995-1997 Kyle E. Jones
|
|
0
|
3 ;;;
|
|
|
4 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
5 ;;; it under the terms of the GNU General Public License as published by
|
|
|
6 ;;; the Free Software Foundation; either version 1, or (at your option)
|
|
|
7 ;;; any later version.
|
|
|
8 ;;;
|
|
|
9 ;;; This program is distributed in the hope that it will be useful,
|
|
|
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
12 ;;; GNU General Public License for more details.
|
|
|
13 ;;;
|
|
|
14 ;;; You should have received a copy of the GNU General Public License
|
|
|
15 ;;; along with this program; if not, write to the Free Software
|
|
|
16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
17
|
|
|
18 (provide 'vm-mouse)
|
|
|
19
|
|
|
20 (defun vm-mouse-fsfemacs-mouse-p ()
|
|
70
|
21 (and (vm-fsfemacs-19-p)
|
|
0
|
22 (fboundp 'set-mouse-position)))
|
|
|
23
|
|
|
24 (defun vm-mouse-xemacs-mouse-p ()
|
|
70
|
25 (and (vm-xemacs-p)
|
|
0
|
26 (fboundp 'set-mouse-position)))
|
|
|
27
|
|
|
28 (defun vm-mouse-set-mouse-track-highlight (start end)
|
|
70
|
29 (cond ((fboundp 'make-overlay)
|
|
0
|
30 (let ((o (make-overlay start end)))
|
|
|
31 (overlay-put o 'mouse-face 'highlight)))
|
|
70
|
32 ((fboundp 'make-extent)
|
|
0
|
33 (let ((o (make-extent start end)))
|
|
|
34 (set-extent-property o 'highlight t)))))
|
|
|
35
|
|
|
36 (defun vm-mouse-button-2 (event)
|
|
|
37 (interactive "e")
|
|
|
38 ;; go to where the event occurred
|
|
|
39 (cond ((vm-mouse-xemacs-mouse-p)
|
|
|
40 (set-buffer (window-buffer (event-window event)))
|
|
|
41 (and (event-point event) (goto-char (event-point event))))
|
|
|
42 ((vm-mouse-fsfemacs-mouse-p)
|
|
|
43 (set-buffer (window-buffer (posn-window (event-start event))))
|
|
|
44 (goto-char (posn-point (event-start event)))))
|
|
|
45 ;; now dispatch depending on where we are
|
|
|
46 (cond ((eq major-mode 'vm-summary-mode)
|
|
|
47 (mouse-set-point event)
|
|
|
48 (beginning-of-line)
|
|
|
49 (if (let ((vm-follow-summary-cursor t))
|
|
|
50 (vm-follow-summary-cursor))
|
|
98
|
51 nil
|
|
0
|
52 (setq this-command 'vm-scroll-forward)
|
|
|
53 (call-interactively 'vm-scroll-forward)))
|
|
98
|
54 ((memq major-mode '(vm-mode vm-virtual-mode vm-presentation-mode))
|
|
|
55 (vm-mouse-popup-or-select event))))
|
|
0
|
56
|
|
|
57 (defun vm-mouse-button-3 (event)
|
|
|
58 (interactive "e")
|
|
|
59 (if vm-use-menus
|
|
|
60 (progn
|
|
|
61 ;; go to where the event occurred
|
|
|
62 (cond ((vm-mouse-xemacs-mouse-p)
|
|
|
63 (set-buffer (window-buffer (event-window event)))
|
|
|
64 (and (event-point event) (goto-char (event-point event))))
|
|
|
65 ((vm-mouse-fsfemacs-mouse-p)
|
|
|
66 (set-buffer (window-buffer (posn-window (event-start event))))
|
|
|
67 (goto-char (posn-point (event-start event)))))
|
|
|
68 ;; now dispatch depending on where we are
|
|
|
69 (cond ((eq major-mode 'vm-summary-mode)
|
|
|
70 (vm-menu-popup-mode-menu event))
|
|
|
71 ((eq major-mode 'vm-mode)
|
|
|
72 (vm-menu-popup-context-menu event))
|
|
98
|
73 ((eq major-mode 'vm-presentation-mode)
|
|
|
74 (vm-menu-popup-context-menu event))
|
|
0
|
75 ((eq major-mode 'vm-virtual-mode)
|
|
|
76 (vm-menu-popup-context-menu event))
|
|
|
77 ((eq major-mode 'mail-mode)
|
|
70
|
78 (vm-menu-popup-mode-menu event))))))
|
|
0
|
79
|
|
|
80 (defun vm-mouse-3-help (object)
|
|
98
|
81 nil
|
|
0
|
82 "Use mouse button 3 to see a menu of options.")
|
|
|
83
|
|
|
84 (defun vm-mouse-get-mouse-track-string (event)
|
|
|
85 (save-excursion
|
|
|
86 ;; go to where the event occurred
|
|
|
87 (cond ((vm-mouse-xemacs-mouse-p)
|
|
|
88 (set-buffer (window-buffer (event-window event)))
|
|
|
89 (and (event-point event) (goto-char (event-point event))))
|
|
|
90 ((vm-mouse-fsfemacs-mouse-p)
|
|
|
91 (set-buffer (window-buffer (posn-window (event-start event))))
|
|
|
92 (goto-char (posn-point (event-start event)))))
|
|
70
|
93 (cond ((fboundp 'overlays-at)
|
|
0
|
94 (let ((o-list (overlays-at (point)))
|
|
|
95 (string nil))
|
|
|
96 (while o-list
|
|
|
97 (if (overlay-get (car o-list) 'mouse-face)
|
|
|
98 (setq string (vm-buffer-substring-no-properties
|
|
|
99 (overlay-start (car o-list))
|
|
|
100 (overlay-end (car o-list)))
|
|
|
101 o-list nil)
|
|
|
102 (setq o-list (cdr o-list))))
|
|
|
103 string ))
|
|
70
|
104 ((fboundp 'extent-at)
|
|
0
|
105 (let ((e (extent-at (point) nil 'highlight)))
|
|
|
106 (if e
|
|
|
107 (buffer-substring (extent-start-position e)
|
|
|
108 (extent-end-position e))
|
|
|
109 nil)))
|
|
|
110 (t nil))))
|
|
|
111
|
|
|
112 (defun vm-mouse-popup-or-select (event)
|
|
|
113 (interactive "e")
|
|
|
114 (cond ((vm-mouse-fsfemacs-mouse-p)
|
|
|
115 (set-buffer (window-buffer (posn-window (event-start event))))
|
|
|
116 (goto-char (posn-point (event-start event)))
|
|
98
|
117 (let (o-list (found nil))
|
|
0
|
118 (setq o-list (overlays-at (point)))
|
|
|
119 (while (and o-list (not found))
|
|
|
120 (cond ((overlay-get (car o-list) 'vm-url)
|
|
|
121 (setq found t)
|
|
98
|
122 (vm-mouse-send-url-at-event event))
|
|
|
123 ((overlay-get (car o-list) 'vm-mime-function)
|
|
|
124 (setq found t)
|
|
|
125 (funcall (overlay-get (car o-list) 'vm-mime-function)
|
|
|
126 (car o-list))))
|
|
0
|
127 (setq o-list (cdr o-list)))
|
|
|
128 (and (not found) (vm-menu-popup-context-menu event))))
|
|
|
129 ;; The XEmacs code is not actually used now, since all
|
|
|
130 ;; selectable objects are handled by an extent keymap
|
|
|
131 ;; binding that points to a more specific function. But
|
|
|
132 ;; this might come in handy later if I want selectable
|
|
98
|
133 ;; objects that don't have an extent or extent keymap
|
|
|
134 ;; attached.
|
|
0
|
135 ((vm-mouse-xemacs-mouse-p)
|
|
|
136 (set-buffer (window-buffer (event-window event)))
|
|
|
137 (and (event-point event) (goto-char (event-point event)))
|
|
98
|
138 (let (e)
|
|
|
139 (cond ((extent-at (point) (current-buffer) 'vm-url)
|
|
|
140 (vm-mouse-send-url-at-event event))
|
|
|
141 ((setq e (extent-at (point) nil 'vm-mime-function))
|
|
|
142 (funcall (extent-property e 'vm-mime-function) e))
|
|
|
143 (t (vm-menu-popup-context-menu event)))))))
|
|
0
|
144
|
|
|
145 (defun vm-mouse-send-url-at-event (event)
|
|
|
146 (interactive "e")
|
|
|
147 (cond ((vm-mouse-xemacs-mouse-p)
|
|
|
148 (set-buffer (window-buffer (event-window event)))
|
|
|
149 (and (event-point event) (goto-char (event-point event)))
|
|
|
150 (vm-mouse-send-url-at-position (event-point event)))
|
|
|
151 ((vm-mouse-fsfemacs-mouse-p)
|
|
|
152 (set-buffer (window-buffer (posn-window (event-start event))))
|
|
|
153 (goto-char (posn-point (event-start event)))
|
|
|
154 (vm-mouse-send-url-at-position (posn-point (event-start event))))))
|
|
|
155
|
|
|
156 (defun vm-mouse-send-url-at-position (pos &optional browser)
|
|
98
|
157 (save-restriction
|
|
|
158 (widen)
|
|
|
159 (cond ((vm-mouse-xemacs-mouse-p)
|
|
|
160 (let ((e (extent-at pos (current-buffer) 'vm-url))
|
|
|
161 url)
|
|
|
162 (if (null e)
|
|
|
163 nil
|
|
|
164 (setq url (buffer-substring (extent-start-position e)
|
|
|
165 (extent-end-position e)))
|
|
|
166 (vm-mouse-send-url url browser))))
|
|
|
167 ((vm-mouse-fsfemacs-mouse-p)
|
|
|
168 (let (o-list url o)
|
|
|
169 (setq o-list (overlays-at pos))
|
|
|
170 (while (and o-list (null (overlay-get (car o-list) 'vm-url)))
|
|
|
171 (setq o-list (cdr o-list)))
|
|
|
172 (if (null o-list)
|
|
|
173 nil
|
|
|
174 (setq o (car o-list))
|
|
|
175 (setq url (vm-buffer-substring-no-properties
|
|
|
176 (overlay-start o)
|
|
|
177 (overlay-end o)))
|
|
|
178 (vm-mouse-send-url url browser)))))))
|
|
0
|
179
|
|
|
180 (defun vm-mouse-send-url (url &optional browser)
|
|
98
|
181 (if (string-match "^mailto:" url)
|
|
|
182 (vm-mail-to-mailto-url url)
|
|
|
183 (let ((browser (or browser vm-url-browser)))
|
|
|
184 (cond ((symbolp browser)
|
|
|
185 (funcall browser url))
|
|
|
186 ((stringp browser)
|
|
|
187 (vm-unsaved-message "Sending URL to %s..." browser)
|
|
|
188 (vm-run-background-command browser url)
|
|
|
189 (vm-unsaved-message "Sending URL to %s... done" browser))))))
|
|
0
|
190
|
|
|
191 (defun vm-mouse-send-url-to-netscape (url &optional new-netscape new-window)
|
|
70
|
192 (vm-unsaved-message "Sending URL to Netscape...")
|
|
0
|
193 (if new-netscape
|
|
70
|
194 (vm-run-background-command vm-netscape-program url)
|
|
|
195 (or (equal 0 (vm-run-command vm-netscape-program "-remote"
|
|
|
196 (concat "openURL(" url
|
|
|
197 (if new-window ", new-window" "")
|
|
|
198 ")")))
|
|
0
|
199 (vm-mouse-send-url-to-netscape url t new-window)))
|
|
70
|
200 (vm-unsaved-message "Sending URL to Netscape... done"))
|
|
54
|
201
|
|
0
|
202 (defun vm-mouse-send-url-to-mosaic (url &optional new-mosaic new-window)
|
|
70
|
203 (vm-unsaved-message "Sending URL to Mosaic...")
|
|
0
|
204 (if (null new-mosaic)
|
|
|
205 (let ((pid-file "~/.mosaicpid")
|
|
|
206 (work-buffer " *mosaic work*")
|
|
|
207 pid)
|
|
|
208 (cond ((file-exists-p pid-file)
|
|
|
209 (set-buffer (get-buffer-create work-buffer))
|
|
|
210 (erase-buffer)
|
|
|
211 (insert-file-contents pid-file)
|
|
|
212 (setq pid (int-to-string (string-to-int (buffer-string))))
|
|
|
213 (erase-buffer)
|
|
|
214 (insert (if new-window "newwin" "goto") ?\n)
|
|
|
215 (insert url ?\n)
|
|
100
|
216 ;; newline convention used should be the local
|
|
|
217 ;; one, whatever that is.
|
|
|
218 (setq buffer-file-type nil)
|
|
|
219 (and (fboundp 'set-file-coding-system)
|
|
|
220 (set-file-coding-system 'no-conversion nil))
|
|
0
|
221 (write-region (point-min) (point-max)
|
|
|
222 (concat "/tmp/Mosaic." pid)
|
|
|
223 nil 0)
|
|
|
224 (set-buffer-modified-p nil)
|
|
|
225 (kill-buffer work-buffer)))
|
|
|
226 (cond ((or (null pid)
|
|
|
227 (not (equal 0 (vm-run-command "kill" "-USR1" pid))))
|
|
|
228 (setq new-mosaic t)))))
|
|
|
229 (if new-mosaic
|
|
70
|
230 (vm-run-background-command vm-mosaic-program url))
|
|
|
231 (vm-unsaved-message "Sending URL to Mosaic... done"))
|
|
0
|
232
|
|
54
|
233
|
|
0
|
234 (defun vm-mouse-install-mouse ()
|
|
|
235 (cond ((vm-mouse-xemacs-mouse-p)
|
|
|
236 (if (null (lookup-key vm-mode-map 'button2))
|
|
|
237 (define-key vm-mode-map 'button2 'vm-mouse-button-2)))
|
|
|
238 ((vm-mouse-fsfemacs-mouse-p)
|
|
|
239 (if (null (lookup-key vm-mode-map [mouse-2]))
|
|
|
240 (define-key vm-mode-map [mouse-2] 'vm-mouse-button-2))
|
|
98
|
241 (if vm-popup-menu-on-mouse-3
|
|
0
|
242 (progn
|
|
|
243 (define-key vm-mode-map [mouse-3] 'ignore)
|
|
|
244 (define-key vm-mode-map [down-mouse-3] 'vm-mouse-button-3))))))
|
|
|
245
|
|
|
246 (defun vm-run-background-command (command &rest arg-list)
|
|
|
247 (apply (function call-process) command nil 0 nil arg-list))
|
|
|
248
|
|
|
249 (defun vm-run-command (command &rest arg-list)
|
|
|
250 (apply (function call-process) command nil nil nil arg-list))
|
|
|
251
|
|
98
|
252 ;; return t on zero exit status
|
|
|
253 ;; return (exit-status . stderr-string) on nonzero exit status
|
|
|
254 (defun vm-run-command-on-region (start end output-buffer command
|
|
|
255 &rest arg-list)
|
|
|
256 (let ((tempfile nil) status errstring)
|
|
|
257 (unwind-protect
|
|
|
258 (progn
|
|
|
259 (setq tempfile (vm-make-tempfile-name))
|
|
|
260 (setq status
|
|
|
261 (apply 'call-process-region
|
|
|
262 start end command nil
|
|
|
263 (list output-buffer tempfile)
|
|
|
264 nil arg-list))
|
|
|
265 (cond ((equal status 0) t)
|
|
|
266 ((zerop (save-excursion
|
|
|
267 (set-buffer (find-file-noselect tempfile))
|
|
|
268 (buffer-size)))
|
|
|
269 t)
|
|
|
270 (t (save-excursion
|
|
|
271 (set-buffer (find-file-noselect tempfile))
|
|
|
272 (setq errstring (buffer-string))
|
|
|
273 (kill-buffer nil)
|
|
|
274 (cons status errstring)))))
|
|
|
275 (vm-error-free-call 'delete-file tempfile))))
|
|
|
276
|
|
0
|
277 ;; stupid yammering compiler
|
|
|
278 (defvar vm-mouse-read-file-name-prompt)
|
|
|
279 (defvar vm-mouse-read-file-name-dir)
|
|
|
280 (defvar vm-mouse-read-file-name-default)
|
|
|
281 (defvar vm-mouse-read-file-name-must-match)
|
|
|
282 (defvar vm-mouse-read-file-name-initial)
|
|
|
283 (defvar vm-mouse-read-file-name-history)
|
|
|
284 (defvar vm-mouse-read-file-name-return-value)
|
|
|
285
|
|
|
286 (defun vm-mouse-read-file-name (prompt &optional dir default
|
|
|
287 must-match initial history)
|
|
|
288 "Like read-file-name, except uses a mouse driven interface.
|
|
|
289 HISTORY argument is ignored."
|
|
|
290 (save-excursion
|
|
|
291 (or dir (setq dir default-directory))
|
|
|
292 (set-buffer (generate-new-buffer " *Files*"))
|
|
|
293 (use-local-map (make-sparse-keymap))
|
|
|
294 (setq buffer-read-only t
|
|
|
295 default-directory dir)
|
|
|
296 (make-local-variable 'vm-mouse-read-file-name-prompt)
|
|
|
297 (make-local-variable 'vm-mouse-read-file-name-dir)
|
|
|
298 (make-local-variable 'vm-mouse-read-file-name-default)
|
|
|
299 (make-local-variable 'vm-mouse-read-file-name-must-match)
|
|
|
300 (make-local-variable 'vm-mouse-read-file-name-initial)
|
|
|
301 (make-local-variable 'vm-mouse-read-file-name-history)
|
|
|
302 (make-local-variable 'vm-mouse-read-file-name-return-value)
|
|
|
303 (setq vm-mouse-read-file-name-prompt prompt)
|
|
|
304 (setq vm-mouse-read-file-name-dir dir)
|
|
|
305 (setq vm-mouse-read-file-name-default default)
|
|
|
306 (setq vm-mouse-read-file-name-must-match must-match)
|
|
|
307 (setq vm-mouse-read-file-name-initial initial)
|
|
|
308 (setq vm-mouse-read-file-name-history history)
|
|
|
309 (setq vm-mouse-read-file-name-prompt prompt)
|
|
|
310 (setq vm-mouse-read-file-name-return-value nil)
|
|
98
|
311 (if (and vm-frame-per-completion (vm-multiple-frames-possible-p))
|
|
|
312 (save-excursion
|
|
|
313 (vm-goto-new-frame 'completion)))
|
|
0
|
314 (switch-to-buffer (current-buffer))
|
|
|
315 (vm-mouse-read-file-name-event-handler)
|
|
|
316 (save-excursion
|
|
|
317 (local-set-key "\C-g" 'vm-mouse-read-file-name-quit-handler)
|
|
|
318 (recursive-edit))
|
|
|
319 ;; buffer could have been killed
|
|
|
320 (and (boundp 'vm-mouse-read-file-name-return-value)
|
|
|
321 (prog1
|
|
|
322 vm-mouse-read-file-name-return-value
|
|
|
323 (kill-buffer (current-buffer))))))
|
|
|
324
|
|
|
325 (defun vm-mouse-read-file-name-event-handler (&optional string)
|
|
|
326 (let ((key-doc "Click here for keyboard interface.")
|
|
|
327 start list)
|
|
|
328 (if string
|
|
|
329 (cond ((equal string key-doc)
|
|
|
330 (condition-case nil
|
|
|
331 (save-excursion
|
|
70
|
332 (save-excursion
|
|
|
333 (let ((vm-mutable-frames t))
|
|
|
334 (vm-delete-windows-or-frames-on (current-buffer))))
|
|
0
|
335 (setq vm-mouse-read-file-name-return-value
|
|
100
|
336 (save-excursion
|
|
|
337 (vm-keyboard-read-file-name
|
|
|
338 vm-mouse-read-file-name-prompt
|
|
|
339 vm-mouse-read-file-name-dir
|
|
|
340 vm-mouse-read-file-name-default
|
|
|
341 vm-mouse-read-file-name-must-match
|
|
|
342 vm-mouse-read-file-name-initial
|
|
|
343 vm-mouse-read-file-name-history)))
|
|
0
|
344 (vm-mouse-read-file-name-quit-handler t))
|
|
|
345 (quit (vm-mouse-read-file-name-quit-handler))))
|
|
|
346 ((file-directory-p string)
|
|
|
347 (setq default-directory (expand-file-name string)))
|
|
|
348 (t (setq vm-mouse-read-file-name-return-value
|
|
|
349 (expand-file-name string))
|
|
|
350 (vm-mouse-read-file-name-quit-handler t))))
|
|
|
351 (setq buffer-read-only nil)
|
|
|
352 (erase-buffer)
|
|
|
353 (setq start (point))
|
|
|
354 (insert vm-mouse-read-file-name-prompt)
|
|
|
355 (vm-set-region-face start (point) 'bold)
|
|
|
356 (cond ((and (not string) vm-mouse-read-file-name-default)
|
|
|
357 (setq start (point))
|
|
|
358 (insert vm-mouse-read-file-name-default)
|
|
|
359 (vm-mouse-set-mouse-track-highlight start (point)))
|
|
|
360 ((not string) nil)
|
|
|
361 (t (insert default-directory)))
|
|
|
362 (insert ?\n ?\n)
|
|
|
363 (setq start (point))
|
|
|
364 (insert key-doc)
|
|
|
365 (vm-mouse-set-mouse-track-highlight start (point))
|
|
|
366 (vm-set-region-face start (point) 'italic)
|
|
|
367 (insert ?\n ?\n)
|
|
98
|
368 (setq list (vm-delete-backup-file-names
|
|
|
369 (vm-delete-auto-save-file-names
|
|
|
370 (directory-files default-directory))))
|
|
0
|
371 (vm-show-list list 'vm-mouse-read-file-name-event-handler)
|
|
|
372 (setq buffer-read-only t)))
|
|
|
373
|
|
|
374 (defun vm-mouse-read-file-name-quit-handler (&optional normal-exit)
|
|
|
375 (interactive)
|
|
70
|
376 (let ((vm-mutable-frames t))
|
|
|
377 (vm-delete-windows-or-frames-on (current-buffer))
|
|
|
378 (if normal-exit
|
|
|
379 (throw 'exit nil)
|
|
|
380 (throw 'exit t))))
|
|
0
|
381
|
|
|
382 (defvar vm-mouse-read-string-prompt)
|
|
|
383 (defvar vm-mouse-read-string-completion-list)
|
|
|
384 (defvar vm-mouse-read-string-multi-word)
|
|
|
385 (defvar vm-mouse-read-string-return-value)
|
|
|
386
|
|
|
387 (defun vm-mouse-read-string (prompt completion-list &optional multi-word)
|
|
|
388 (save-excursion
|
|
|
389 (set-buffer (generate-new-buffer " *Choices*"))
|
|
|
390 (use-local-map (make-sparse-keymap))
|
|
|
391 (setq buffer-read-only t)
|
|
|
392 (make-local-variable 'vm-mouse-read-string-prompt)
|
|
|
393 (make-local-variable 'vm-mouse-read-string-completion-list)
|
|
|
394 (make-local-variable 'vm-mouse-read-string-multi-word)
|
|
|
395 (make-local-variable 'vm-mouse-read-string-return-value)
|
|
|
396 (setq vm-mouse-read-string-prompt prompt)
|
|
|
397 (setq vm-mouse-read-string-completion-list completion-list)
|
|
|
398 (setq vm-mouse-read-string-multi-word multi-word)
|
|
|
399 (setq vm-mouse-read-string-return-value nil)
|
|
98
|
400 (if (and vm-frame-per-completion (vm-multiple-frames-possible-p))
|
|
|
401 (save-excursion
|
|
|
402 (vm-goto-new-frame 'completion)))
|
|
0
|
403 (switch-to-buffer (current-buffer))
|
|
|
404 (vm-mouse-read-string-event-handler)
|
|
|
405 (save-excursion
|
|
|
406 (local-set-key "\C-g" 'vm-mouse-read-string-quit-handler)
|
|
|
407 (recursive-edit))
|
|
|
408 ;; buffer could have been killed
|
|
|
409 (and (boundp 'vm-mouse-read-string-return-value)
|
|
|
410 (prog1
|
|
|
411 (if (listp vm-mouse-read-string-return-value)
|
|
|
412 (mapconcat 'identity vm-mouse-read-string-return-value " ")
|
|
|
413 vm-mouse-read-string-return-value)
|
|
|
414 (kill-buffer (current-buffer))))))
|
|
|
415
|
|
|
416 (defun vm-mouse-read-string-event-handler (&optional string)
|
|
|
417 (let ((key-doc "Click here for keyboard interface.")
|
|
|
418 (bs-doc " .... to go back one word.")
|
|
98
|
419 (done-doc " .... when you're done.")
|
|
0
|
420 start list)
|
|
|
421 (if string
|
|
|
422 (cond ((equal string key-doc)
|
|
|
423 (condition-case nil
|
|
|
424 (save-excursion
|
|
70
|
425 (save-excursion
|
|
|
426 (let ((vm-mutable-frames t))
|
|
|
427 (vm-delete-windows-or-frames-on (current-buffer))))
|
|
0
|
428 (setq vm-mouse-read-string-return-value
|
|
|
429 (vm-keyboard-read-string
|
|
|
430 vm-mouse-read-string-prompt
|
|
|
431 vm-mouse-read-string-completion-list
|
|
|
432 vm-mouse-read-string-multi-word))
|
|
|
433 (vm-mouse-read-string-quit-handler t))
|
|
|
434 (quit (vm-mouse-read-string-quit-handler))))
|
|
|
435 ((equal string bs-doc)
|
|
|
436 (setq vm-mouse-read-string-return-value
|
|
|
437 (nreverse
|
|
|
438 (cdr
|
|
|
439 (nreverse vm-mouse-read-string-return-value)))))
|
|
|
440 ((equal string done-doc)
|
|
|
441 (vm-mouse-read-string-quit-handler t))
|
|
|
442 (t (setq vm-mouse-read-string-return-value
|
|
|
443 (nconc vm-mouse-read-string-return-value
|
|
|
444 (list string)))
|
|
|
445 (if (null vm-mouse-read-string-multi-word)
|
|
|
446 (vm-mouse-read-string-quit-handler t)))))
|
|
|
447 (setq buffer-read-only nil)
|
|
|
448 (erase-buffer)
|
|
|
449 (setq start (point))
|
|
|
450 (insert vm-mouse-read-string-prompt)
|
|
|
451 (vm-set-region-face start (point) 'bold)
|
|
|
452 (insert (mapconcat 'identity vm-mouse-read-string-return-value " "))
|
|
|
453 (insert ?\n ?\n)
|
|
|
454 (setq start (point))
|
|
|
455 (insert key-doc)
|
|
|
456 (vm-mouse-set-mouse-track-highlight start (point))
|
|
|
457 (vm-set-region-face start (point) 'italic)
|
|
|
458 (insert ?\n)
|
|
|
459 (if vm-mouse-read-string-multi-word
|
|
|
460 (progn
|
|
|
461 (setq start (point))
|
|
|
462 (insert bs-doc)
|
|
|
463 (vm-mouse-set-mouse-track-highlight start (point))
|
|
|
464 (vm-set-region-face start (point) 'italic)
|
|
|
465 (insert ?\n)
|
|
|
466 (setq start (point))
|
|
|
467 (insert done-doc)
|
|
|
468 (vm-mouse-set-mouse-track-highlight start (point))
|
|
|
469 (vm-set-region-face start (point) 'italic)
|
|
|
470 (insert ?\n)))
|
|
|
471 (insert ?\n)
|
|
|
472 (vm-show-list vm-mouse-read-string-completion-list
|
|
|
473 'vm-mouse-read-string-event-handler)
|
|
|
474 (setq buffer-read-only t)))
|
|
|
475
|
|
|
476 (defun vm-mouse-read-string-quit-handler (&optional normal-exit)
|
|
|
477 (interactive)
|
|
70
|
478 (let ((vm-mutable-frames t))
|
|
|
479 (vm-delete-windows-or-frames-on (current-buffer))
|
|
|
480 (if normal-exit
|
|
|
481 (throw 'exit nil)
|
|
|
482 (throw 'exit t))))
|
