|
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)
|
|
108
|
78 (vm-menu-popup-context-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)
|
|
102
|
187 (message "Sending URL to %s..." browser)
|
|
98
|
188 (vm-run-background-command browser url)
|
|
102
|
189 (message "Sending URL to %s... done" browser))))))
|
|
0
|
190
|
|
|
191 (defun vm-mouse-send-url-to-netscape (url &optional new-netscape new-window)
|
|
102
|
192 (message "Sending URL to Netscape...")
|
|
0
|
193 (if new-netscape
|
|
114
|
194 (apply 'vm-run-background-command vm-netscape-program
|
|
|
195 (append vm-netscape-program-switches (list url)))
|
|
|
196 (or (equal 0 (apply 'vm-run-command vm-netscape-program "-remote"
|
|
|
197 (append (list (concat "openURL(" url
|
|
|
198 (if new-window ", new-window" "")
|
|
|
199 ")"))
|
|
|
200 vm-netscape-program-switches)))
|
|
0
|
201 (vm-mouse-send-url-to-netscape url t new-window)))
|
|
102
|
202 (message "Sending URL to Netscape... done"))
|
|
54
|
203
|
|
0
|
204 (defun vm-mouse-send-url-to-mosaic (url &optional new-mosaic new-window)
|
|
102
|
205 (message "Sending URL to Mosaic...")
|
|
0
|
206 (if (null new-mosaic)
|
|
|
207 (let ((pid-file "~/.mosaicpid")
|
|
|
208 (work-buffer " *mosaic work*")
|
|
|
209 pid)
|
|
|
210 (cond ((file-exists-p pid-file)
|
|
|
211 (set-buffer (get-buffer-create work-buffer))
|
|
|
212 (erase-buffer)
|
|
|
213 (insert-file-contents pid-file)
|
|
|
214 (setq pid (int-to-string (string-to-int (buffer-string))))
|
|
|
215 (erase-buffer)
|
|
|
216 (insert (if new-window "newwin" "goto") ?\n)
|
|
|
217 (insert url ?\n)
|
|
100
|
218 ;; newline convention used should be the local
|
|
|
219 ;; one, whatever that is.
|
|
|
220 (setq buffer-file-type nil)
|
|
102
|
221 (and (vm-xemacs-mule-p)
|
|
110
|
222 (set-buffer-file-coding-system 'no-conversion nil))
|
|
0
|
223 (write-region (point-min) (point-max)
|
|
|
224 (concat "/tmp/Mosaic." pid)
|
|
|
225 nil 0)
|
|
|
226 (set-buffer-modified-p nil)
|
|
|
227 (kill-buffer work-buffer)))
|
|
|
228 (cond ((or (null pid)
|
|
|
229 (not (equal 0 (vm-run-command "kill" "-USR1" pid))))
|
|
|
230 (setq new-mosaic t)))))
|
|
|
231 (if new-mosaic
|
|
114
|
232 (apply 'vm-run-background-command vm-mosaic-program
|
|
|
233 (append vm-mosaic-program-switches (list url))))
|
|
102
|
234 (message "Sending URL to Mosaic... done"))
|
|
0
|
235
|
|
|
236 (defun vm-mouse-install-mouse ()
|
|
|
237 (cond ((vm-mouse-xemacs-mouse-p)
|
|
|
238 (if (null (lookup-key vm-mode-map 'button2))
|
|
|
239 (define-key vm-mode-map 'button2 'vm-mouse-button-2)))
|
|
|
240 ((vm-mouse-fsfemacs-mouse-p)
|
|
|
241 (if (null (lookup-key vm-mode-map [mouse-2]))
|
|
|
242 (define-key vm-mode-map [mouse-2] 'vm-mouse-button-2))
|
|
98
|
243 (if vm-popup-menu-on-mouse-3
|
|
0
|
244 (progn
|
|
|
245 (define-key vm-mode-map [mouse-3] 'ignore)
|
|
|
246 (define-key vm-mode-map [down-mouse-3] 'vm-mouse-button-3))))))
|
|
|
247
|
|
|
248 (defun vm-run-background-command (command &rest arg-list)
|
|
|
249 (apply (function call-process) command nil 0 nil arg-list))
|
|
|
250
|
|
|
251 (defun vm-run-command (command &rest arg-list)
|
|
|
252 (apply (function call-process) command nil nil nil arg-list))
|
|
|
253
|
|
98
|
254 ;; return t on zero exit status
|
|
|
255 ;; return (exit-status . stderr-string) on nonzero exit status
|
|
|
256 (defun vm-run-command-on-region (start end output-buffer command
|
|
|
257 &rest arg-list)
|
|
102
|
258 (let ((tempfile nil)
|
|
|
259 ;; for DOS/Windows command to tell it that its input is
|
|
|
260 ;; binary.
|
|
|
261 (binary-process-input t)
|
|
|
262 status errstring)
|
|
98
|
263 (unwind-protect
|
|
|
264 (progn
|
|
|
265 (setq tempfile (vm-make-tempfile-name))
|
|
|
266 (setq status
|
|
|
267 (apply 'call-process-region
|
|
|
268 start end command nil
|
|
|
269 (list output-buffer tempfile)
|
|
|
270 nil arg-list))
|
|
|
271 (cond ((equal status 0) t)
|
|
102
|
272 ;; even if exit status non-zero, if there was no
|
|
108
|
273 ;; diagnostic output the command probably
|
|
|
274 ;; succeeded. I have tried to just use exit status
|
|
|
275 ;; as the failure criterion and users complained.
|
|
102
|
276 ((equal (nth 7 (file-attributes tempfile)) 0)
|
|
|
277 (message "%s exited non-zero (code %s)" command status)
|
|
98
|
278 t)
|
|
|
279 (t (save-excursion
|
|
102
|
280 (message "%s exited non-zero (code %s)" command status)
|
|
98
|
281 (set-buffer (find-file-noselect tempfile))
|
|
|
282 (setq errstring (buffer-string))
|
|
|
283 (kill-buffer nil)
|
|
|
284 (cons status errstring)))))
|
|
|
285 (vm-error-free-call 'delete-file tempfile))))
|
|
|
286
|
|
0
|
287 ;; stupid yammering compiler
|
|
|
288 (defvar vm-mouse-read-file-name-prompt)
|
|
|
289 (defvar vm-mouse-read-file-name-dir)
|
|
|
290 (defvar vm-mouse-read-file-name-default)
|
|
|
291 (defvar vm-mouse-read-file-name-must-match)
|
|
|
292 (defvar vm-mouse-read-file-name-initial)
|
|
|
293 (defvar vm-mouse-read-file-name-history)
|
|
|
294 (defvar vm-mouse-read-file-name-return-value)
|
|
|
295
|
|
|
296 (defun vm-mouse-read-file-name (prompt &optional dir default
|
|
|
297 must-match initial history)
|
|
|
298 "Like read-file-name, except uses a mouse driven interface.
|
|
|
299 HISTORY argument is ignored."
|
|
|
300 (save-excursion
|
|
|
301 (or dir (setq dir default-directory))
|
|
|
302 (set-buffer (generate-new-buffer " *Files*"))
|
|
|
303 (use-local-map (make-sparse-keymap))
|
|
|
304 (setq buffer-read-only t
|
|
|
305 default-directory dir)
|
|
|
306 (make-local-variable 'vm-mouse-read-file-name-prompt)
|
|
|
307 (make-local-variable 'vm-mouse-read-file-name-dir)
|
|
|
308 (make-local-variable 'vm-mouse-read-file-name-default)
|
|
|
309 (make-local-variable 'vm-mouse-read-file-name-must-match)
|
|
|
310 (make-local-variable 'vm-mouse-read-file-name-initial)
|
|
|
311 (make-local-variable 'vm-mouse-read-file-name-history)
|
|
|
312 (make-local-variable 'vm-mouse-read-file-name-return-value)
|
|
|
313 (setq vm-mouse-read-file-name-prompt prompt)
|
|
|
314 (setq vm-mouse-read-file-name-dir dir)
|
|
|
315 (setq vm-mouse-read-file-name-default default)
|
|
|
316 (setq vm-mouse-read-file-name-must-match must-match)
|
|
|
317 (setq vm-mouse-read-file-name-initial initial)
|
|
|
318 (setq vm-mouse-read-file-name-history history)
|
|
|
319 (setq vm-mouse-read-file-name-prompt prompt)
|
|
|
320 (setq vm-mouse-read-file-name-return-value nil)
|
|
98
|
321 (if (and vm-frame-per-completion (vm-multiple-frames-possible-p))
|
|
|
322 (save-excursion
|
|
|
323 (vm-goto-new-frame 'completion)))
|
|
0
|
324 (switch-to-buffer (current-buffer))
|
|
|
325 (vm-mouse-read-file-name-event-handler)
|
|
|
326 (save-excursion
|
|
|
327 (local-set-key "\C-g" 'vm-mouse-read-file-name-quit-handler)
|
|
|
328 (recursive-edit))
|
|
|
329 ;; buffer could have been killed
|
|
|
330 (and (boundp 'vm-mouse-read-file-name-return-value)
|
|
|
331 (prog1
|
|
|
332 vm-mouse-read-file-name-return-value
|
|
|
333 (kill-buffer (current-buffer))))))
|
|
|
334
|
|
|
335 (defun vm-mouse-read-file-name-event-handler (&optional string)
|
|
|
336 (let ((key-doc "Click here for keyboard interface.")
|
|
|
337 start list)
|
|
|
338 (if string
|
|
|
339 (cond ((equal string key-doc)
|
|
|
340 (condition-case nil
|
|
|
341 (save-excursion
|
|
70
|
342 (save-excursion
|
|
|
343 (let ((vm-mutable-frames t))
|
|
|
344 (vm-delete-windows-or-frames-on (current-buffer))))
|
|
0
|
345 (setq vm-mouse-read-file-name-return-value
|
|
100
|
346 (save-excursion
|
|
|
347 (vm-keyboard-read-file-name
|
|
|
348 vm-mouse-read-file-name-prompt
|
|
|
349 vm-mouse-read-file-name-dir
|
|
|
350 vm-mouse-read-file-name-default
|
|
|
351 vm-mouse-read-file-name-must-match
|
|
|
352 vm-mouse-read-file-name-initial
|
|
|
353 vm-mouse-read-file-name-history)))
|
|
0
|
354 (vm-mouse-read-file-name-quit-handler t))
|
|
|
355 (quit (vm-mouse-read-file-name-quit-handler))))
|
|
|
356 ((file-directory-p string)
|
|
|
357 (setq default-directory (expand-file-name string)))
|
|
|
358 (t (setq vm-mouse-read-file-name-return-value
|
|
|
359 (expand-file-name string))
|
|
|
360 (vm-mouse-read-file-name-quit-handler t))))
|
|
|
361 (setq buffer-read-only nil)
|
|
|
362 (erase-buffer)
|
|
|
363 (setq start (point))
|
|
|
364 (insert vm-mouse-read-file-name-prompt)
|
|
|
365 (vm-set-region-face start (point) 'bold)
|
|
|
366 (cond ((and (not string) vm-mouse-read-file-name-default)
|
|
|
367 (setq start (point))
|
|
|
368 (insert vm-mouse-read-file-name-default)
|
|
|
369 (vm-mouse-set-mouse-track-highlight start (point)))
|
|
|
370 ((not string) nil)
|
|
|
371 (t (insert default-directory)))
|
|
|
372 (insert ?\n ?\n)
|
|
|
373 (setq start (point))
|
|
|
374 (insert key-doc)
|
|
|
375 (vm-mouse-set-mouse-track-highlight start (point))
|
|
|
376 (vm-set-region-face start (point) 'italic)
|
|
|
377 (insert ?\n ?\n)
|
|
98
|
378 (setq list (vm-delete-backup-file-names
|
|
|
379 (vm-delete-auto-save-file-names
|
|
|
380 (directory-files default-directory))))
|
|
0
|
381 (vm-show-list list 'vm-mouse-read-file-name-event-handler)
|
|
|
382 (setq buffer-read-only t)))
|
|
|
383
|
|
|
384 (defun vm-mouse-read-file-name-quit-handler (&optional normal-exit)
|
|
|
385 (interactive)
|
|
70
|
386 (let ((vm-mutable-frames t))
|
|
|
387 (vm-delete-windows-or-frames-on (current-buffer))
|
|
|
388 (if normal-exit
|
|
|
389 (throw 'exit nil)
|
|
|
390 (throw 'exit t))))
|
|
0
|
391
|
|
|
392 (defvar vm-mouse-read-string-prompt)
|
|
|
393 (defvar vm-mouse-read-string-completion-list)
|
|
|
394 (defvar vm-mouse-read-string-multi-word)
|
|
|
395 (defvar vm-mouse-read-string-return-value)
|
|
|
396
|
|
|
397 (defun vm-mouse-read-string (prompt completion-list &optional multi-word)
|
|
|
398 (save-excursion
|
|
|
399 (set-buffer (generate-new-buffer " *Choices*"))
|
|
|
400 (use-local-map (make-sparse-keymap))
|
|
|
401 (setq buffer-read-only t)
|
|
|
402 (make-local-variable 'vm-mouse-read-string-prompt)
|
|
|
403 (make-local-variable 'vm-mouse-read-string-completion-list)
|
|
|
404 (make-local-variable 'vm-mouse-read-string-multi-word)
|
|
|
405 (make-local-variable 'vm-mouse-read-string-return-value)
|
|
|
406 (setq vm-mouse-read-string-prompt prompt)
|
|
|
407 (setq vm-mouse-read-string-completion-list completion-list)
|
|
|
408 (setq vm-mouse-read-string-multi-word multi-word)
|
|
|
409 (setq vm-mouse-read-string-return-value nil)
|
|
98
|
410 (if (and vm-frame-per-completion (vm-multiple-frames-possible-p))
|
|
|
411 (save-excursion
|
|
|
412 (vm-goto-new-frame 'completion)))
|
|
0
|
413 (switch-to-buffer (current-buffer))
|
|
|
414 (vm-mouse-read-string-event-handler)
|
|
|
415 (save-excursion
|
|
|
416 (local-set-key "\C-g" 'vm-mouse-read-string-quit-handler)
|
|
|
417 (recursive-edit))
|
|
|
418 ;; buffer could have been killed
|
|
|
419 (and (boundp 'vm-mouse-read-string-return-value)
|
|
|
420 (prog1
|
|
|
421 (if (listp vm-mouse-read-string-return-value)
|
|
|
422 (mapconcat 'identity vm-mouse-read-string-return-value " ")
|
|
|
423 vm-mouse-read-string-return-value)
|
|
|
424 (kill-buffer (current-buffer))))))
|
|
|
425
|
|
|
426 (defun vm-mouse-read-string-event-handler (&optional string)
|
|
|
427 (let ((key-doc "Click here for keyboard interface.")
|
|
|
428 (bs-doc " .... to go back one word.")
|
|
98
|
429 (done-doc " .... when you're done.")
|
|
0
|
430 start list)
|
|
|
431 (if string
|
|
|
432 (cond ((equal string key-doc)
|
|
|
433 (condition-case nil
|
|
|
434 (save-excursion
|
|
70
|
435 (save-excursion
|
|
|
436 (let ((vm-mutable-frames t))
|
|
|
437 (vm-delete-windows-or-frames-on (current-buffer))))
|
|
0
|
438 (setq vm-mouse-read-string-return-value
|
|
|
439 (vm-keyboard-read-string
|
|
|
440 vm-mouse-read-string-prompt
|
|
|
441 vm-mouse-read-string-completion-list
|
|
|
442 vm-mouse-read-string-multi-word))
|
|
|
443 (vm-mouse-read-string-quit-handler t))
|
|
|
444 (quit (vm-mouse-read-string-quit-handler))))
|
|
|
445 ((equal string bs-doc)
|
|
|
446 (setq vm-mouse-read-string-return-value
|
|
|
447 (nreverse
|
|
|
448 (cdr
|
|
|
449 (nreverse vm-mouse-read-string-return-value)))))
|
|
|
450 ((equal string done-doc)
|
|
|
451 (vm-mouse-read-string-quit-handler t))
|
|
|
452 (t (setq vm-mouse-read-string-return-value
|
|
|
453 (nconc vm-mouse-read-string-return-value
|
|
|
454 (list string)))
|
|
|
455 (if (null vm-mouse-read-string-multi-word)
|
|
|
456 (vm-mouse-read-string-quit-handler t)))))
|
|
|
457 (setq buffer-read-only nil)
|
|
|
458 (erase-buffer)
|
|
|
459 (setq start (point))
|
|
|
460 (insert vm-mouse-read-string-prompt)
|
|
|
461 (vm-set-region-face start (point) 'bold)
|
|
|
462 (insert (mapconcat 'identity vm-mouse-read-string-return-value " "))
|
|
|
463 (insert ?\n ?\n)
|
|
|
464 (setq start (point))
|
|
|
465 (insert key-doc)
|
|
|
466 (vm-mouse-set-mouse-track-highlight start (point))
|
|
|
467 (vm-set-region-face start (point) 'italic)
|
|
|
468 (insert ?\n)
|
|
|
469 (if vm-mouse-read-string-multi-word
|
|
|
470 (progn
|
|
|
471 (setq start (point))
|
|
|
472 (insert bs-doc)
|
|
|
473 (vm-mouse-set-mouse-track-highlight start (point))
|
|
|
474 (vm-set-region-face start (point) 'italic)
|
|
|
475 (insert ?\n)
|
|
|
476 (setq start (point))
|
|
|
477 (insert done-doc)
|
|
|
478 (vm-mouse-set-mouse-track-highlight start (point))
|
|
|
479 (vm-set-region-face start (point) 'italic)
|
|
|
480 (insert ?\n)))
|
|
|
481 (insert ?\n)
|
|
|
482 (vm-show-list vm-mouse-read-string-completion-list
|
|
|
483 'vm-mouse-read-string-event-handler)
|
|
|
484 (setq buffer-read-only t)))
|
|
|
485
|
|
|
486 (defun vm-mouse-read-string-quit-handler (&optional normal-exit)
|
|
|
487 (interactive)
|
|
70
|
488 (let ((vm-mutable-frames t))
|
|
|
489 (vm-delete-windows-or-frames-on (current-buffer))
|
|
|
490 (if normal-exit
|
|
|
491 (throw 'exit nil)
|
|
|
492 (throw 'exit t))))
|
