annotate lisp/vm/vm-mouse.el @ 7:c153ca296910

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