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