Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-mouse.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 05472e90ae02
children 0d2f883870bc
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
1 ;;; Mouse related functions and commands 1 ;;; Mouse related functions and commands
2 ;;; Copyright (C) 1995-1997 Kyle E. Jones 2 ;;; Copyright (C) 1995 Kyle E. Jones
3 ;;; 3 ;;;
4 ;;; This program is free software; you can redistribute it and/or modify 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 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) 6 ;;; the Free Software Foundation; either version 1, or (at your option)
7 ;;; any later version. 7 ;;; any later version.
16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 16 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
17 17
18 (provide 'vm-mouse) 18 (provide 'vm-mouse)
19 19
20 (defun vm-mouse-fsfemacs-mouse-p () 20 (defun vm-mouse-fsfemacs-mouse-p ()
21 (and vm-fsfemacs-19-p 21 (and (vm-fsfemacs-19-p)
22 (fboundp 'set-mouse-position))) 22 (fboundp 'set-mouse-position)))
23 23
24 (defun vm-mouse-xemacs-mouse-p () 24 (defun vm-mouse-xemacs-mouse-p ()
25 (and vm-xemacs-p 25 (and (vm-xemacs-p)
26 (fboundp 'set-mouse-position))) 26 (fboundp 'set-mouse-position)))
27 27
28 (defun vm-mouse-set-mouse-track-highlight (start end) 28 (defun vm-mouse-set-mouse-track-highlight (start end)
29 (cond (vm-fsfemacs-19-p 29 (cond ((fboundp 'make-overlay)
30 (let ((o (make-overlay start end))) 30 (let ((o (make-overlay start end)))
31 (overlay-put o 'mouse-face 'highlight))) 31 (overlay-put o 'mouse-face 'highlight)))
32 (vm-xemacs-p 32 ((fboundp 'make-extent)
33 (let ((o (make-extent start end))) 33 (let ((o (make-extent start end)))
34 (set-extent-property o 'highlight t))))) 34 (set-extent-property o 'highlight t)))))
35 35
36 (defun vm-mouse-button-2 (event) 36 (defun vm-mouse-button-2 (event)
37 (interactive "e") 37 (interactive "e")
46 (cond ((eq major-mode 'vm-summary-mode) 46 (cond ((eq major-mode 'vm-summary-mode)
47 (mouse-set-point event) 47 (mouse-set-point event)
48 (beginning-of-line) 48 (beginning-of-line)
49 (if (let ((vm-follow-summary-cursor t)) 49 (if (let ((vm-follow-summary-cursor t))
50 (vm-follow-summary-cursor)) 50 (vm-follow-summary-cursor))
51 nil 51 (progn
52 (vm-select-folder-buffer)
53 (vm-preview-current-message))
52 (setq this-command 'vm-scroll-forward) 54 (setq this-command 'vm-scroll-forward)
53 (call-interactively 'vm-scroll-forward))) 55 (call-interactively 'vm-scroll-forward)))
54 ((memq major-mode '(vm-mode vm-virtual-mode vm-presentation-mode)) 56 ((memq major-mode '(vm-mode vm-virtual-mode))
55 (vm-mouse-popup-or-select event)))) 57 (cond ((and (vm-mouse-fsfemacs-mouse-p) vm-url-browser)
58 (vm-mouse-popup-or-select event))))))
56 59
57 (defun vm-mouse-button-3 (event) 60 (defun vm-mouse-button-3 (event)
58 (interactive "e") 61 (interactive "e")
59 (if vm-use-menus 62 (if vm-use-menus
60 (progn 63 (progn
68 ;; now dispatch depending on where we are 71 ;; now dispatch depending on where we are
69 (cond ((eq major-mode 'vm-summary-mode) 72 (cond ((eq major-mode 'vm-summary-mode)
70 (vm-menu-popup-mode-menu event)) 73 (vm-menu-popup-mode-menu event))
71 ((eq major-mode 'vm-mode) 74 ((eq major-mode 'vm-mode)
72 (vm-menu-popup-context-menu event)) 75 (vm-menu-popup-context-menu event))
73 ((eq major-mode 'vm-presentation-mode)
74 (vm-menu-popup-context-menu event))
75 ((eq major-mode 'vm-virtual-mode) 76 ((eq major-mode 'vm-virtual-mode)
76 (vm-menu-popup-context-menu event)) 77 (vm-menu-popup-context-menu event))
77 ((eq major-mode 'mail-mode) 78 ((eq major-mode 'mail-mode)
78 (vm-menu-popup-context-menu event)))))) 79 (vm-menu-popup-mode-menu event))))))
79 80
80 (defun vm-mouse-3-help (object) 81 (defun vm-mouse-3-help (object)
81 nil
82 "Use mouse button 3 to see a menu of options.") 82 "Use mouse button 3 to see a menu of options.")
83 83
84 (defun vm-mouse-get-mouse-track-string (event) 84 (defun vm-mouse-get-mouse-track-string (event)
85 (save-excursion 85 (save-excursion
86 ;; go to where the event occurred 86 ;; go to where the event occurred
88 (set-buffer (window-buffer (event-window event))) 88 (set-buffer (window-buffer (event-window event)))
89 (and (event-point event) (goto-char (event-point event)))) 89 (and (event-point event) (goto-char (event-point event))))
90 ((vm-mouse-fsfemacs-mouse-p) 90 ((vm-mouse-fsfemacs-mouse-p)
91 (set-buffer (window-buffer (posn-window (event-start event)))) 91 (set-buffer (window-buffer (posn-window (event-start event))))
92 (goto-char (posn-point (event-start event))))) 92 (goto-char (posn-point (event-start event)))))
93 (cond (vm-fsfemacs-19-p 93 (cond ((fboundp 'overlays-at)
94 (let ((o-list (overlays-at (point))) 94 (let ((o-list (overlays-at (point)))
95 (string nil)) 95 (string nil))
96 (while o-list 96 (while o-list
97 (if (overlay-get (car o-list) 'mouse-face) 97 (if (overlay-get (car o-list) 'mouse-face)
98 (setq string (vm-buffer-substring-no-properties 98 (setq string (vm-buffer-substring-no-properties
99 (overlay-start (car o-list)) 99 (overlay-start (car o-list))
100 (overlay-end (car o-list))) 100 (overlay-end (car o-list)))
101 o-list nil) 101 o-list nil)
102 (setq o-list (cdr o-list)))) 102 (setq o-list (cdr o-list))))
103 string )) 103 string ))
104 (vm-xemacs-p 104 ((fboundp 'extent-at)
105 (let ((e (extent-at (point) nil 'highlight))) 105 (let ((e (extent-at (point) nil 'highlight)))
106 (if e 106 (if e
107 (buffer-substring (extent-start-position e) 107 (buffer-substring (extent-start-position e)
108 (extent-end-position e)) 108 (extent-end-position e))
109 nil))) 109 nil)))
112 (defun vm-mouse-popup-or-select (event) 112 (defun vm-mouse-popup-or-select (event)
113 (interactive "e") 113 (interactive "e")
114 (cond ((vm-mouse-fsfemacs-mouse-p) 114 (cond ((vm-mouse-fsfemacs-mouse-p)
115 (set-buffer (window-buffer (posn-window (event-start event)))) 115 (set-buffer (window-buffer (posn-window (event-start event))))
116 (goto-char (posn-point (event-start event))) 116 (goto-char (posn-point (event-start event)))
117 (let (o-list (found nil)) 117 (let (o-list o menu (found nil))
118 (setq o-list (overlays-at (point))) 118 (setq o-list (overlays-at (point)))
119 (while (and o-list (not found)) 119 (while (and o-list (not found))
120 (cond ((overlay-get (car o-list) 'vm-url) 120 (cond ((overlay-get (car o-list) 'vm-url)
121 (setq found t) 121 (setq found t)
122 (vm-mouse-send-url-at-event event)) 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))))
127 (setq o-list (cdr o-list))) 123 (setq o-list (cdr o-list)))
128 (and (not found) (vm-menu-popup-context-menu event)))) 124 (and (not found) (vm-menu-popup-context-menu event))))
129 ;; The XEmacs code is not actually used now, since all 125 ;; The XEmacs code is not actually used now, since all
130 ;; selectable objects are handled by an extent keymap 126 ;; selectable objects are handled by an extent keymap
131 ;; binding that points to a more specific function. But 127 ;; binding that points to a more specific function. But
132 ;; this might come in handy later if I want selectable 128 ;; this might come in handy later if I want selectable
133 ;; objects that don't have an extent or extent keymap 129 ;; objects that don't have an extent attached.
134 ;; attached.
135 ((vm-mouse-xemacs-mouse-p) 130 ((vm-mouse-xemacs-mouse-p)
136 (set-buffer (window-buffer (event-window event))) 131 (set-buffer (window-buffer (event-window event)))
137 (and (event-point event) (goto-char (event-point event))) 132 (and (event-point event) (goto-char (event-point event)))
138 (let (e) 133 (if (extent-at (point) (current-buffer) 'vm-url)
139 (cond ((extent-at (point) (current-buffer) 'vm-url) 134 (vm-mouse-send-url-at-event event)
140 (vm-mouse-send-url-at-event event)) 135 (vm-menu-popup-context-menu 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)))))))
144 136
145 (defun vm-mouse-send-url-at-event (event) 137 (defun vm-mouse-send-url-at-event (event)
146 (interactive "e") 138 (interactive "e")
147 (cond ((vm-mouse-xemacs-mouse-p) 139 (cond ((vm-mouse-xemacs-mouse-p)
148 (set-buffer (window-buffer (event-window event))) 140 (set-buffer (window-buffer (event-window event)))
152 (set-buffer (window-buffer (posn-window (event-start event)))) 144 (set-buffer (window-buffer (posn-window (event-start event))))
153 (goto-char (posn-point (event-start event))) 145 (goto-char (posn-point (event-start event)))
154 (vm-mouse-send-url-at-position (posn-point (event-start event)))))) 146 (vm-mouse-send-url-at-position (posn-point (event-start event))))))
155 147
156 (defun vm-mouse-send-url-at-position (pos &optional browser) 148 (defun vm-mouse-send-url-at-position (pos &optional browser)
157 (save-restriction 149 (cond ((vm-mouse-xemacs-mouse-p)
158 (widen) 150 (let ((e (extent-at pos (current-buffer) 'vm-url))
159 (cond ((vm-mouse-xemacs-mouse-p) 151 url)
160 (let ((e (extent-at pos (current-buffer) 'vm-url)) 152 (if (null e)
161 url) 153 nil
162 (if (null e) 154 (setq url (buffer-substring (extent-start-position e)
163 nil 155 (extent-end-position e)))
164 (setq url (buffer-substring (extent-start-position e) 156 (vm-mouse-send-url url browser))))
165 (extent-end-position e))) 157 ((vm-mouse-fsfemacs-mouse-p)
166 (vm-mouse-send-url url browser)))) 158 (let (o-list url o)
167 ((vm-mouse-fsfemacs-mouse-p) 159 (setq o-list (overlays-at pos))
168 (let (o-list url o) 160 (while (and o-list (null (overlay-get (car o-list) 'vm-url)))
169 (setq o-list (overlays-at pos)) 161 (setq o-list (cdr o-list)))
170 (while (and o-list (null (overlay-get (car o-list) 'vm-url))) 162 (if (null o-list)
171 (setq o-list (cdr o-list))) 163 nil
172 (if (null o-list) 164 (setq o (car o-list))
173 nil 165 (setq url (vm-buffer-substring-no-properties
174 (setq o (car o-list)) 166 (overlay-start o)
175 (setq url (vm-buffer-substring-no-properties 167 (overlay-end o)))
176 (overlay-start o) 168 (vm-mouse-send-url url browser))))))
177 (overlay-end o)))
178 (vm-mouse-send-url url browser)))))))
179 169
180 (defun vm-mouse-send-url (url &optional browser) 170 (defun vm-mouse-send-url (url &optional browser)
181 (if (string-match "^mailto:" url) 171 (let ((browser (or browser vm-url-browser)))
182 (vm-mail-to-mailto-url url) 172 (cond ((symbolp browser)
183 (let ((browser (or browser vm-url-browser))) 173 (funcall browser url))
184 (cond ((symbolp browser) 174 ((stringp browser)
185 (funcall browser url)) 175 (vm-unsaved-message "Sending URL to %s..." browser)
186 ((stringp browser) 176 (vm-run-background-command browser url)
187 (message "Sending URL to %s..." browser) 177 (vm-unsaved-message "Sending URL to %s... done" browser)))))
188 (vm-run-background-command browser url)
189 (message "Sending URL to %s... done" browser))))))
190 178
191 (defun vm-mouse-send-url-to-netscape (url &optional new-netscape new-window) 179 (defun vm-mouse-send-url-to-netscape (url &optional new-netscape new-window)
192 (message "Sending URL to Netscape...") 180 (vm-unsaved-message "Sending URL to Netscape...")
193 (if new-netscape 181 (if new-netscape
194 (apply 'vm-run-background-command vm-netscape-program 182 (vm-run-background-command vm-netscape-program url)
195 (append vm-netscape-program-switches (list url))) 183 (or (equal 0 (vm-run-command vm-netscape-program "-remote"
196 (or (equal 0 (apply 'vm-run-command vm-netscape-program "-remote" 184 (concat "openURL(" url
197 (append (list (concat "openURL(" url 185 (if new-window ", new-window" "")
198 (if new-window ", new-window" "") 186 ")")))
199 ")"))
200 vm-netscape-program-switches)))
201 (vm-mouse-send-url-to-netscape url t new-window))) 187 (vm-mouse-send-url-to-netscape url t new-window)))
202 (message "Sending URL to Netscape... done")) 188 (vm-unsaved-message "Sending URL to Netscape... done"))
203
204 (defun vm-mouse-send-url-to-netscape-new-window (url)
205 (vm-mouse-send-url-to-netscape url nil t))
206 189
207 (defun vm-mouse-send-url-to-mosaic (url &optional new-mosaic new-window) 190 (defun vm-mouse-send-url-to-mosaic (url &optional new-mosaic new-window)
208 (message "Sending URL to Mosaic...") 191 (vm-unsaved-message "Sending URL to Mosaic...")
209 (if (null new-mosaic) 192 (if (null new-mosaic)
210 (let ((pid-file "~/.mosaicpid") 193 (let ((pid-file "~/.mosaicpid")
211 (work-buffer " *mosaic work*") 194 (work-buffer " *mosaic work*")
212 pid) 195 pid)
213 (cond ((file-exists-p pid-file) 196 (cond ((file-exists-p pid-file)
216 (insert-file-contents pid-file) 199 (insert-file-contents pid-file)
217 (setq pid (int-to-string (string-to-int (buffer-string)))) 200 (setq pid (int-to-string (string-to-int (buffer-string))))
218 (erase-buffer) 201 (erase-buffer)
219 (insert (if new-window "newwin" "goto") ?\n) 202 (insert (if new-window "newwin" "goto") ?\n)
220 (insert url ?\n) 203 (insert url ?\n)
221 ;; newline convention used should be the local
222 ;; one, whatever that is.
223 (setq buffer-file-type nil)
224 (and vm-xemacs-mule-p
225 (set-buffer-file-coding-system 'no-conversion nil))
226 (write-region (point-min) (point-max) 204 (write-region (point-min) (point-max)
227 (concat "/tmp/Mosaic." pid) 205 (concat "/tmp/Mosaic." pid)
228 nil 0) 206 nil 0)
229 (set-buffer-modified-p nil) 207 (set-buffer-modified-p nil)
230 (kill-buffer work-buffer))) 208 (kill-buffer work-buffer)))
231 (cond ((or (null pid) 209 (cond ((or (null pid)
232 (not (equal 0 (vm-run-command "kill" "-USR1" pid)))) 210 (not (equal 0 (vm-run-command "kill" "-USR1" pid))))
233 (setq new-mosaic t))))) 211 (setq new-mosaic t)))))
234 (if new-mosaic 212 (if new-mosaic
235 (apply 'vm-run-background-command vm-mosaic-program 213 (vm-run-background-command vm-mosaic-program url))
236 (append vm-mosaic-program-switches (list url)))) 214 (vm-unsaved-message "Sending URL to Mosaic... done"))
237 (message "Sending URL to Mosaic... done")) 215
238
239 (defun vm-mouse-send-url-to-mosaic-new-window (url)
240 (vm-mouse-send-url-to-mosaic url nil t))
241 216
242 (defun vm-mouse-install-mouse () 217 (defun vm-mouse-install-mouse ()
243 (cond ((vm-mouse-xemacs-mouse-p) 218 (cond ((vm-mouse-xemacs-mouse-p)
244 (if (null (lookup-key vm-mode-map 'button2)) 219 (if (null (lookup-key vm-mode-map 'button2))
245 (define-key vm-mode-map 'button2 'vm-mouse-button-2))) 220 (define-key vm-mode-map 'button2 'vm-mouse-button-2)))
246 ((vm-mouse-fsfemacs-mouse-p) 221 ((vm-mouse-fsfemacs-mouse-p)
247 (if (null (lookup-key vm-mode-map [mouse-2])) 222 (if (null (lookup-key vm-mode-map [mouse-2]))
248 (define-key vm-mode-map [mouse-2] 'vm-mouse-button-2)) 223 (define-key vm-mode-map [mouse-2] 'vm-mouse-button-2))
249 (if vm-popup-menu-on-mouse-3 224 (if (null (lookup-key vm-mode-map [down-mouse-3]))
250 (progn 225 (progn
251 (define-key vm-mode-map [mouse-3] 'ignore) 226 (define-key vm-mode-map [mouse-3] 'ignore)
252 (define-key vm-mode-map [down-mouse-3] 'vm-mouse-button-3)))))) 227 (define-key vm-mode-map [down-mouse-3] 'vm-mouse-button-3))))))
253 228
254 (defun vm-run-background-command (command &rest arg-list) 229 (defun vm-run-background-command (command &rest arg-list)
255 (apply (function call-process) command nil 0 nil arg-list)) 230 (apply (function call-process) command nil 0 nil arg-list))
256 231
257 (defun vm-run-command (command &rest arg-list) 232 (defun vm-run-command (command &rest arg-list)
258 (apply (function call-process) command nil nil nil arg-list)) 233 (apply (function call-process) command nil nil nil arg-list))
259
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)
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)
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)
278 ;; even if exit status non-zero, if there was no
279 ;; diagnostic output the command probably
280 ;; succeeded. I have tried to just use exit status
281 ;; as the failure criterion and users complained.
282 ((equal (nth 7 (file-attributes tempfile)) 0)
283 (message "%s exited non-zero (code %s)" command status)
284 t)
285 (t (save-excursion
286 (message "%s exited non-zero (code %s)" command status)
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 234
293 ;; stupid yammering compiler 235 ;; stupid yammering compiler
294 (defvar vm-mouse-read-file-name-prompt) 236 (defvar vm-mouse-read-file-name-prompt)
295 (defvar vm-mouse-read-file-name-dir) 237 (defvar vm-mouse-read-file-name-dir)
296 (defvar vm-mouse-read-file-name-default) 238 (defvar vm-mouse-read-file-name-default)
322 (setq vm-mouse-read-file-name-must-match must-match) 264 (setq vm-mouse-read-file-name-must-match must-match)
323 (setq vm-mouse-read-file-name-initial initial) 265 (setq vm-mouse-read-file-name-initial initial)
324 (setq vm-mouse-read-file-name-history history) 266 (setq vm-mouse-read-file-name-history history)
325 (setq vm-mouse-read-file-name-prompt prompt) 267 (setq vm-mouse-read-file-name-prompt prompt)
326 (setq vm-mouse-read-file-name-return-value nil) 268 (setq vm-mouse-read-file-name-return-value nil)
327 (if (and vm-mutable-frames vm-frame-per-completion 269 (save-excursion
328 (vm-multiple-frames-possible-p)) 270 (vm-goto-new-frame 'completion))
329 (save-excursion
330 (vm-goto-new-frame 'completion)))
331 (switch-to-buffer (current-buffer)) 271 (switch-to-buffer (current-buffer))
332 (vm-mouse-read-file-name-event-handler) 272 (vm-mouse-read-file-name-event-handler)
333 (save-excursion 273 (save-excursion
334 (local-set-key "\C-g" 'vm-mouse-read-file-name-quit-handler) 274 (local-set-key "\C-g" 'vm-mouse-read-file-name-quit-handler)
335 (recursive-edit)) 275 (recursive-edit))
344 start list) 284 start list)
345 (if string 285 (if string
346 (cond ((equal string key-doc) 286 (cond ((equal string key-doc)
347 (condition-case nil 287 (condition-case nil
348 (save-excursion 288 (save-excursion
289 (save-excursion
290 (let ((vm-mutable-frames t))
291 (vm-delete-windows-or-frames-on (current-buffer))))
349 (setq vm-mouse-read-file-name-return-value 292 (setq vm-mouse-read-file-name-return-value
350 (save-excursion 293 (vm-keyboard-read-file-name
351 (vm-keyboard-read-file-name 294 vm-mouse-read-file-name-prompt
352 vm-mouse-read-file-name-prompt 295 vm-mouse-read-file-name-dir
353 vm-mouse-read-file-name-dir 296 vm-mouse-read-file-name-default
354 vm-mouse-read-file-name-default 297 vm-mouse-read-file-name-must-match
355 vm-mouse-read-file-name-must-match 298 vm-mouse-read-file-name-initial
356 vm-mouse-read-file-name-initial 299 vm-mouse-read-file-name-history))
357 vm-mouse-read-file-name-history)))
358 (vm-mouse-read-file-name-quit-handler t)) 300 (vm-mouse-read-file-name-quit-handler t))
359 (quit (vm-mouse-read-file-name-quit-handler)))) 301 (quit (vm-mouse-read-file-name-quit-handler))))
360 ((file-directory-p string) 302 ((file-directory-p string)
361 (setq default-directory (expand-file-name string))) 303 (setq default-directory (expand-file-name string)))
362 (t (setq vm-mouse-read-file-name-return-value 304 (t (setq vm-mouse-read-file-name-return-value
377 (setq start (point)) 319 (setq start (point))
378 (insert key-doc) 320 (insert key-doc)
379 (vm-mouse-set-mouse-track-highlight start (point)) 321 (vm-mouse-set-mouse-track-highlight start (point))
380 (vm-set-region-face start (point) 'italic) 322 (vm-set-region-face start (point) 'italic)
381 (insert ?\n ?\n) 323 (insert ?\n ?\n)
382 (setq list (vm-delete-backup-file-names 324 (setq list (directory-files default-directory))
383 (vm-delete-auto-save-file-names
384 (directory-files default-directory))))
385 (vm-show-list list 'vm-mouse-read-file-name-event-handler) 325 (vm-show-list list 'vm-mouse-read-file-name-event-handler)
386 (setq buffer-read-only t))) 326 (setq buffer-read-only t)))
387 327
388 (defun vm-mouse-read-file-name-quit-handler (&optional normal-exit) 328 (defun vm-mouse-read-file-name-quit-handler (&optional normal-exit)
389 (interactive) 329 (interactive)
390 (vm-maybe-delete-windows-or-frames-on (current-buffer)) 330 (let ((vm-mutable-frames t))
391 (if normal-exit 331 (vm-delete-windows-or-frames-on (current-buffer))
392 (throw 'exit nil) 332 (if normal-exit
393 (throw 'exit t))) 333 (throw 'exit nil)
334 (throw 'exit t))))
394 335
395 (defvar vm-mouse-read-string-prompt) 336 (defvar vm-mouse-read-string-prompt)
396 (defvar vm-mouse-read-string-completion-list) 337 (defvar vm-mouse-read-string-completion-list)
397 (defvar vm-mouse-read-string-multi-word) 338 (defvar vm-mouse-read-string-multi-word)
398 (defvar vm-mouse-read-string-return-value) 339 (defvar vm-mouse-read-string-return-value)
408 (make-local-variable 'vm-mouse-read-string-return-value) 349 (make-local-variable 'vm-mouse-read-string-return-value)
409 (setq vm-mouse-read-string-prompt prompt) 350 (setq vm-mouse-read-string-prompt prompt)
410 (setq vm-mouse-read-string-completion-list completion-list) 351 (setq vm-mouse-read-string-completion-list completion-list)
411 (setq vm-mouse-read-string-multi-word multi-word) 352 (setq vm-mouse-read-string-multi-word multi-word)
412 (setq vm-mouse-read-string-return-value nil) 353 (setq vm-mouse-read-string-return-value nil)
413 (if (and vm-mutable-frames vm-frame-per-completion 354 (save-excursion
414 (vm-multiple-frames-possible-p)) 355 (vm-goto-new-frame 'completion))
415 (save-excursion
416 (vm-goto-new-frame 'completion)))
417 (switch-to-buffer (current-buffer)) 356 (switch-to-buffer (current-buffer))
418 (vm-mouse-read-string-event-handler) 357 (vm-mouse-read-string-event-handler)
419 (save-excursion 358 (save-excursion
420 (local-set-key "\C-g" 'vm-mouse-read-string-quit-handler) 359 (local-set-key "\C-g" 'vm-mouse-read-string-quit-handler)
421 (recursive-edit)) 360 (recursive-edit))
428 (kill-buffer (current-buffer)))))) 367 (kill-buffer (current-buffer))))))
429 368
430 (defun vm-mouse-read-string-event-handler (&optional string) 369 (defun vm-mouse-read-string-event-handler (&optional string)
431 (let ((key-doc "Click here for keyboard interface.") 370 (let ((key-doc "Click here for keyboard interface.")
432 (bs-doc " .... to go back one word.") 371 (bs-doc " .... to go back one word.")
433 (done-doc " .... when you're done.") 372 (done-doc " .... to when you're done.")
434 start list) 373 start list)
435 (if string 374 (if string
436 (cond ((equal string key-doc) 375 (cond ((equal string key-doc)
437 (condition-case nil 376 (condition-case nil
438 (save-excursion 377 (save-excursion
378 (save-excursion
379 (let ((vm-mutable-frames t))
380 (vm-delete-windows-or-frames-on (current-buffer))))
439 (setq vm-mouse-read-string-return-value 381 (setq vm-mouse-read-string-return-value
440 (vm-keyboard-read-string 382 (vm-keyboard-read-string
441 vm-mouse-read-string-prompt 383 vm-mouse-read-string-prompt
442 vm-mouse-read-string-completion-list 384 vm-mouse-read-string-completion-list
443 vm-mouse-read-string-multi-word)) 385 vm-mouse-read-string-multi-word))
484 'vm-mouse-read-string-event-handler) 426 'vm-mouse-read-string-event-handler)
485 (setq buffer-read-only t))) 427 (setq buffer-read-only t)))
486 428
487 (defun vm-mouse-read-string-quit-handler (&optional normal-exit) 429 (defun vm-mouse-read-string-quit-handler (&optional normal-exit)
488 (interactive) 430 (interactive)
489 (vm-maybe-delete-windows-or-frames-on (current-buffer)) 431 (let ((vm-mutable-frames t))
490 (if normal-exit 432 (vm-delete-windows-or-frames-on (current-buffer))
491 (throw 'exit nil) 433 (if normal-exit
492 (throw 'exit t))) 434 (throw 'exit nil)
435 (throw 'exit t))))