Mercurial > hg > xemacs-beta

comparison lisp/vm/vm-mouse.el @ 54:05472e90ae02 r19-16-pre2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-16-pre2
author cvs
date Mon, 13 Aug 2007 08:57:55 +0200
parents c53a95d3c46d
children 131b0175ea99
comparison
equal deleted inserted replaced
53:875393c1a535 54:05472e90ae02
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 ((fboundp 'make-overlay) 29 (cond (vm-fsfemacs-19-p
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 ((fboundp 'make-extent) 32 (vm-xemacs-p
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")
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 ((fboundp 'overlays-at) 93 (cond (vm-fsfemacs-19-p
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 ((fboundp 'extent-at) 104 (vm-xemacs-p
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)))
199 ")")) 199 ")"))
200 vm-netscape-program-switches))) 200 vm-netscape-program-switches)))
201 (vm-mouse-send-url-to-netscape url t new-window))) 201 (vm-mouse-send-url-to-netscape url t new-window)))
202 (message "Sending URL to Netscape... done")) 202 (message "Sending URL to Netscape... done"))
203 203
204 (defun vm-mouse-send-url-to-netscape-new-window (url)
205 (vm-mouse-send-url-to-netscape url nil t))
206
204 (defun vm-mouse-send-url-to-mosaic (url &optional new-mosaic new-window) 207 (defun vm-mouse-send-url-to-mosaic (url &optional new-mosaic new-window)
205 (message "Sending URL to Mosaic...") 208 (message "Sending URL to Mosaic...")
206 (if (null new-mosaic) 209 (if (null new-mosaic)
207 (let ((pid-file "~/.mosaicpid") 210 (let ((pid-file "~/.mosaicpid")
208 (work-buffer " *mosaic work*") 211 (work-buffer " *mosaic work*")
216 (insert (if new-window "newwin" "goto") ?\n) 219 (insert (if new-window "newwin" "goto") ?\n)
217 (insert url ?\n) 220 (insert url ?\n)
218 ;; newline convention used should be the local 221 ;; newline convention used should be the local
219 ;; one, whatever that is. 222 ;; one, whatever that is.
220 (setq buffer-file-type nil) 223 (setq buffer-file-type nil)
221 (and (vm-xemacs-mule-p) 224 (and vm-xemacs-mule-p
222 (set-file-coding-system 'no-conversion nil)) 225 (set-buffer-file-coding-system 'no-conversion nil))
223 (write-region (point-min) (point-max) 226 (write-region (point-min) (point-max)
224 (concat "/tmp/Mosaic." pid) 227 (concat "/tmp/Mosaic." pid)
225 nil 0) 228 nil 0)
226 (set-buffer-modified-p nil) 229 (set-buffer-modified-p nil)
227 (kill-buffer work-buffer))) 230 (kill-buffer work-buffer)))
230 (setq new-mosaic t))))) 233 (setq new-mosaic t)))))
231 (if new-mosaic 234 (if new-mosaic
232 (apply 'vm-run-background-command vm-mosaic-program 235 (apply 'vm-run-background-command vm-mosaic-program
233 (append vm-mosaic-program-switches (list url)))) 236 (append vm-mosaic-program-switches (list url))))
234 (message "Sending URL to Mosaic... done")) 237 (message "Sending URL to Mosaic... done"))
238
239 (defun vm-mouse-send-url-to-mosaic-new-window (url)
240 (vm-mouse-send-url-to-mosaic url nil t))
235 241
236 (defun vm-mouse-install-mouse () 242 (defun vm-mouse-install-mouse ()
237 (cond ((vm-mouse-xemacs-mouse-p) 243 (cond ((vm-mouse-xemacs-mouse-p)
238 (if (null (lookup-key vm-mode-map 'button2)) 244 (if (null (lookup-key vm-mode-map 'button2))
239 (define-key vm-mode-map 'button2 'vm-mouse-button-2))) 245 (define-key vm-mode-map 'button2 'vm-mouse-button-2)))
316 (setq vm-mouse-read-file-name-must-match must-match) 322 (setq vm-mouse-read-file-name-must-match must-match)
317 (setq vm-mouse-read-file-name-initial initial) 323 (setq vm-mouse-read-file-name-initial initial)
318 (setq vm-mouse-read-file-name-history history) 324 (setq vm-mouse-read-file-name-history history)
319 (setq vm-mouse-read-file-name-prompt prompt) 325 (setq vm-mouse-read-file-name-prompt prompt)
320 (setq vm-mouse-read-file-name-return-value nil) 326 (setq vm-mouse-read-file-name-return-value nil)
321 (if (and vm-frame-per-completion (vm-multiple-frames-possible-p)) 327 (if (and vm-mutable-frames vm-frame-per-completion
328 (vm-multiple-frames-possible-p))
322 (save-excursion 329 (save-excursion
323 (vm-goto-new-frame 'completion))) 330 (vm-goto-new-frame 'completion)))
324 (switch-to-buffer (current-buffer)) 331 (switch-to-buffer (current-buffer))
325 (vm-mouse-read-file-name-event-handler) 332 (vm-mouse-read-file-name-event-handler)
326 (save-excursion 333 (save-excursion
337 start list) 344 start list)
338 (if string 345 (if string
339 (cond ((equal string key-doc) 346 (cond ((equal string key-doc)
340 (condition-case nil 347 (condition-case nil
341 (save-excursion 348 (save-excursion
342 (save-excursion
343 (let ((vm-mutable-frames t))
344 (vm-delete-windows-or-frames-on (current-buffer))))
345 (setq vm-mouse-read-file-name-return-value 349 (setq vm-mouse-read-file-name-return-value
346 (save-excursion 350 (save-excursion
347 (vm-keyboard-read-file-name 351 (vm-keyboard-read-file-name
348 vm-mouse-read-file-name-prompt 352 vm-mouse-read-file-name-prompt
349 vm-mouse-read-file-name-dir 353 vm-mouse-read-file-name-dir
381 (vm-show-list list 'vm-mouse-read-file-name-event-handler) 385 (vm-show-list list 'vm-mouse-read-file-name-event-handler)
382 (setq buffer-read-only t))) 386 (setq buffer-read-only t)))
383 387
384 (defun vm-mouse-read-file-name-quit-handler (&optional normal-exit) 388 (defun vm-mouse-read-file-name-quit-handler (&optional normal-exit)
385 (interactive) 389 (interactive)
386 (let ((vm-mutable-frames t)) 390 (vm-maybe-delete-windows-or-frames-on (current-buffer))
387 (vm-delete-windows-or-frames-on (current-buffer)) 391 (if normal-exit
388 (if normal-exit 392 (throw 'exit nil)
389 (throw 'exit nil) 393 (throw 'exit t)))
390 (throw 'exit t))))
391 394
392 (defvar vm-mouse-read-string-prompt) 395 (defvar vm-mouse-read-string-prompt)
393 (defvar vm-mouse-read-string-completion-list) 396 (defvar vm-mouse-read-string-completion-list)
394 (defvar vm-mouse-read-string-multi-word) 397 (defvar vm-mouse-read-string-multi-word)
395 (defvar vm-mouse-read-string-return-value) 398 (defvar vm-mouse-read-string-return-value)
405 (make-local-variable 'vm-mouse-read-string-return-value) 408 (make-local-variable 'vm-mouse-read-string-return-value)
406 (setq vm-mouse-read-string-prompt prompt) 409 (setq vm-mouse-read-string-prompt prompt)
407 (setq vm-mouse-read-string-completion-list completion-list) 410 (setq vm-mouse-read-string-completion-list completion-list)
408 (setq vm-mouse-read-string-multi-word multi-word) 411 (setq vm-mouse-read-string-multi-word multi-word)
409 (setq vm-mouse-read-string-return-value nil) 412 (setq vm-mouse-read-string-return-value nil)
410 (if (and vm-frame-per-completion (vm-multiple-frames-possible-p)) 413 (if (and vm-mutable-frames vm-frame-per-completion
414 (vm-multiple-frames-possible-p))
411 (save-excursion 415 (save-excursion
412 (vm-goto-new-frame 'completion))) 416 (vm-goto-new-frame 'completion)))
413 (switch-to-buffer (current-buffer)) 417 (switch-to-buffer (current-buffer))
414 (vm-mouse-read-string-event-handler) 418 (vm-mouse-read-string-event-handler)
415 (save-excursion 419 (save-excursion
430 start list) 434 start list)
431 (if string 435 (if string
432 (cond ((equal string key-doc) 436 (cond ((equal string key-doc)
433 (condition-case nil 437 (condition-case nil
434 (save-excursion 438 (save-excursion
435 (save-excursion
436 (let ((vm-mutable-frames t))
437 (vm-delete-windows-or-frames-on (current-buffer))))
438 (setq vm-mouse-read-string-return-value 439 (setq vm-mouse-read-string-return-value
439 (vm-keyboard-read-string 440 (vm-keyboard-read-string
440 vm-mouse-read-string-prompt 441 vm-mouse-read-string-prompt
441 vm-mouse-read-string-completion-list 442 vm-mouse-read-string-completion-list
442 vm-mouse-read-string-multi-word)) 443 vm-mouse-read-string-multi-word))
483 'vm-mouse-read-string-event-handler) 484 'vm-mouse-read-string-event-handler)
484 (setq buffer-read-only t))) 485 (setq buffer-read-only t)))
485 486
486 (defun vm-mouse-read-string-quit-handler (&optional normal-exit) 487 (defun vm-mouse-read-string-quit-handler (&optional normal-exit)
487 (interactive) 488 (interactive)
488 (let ((vm-mutable-frames t)) 489 (vm-maybe-delete-windows-or-frames-on (current-buffer))
489 (vm-delete-windows-or-frames-on (current-buffer)) 490 (if normal-exit
490 (if normal-exit 491 (throw 'exit nil)
491 (throw 'exit nil) 492 (throw 'exit t)))
492 (throw 'exit t))))