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

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 05472e90ae02
children 0d2f883870bc
line wrap: on
line diff
--- a/lisp/vm/vm-mouse.el	Mon Aug 13 09:00:04 2007 +0200
+++ b/lisp/vm/vm-mouse.el	Mon Aug 13 09:02:59 2007 +0200
@@ -1,5 +1,5 @@
 ;;; Mouse related functions and commands
-;;; Copyright (C) 1995-1997 Kyle E. Jones
+;;; Copyright (C) 1995 Kyle E. Jones
 ;;;
 ;;; This program is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -18,18 +18,18 @@
 (provide 'vm-mouse)
 
 (defun vm-mouse-fsfemacs-mouse-p ()
-  (and vm-fsfemacs-19-p
+  (and (vm-fsfemacs-19-p)
        (fboundp 'set-mouse-position)))
 
 (defun vm-mouse-xemacs-mouse-p ()
-  (and vm-xemacs-p
+  (and (vm-xemacs-p)
        (fboundp 'set-mouse-position)))
 
 (defun vm-mouse-set-mouse-track-highlight (start end)
-  (cond (vm-fsfemacs-19-p
+  (cond ((fboundp 'make-overlay)
 	 (let ((o (make-overlay start end)))
 	   (overlay-put o 'mouse-face 'highlight)))
-	(vm-xemacs-p
+	((fboundp 'make-extent)
 	 (let ((o (make-extent start end)))
 	   (set-extent-property o 'highlight t)))))
 
@@ -48,11 +48,14 @@
 	 (beginning-of-line)
 	 (if (let ((vm-follow-summary-cursor t))
 	       (vm-follow-summary-cursor))
-	     nil
+	     (progn
+	       (vm-select-folder-buffer)
+	       (vm-preview-current-message))
 	   (setq this-command 'vm-scroll-forward)
 	   (call-interactively 'vm-scroll-forward)))
-	((memq major-mode '(vm-mode vm-virtual-mode vm-presentation-mode))
-	 (vm-mouse-popup-or-select event))))
+	((memq major-mode '(vm-mode vm-virtual-mode))
+	 (cond ((and (vm-mouse-fsfemacs-mouse-p) vm-url-browser)
+		(vm-mouse-popup-or-select event))))))
 
 (defun vm-mouse-button-3 (event)
   (interactive "e")
@@ -70,15 +73,12 @@
 	       (vm-menu-popup-mode-menu event))
 	      ((eq major-mode 'vm-mode)
 	       (vm-menu-popup-context-menu event))
-	      ((eq major-mode 'vm-presentation-mode)
-	       (vm-menu-popup-context-menu event))
 	      ((eq major-mode 'vm-virtual-mode)
 	       (vm-menu-popup-context-menu event))
 	      ((eq major-mode 'mail-mode)
-	       (vm-menu-popup-context-menu event))))))
+	       (vm-menu-popup-mode-menu event))))))
 
 (defun vm-mouse-3-help (object)
-  nil
   "Use mouse button 3 to see a menu of options.")
 
 (defun vm-mouse-get-mouse-track-string (event)
@@ -90,7 +90,7 @@
 	  ((vm-mouse-fsfemacs-mouse-p)
 	   (set-buffer (window-buffer (posn-window (event-start event))))
 	   (goto-char (posn-point (event-start event)))))
-    (cond (vm-fsfemacs-19-p
+    (cond ((fboundp 'overlays-at)
 	   (let ((o-list (overlays-at (point)))
 		 (string nil))
 	     (while o-list
@@ -101,7 +101,7 @@
 			 o-list nil)
 		 (setq o-list (cdr o-list))))
 	     string ))
-	  (vm-xemacs-p
+	  ((fboundp 'extent-at)
 	   (let ((e (extent-at (point) nil 'highlight)))
 	     (if e
 		 (buffer-substring (extent-start-position e)
@@ -114,33 +114,25 @@
   (cond ((vm-mouse-fsfemacs-mouse-p)
 	 (set-buffer (window-buffer (posn-window (event-start event))))
 	 (goto-char (posn-point (event-start event)))
-	 (let (o-list (found nil))
+	 (let (o-list o menu (found nil))
 	   (setq o-list (overlays-at (point)))
 	   (while (and o-list (not found))
 	     (cond ((overlay-get (car o-list) 'vm-url)
 		    (setq found t)
-		    (vm-mouse-send-url-at-event event))
-		   ((overlay-get (car o-list) 'vm-mime-function)
-		    (setq found t)
-		    (funcall (overlay-get (car o-list) 'vm-mime-function)
-			     (car o-list))))
+		    (vm-mouse-send-url-at-event event)))
 	     (setq o-list (cdr o-list)))
 	   (and (not found) (vm-menu-popup-context-menu event))))
 	;; The XEmacs code is not actually used now, since all
 	;; selectable objects are handled by an extent keymap
 	;; binding that points to a more specific function.  But
 	;; this might come in handy later if I want selectable
-	;; objects that don't have an extent or extent keymap
-	;; attached.
+	;; objects that don't have an extent attached.
 	((vm-mouse-xemacs-mouse-p)
 	 (set-buffer (window-buffer (event-window event)))
 	 (and (event-point event) (goto-char (event-point event)))
-	 (let (e)
-	   (cond ((extent-at (point) (current-buffer) 'vm-url)
-		  (vm-mouse-send-url-at-event event))
-		 ((setq e (extent-at (point) nil 'vm-mime-function))
-		  (funcall (extent-property e 'vm-mime-function) e))
-		 (t (vm-menu-popup-context-menu event)))))))
+	 (if (extent-at (point) (current-buffer) 'vm-url)
+	     (vm-mouse-send-url-at-event event)
+	   (vm-menu-popup-context-menu event)))))
 
 (defun vm-mouse-send-url-at-event (event)
   (interactive "e")
@@ -154,58 +146,49 @@
 	 (vm-mouse-send-url-at-position (posn-point (event-start event))))))
 
 (defun vm-mouse-send-url-at-position (pos &optional browser)
-  (save-restriction
-    (widen)
-    (cond ((vm-mouse-xemacs-mouse-p)
-	   (let ((e (extent-at pos (current-buffer) 'vm-url))
-		 url)
-	     (if (null e)
-		 nil
-	       (setq url (buffer-substring (extent-start-position e)
-					   (extent-end-position e)))
-	       (vm-mouse-send-url url browser))))
-	  ((vm-mouse-fsfemacs-mouse-p)
-	   (let (o-list url o)
-	     (setq o-list (overlays-at pos))
-	     (while (and o-list (null (overlay-get (car o-list) 'vm-url)))
-	       (setq o-list (cdr o-list)))
-	     (if (null o-list)
-		 nil
-	       (setq o (car o-list))
-	       (setq url (vm-buffer-substring-no-properties
-			  (overlay-start o)
-			  (overlay-end o)))
-	       (vm-mouse-send-url url browser)))))))
+  (cond ((vm-mouse-xemacs-mouse-p)
+	 (let ((e (extent-at pos (current-buffer) 'vm-url))
+	       url)
+	   (if (null e)
+	       nil
+	     (setq url (buffer-substring (extent-start-position e)
+					 (extent-end-position e)))
+	     (vm-mouse-send-url url browser))))
+	((vm-mouse-fsfemacs-mouse-p)
+	 (let (o-list url o)
+	   (setq o-list (overlays-at pos))
+	   (while (and o-list (null (overlay-get (car o-list) 'vm-url)))
+	     (setq o-list (cdr o-list)))
+	   (if (null o-list)
+	       nil
+	     (setq o (car o-list))
+	     (setq url (vm-buffer-substring-no-properties
+			(overlay-start o)
+			(overlay-end o)))
+	     (vm-mouse-send-url url browser))))))
 
 (defun vm-mouse-send-url (url &optional browser)
-  (if (string-match "^mailto:" url)
-      (vm-mail-to-mailto-url url)
-    (let ((browser (or browser vm-url-browser)))
-      (cond ((symbolp browser)
-	     (funcall browser url))
-	    ((stringp browser)
-	     (message "Sending URL to %s..." browser)
-	     (vm-run-background-command browser url)
-	     (message "Sending URL to %s... done" browser))))))
+  (let ((browser (or browser vm-url-browser)))
+    (cond ((symbolp browser)
+	   (funcall browser url))
+	  ((stringp browser)
+	   (vm-unsaved-message "Sending URL to %s..." browser)
+	   (vm-run-background-command browser url)
+	   (vm-unsaved-message "Sending URL to %s... done" browser)))))
 
 (defun vm-mouse-send-url-to-netscape (url &optional new-netscape new-window)
-  (message "Sending URL to Netscape...")
+  (vm-unsaved-message "Sending URL to Netscape...")
   (if new-netscape
-      (apply 'vm-run-background-command vm-netscape-program
-	     (append vm-netscape-program-switches (list url)))
-    (or (equal 0 (apply 'vm-run-command vm-netscape-program "-remote" 
-			(append (list (concat "openURL(" url
-					      (if new-window ", new-window" "")
-					      ")"))
-				vm-netscape-program-switches)))
+      (vm-run-background-command vm-netscape-program url)
+    (or (equal 0 (vm-run-command vm-netscape-program "-remote" 
+				 (concat "openURL(" url
+					 (if new-window ", new-window" "")
+					 ")")))
 	(vm-mouse-send-url-to-netscape url t new-window)))
-  (message "Sending URL to Netscape... done"))
-
-(defun vm-mouse-send-url-to-netscape-new-window (url)
-  (vm-mouse-send-url-to-netscape url nil t))
+  (vm-unsaved-message "Sending URL to Netscape... done"))
 
 (defun vm-mouse-send-url-to-mosaic (url &optional new-mosaic new-window)
-  (message "Sending URL to Mosaic...")
+  (vm-unsaved-message "Sending URL to Mosaic...")
   (if (null new-mosaic)
       (let ((pid-file "~/.mosaicpid")
 	    (work-buffer " *mosaic work*")
@@ -218,11 +201,6 @@
 	       (erase-buffer)
 	       (insert (if new-window "newwin" "goto") ?\n)
 	       (insert url ?\n)
-	       ;; newline convention used should be the local
-	       ;; one, whatever that is.
-	       (setq buffer-file-type nil)
-	       (and vm-xemacs-mule-p
-		    (set-buffer-file-coding-system 'no-conversion nil))
 	       (write-region (point-min) (point-max)
 			     (concat "/tmp/Mosaic." pid)
 			     nil 0)
@@ -232,12 +210,9 @@
 		   (not (equal 0 (vm-run-command "kill" "-USR1" pid))))
 	       (setq new-mosaic t)))))
   (if new-mosaic
-     (apply 'vm-run-background-command vm-mosaic-program
-	    (append vm-mosaic-program-switches (list url))))
-  (message "Sending URL to Mosaic... done"))
+      (vm-run-background-command vm-mosaic-program url))
+  (vm-unsaved-message "Sending URL to Mosaic... done"))
 
-(defun vm-mouse-send-url-to-mosaic-new-window (url)
-  (vm-mouse-send-url-to-mosaic url nil t))
 
 (defun vm-mouse-install-mouse ()
   (cond ((vm-mouse-xemacs-mouse-p)
@@ -246,7 +221,7 @@
 	((vm-mouse-fsfemacs-mouse-p)
 	 (if (null (lookup-key vm-mode-map [mouse-2]))
 	     (define-key vm-mode-map [mouse-2] 'vm-mouse-button-2))
-	 (if vm-popup-menu-on-mouse-3
+	 (if (null (lookup-key vm-mode-map [down-mouse-3]))
 	     (progn
 	       (define-key vm-mode-map [mouse-3] 'ignore)
 	       (define-key vm-mode-map [down-mouse-3] 'vm-mouse-button-3))))))
@@ -257,39 +232,6 @@
 (defun vm-run-command (command &rest arg-list)
   (apply (function call-process) command nil nil nil arg-list))
 
-;; return t on zero exit status
-;; return (exit-status . stderr-string) on nonzero exit status
-(defun vm-run-command-on-region (start end output-buffer command
-				       &rest arg-list)
-  (let ((tempfile nil)
-	;; for DOS/Windows command to tell it that its input is
-	;; binary.
-	(binary-process-input t)
-	status errstring)
-    (unwind-protect
-	(progn
-	  (setq tempfile (vm-make-tempfile-name))
-	  (setq status
-		(apply 'call-process-region
-		       start end command nil
-		       (list output-buffer tempfile)
-		       nil arg-list))
-	  (cond ((equal status 0) t)
-		;; even if exit status non-zero, if there was no
-		;; diagnostic output the command probably
-		;; succeeded.  I have tried to just use exit status
-		;; as the failure criterion and users complained.
-		((equal (nth 7 (file-attributes tempfile)) 0)
-		 (message "%s exited non-zero (code %s)" command status)
-		 t)
-		(t (save-excursion
-		     (message "%s exited non-zero (code %s)" command status)
-		     (set-buffer (find-file-noselect tempfile))
-		     (setq errstring (buffer-string))
-		     (kill-buffer nil)
-		     (cons status errstring)))))
-      (vm-error-free-call 'delete-file tempfile))))
-
 ;; stupid yammering compiler
 (defvar vm-mouse-read-file-name-prompt)
 (defvar vm-mouse-read-file-name-dir)
@@ -324,10 +266,8 @@
     (setq vm-mouse-read-file-name-history history)
     (setq vm-mouse-read-file-name-prompt prompt)
     (setq vm-mouse-read-file-name-return-value nil)
-    (if (and vm-mutable-frames vm-frame-per-completion
-	     (vm-multiple-frames-possible-p))
-	(save-excursion
-	  (vm-goto-new-frame 'completion)))
+    (save-excursion
+      (vm-goto-new-frame 'completion))
     (switch-to-buffer (current-buffer))
     (vm-mouse-read-file-name-event-handler)
     (save-excursion
@@ -346,15 +286,17 @@
 	(cond ((equal string key-doc)
 	       (condition-case nil
 		   (save-excursion
+		     (save-excursion
+		       (let ((vm-mutable-frames t))
+			 (vm-delete-windows-or-frames-on (current-buffer))))
 		     (setq vm-mouse-read-file-name-return-value
-			   (save-excursion
-			     (vm-keyboard-read-file-name
-			      vm-mouse-read-file-name-prompt
-			      vm-mouse-read-file-name-dir
-			      vm-mouse-read-file-name-default
-			      vm-mouse-read-file-name-must-match
-			      vm-mouse-read-file-name-initial
-			      vm-mouse-read-file-name-history)))
+			   (vm-keyboard-read-file-name
+			    vm-mouse-read-file-name-prompt
+			    vm-mouse-read-file-name-dir
+			    vm-mouse-read-file-name-default
+			    vm-mouse-read-file-name-must-match
+			    vm-mouse-read-file-name-initial
+			    vm-mouse-read-file-name-history))
 		     (vm-mouse-read-file-name-quit-handler t))
 		 (quit (vm-mouse-read-file-name-quit-handler))))
 	      ((file-directory-p string)
@@ -379,18 +321,17 @@
     (vm-mouse-set-mouse-track-highlight start (point))
     (vm-set-region-face start (point) 'italic)
     (insert ?\n ?\n)
-    (setq list (vm-delete-backup-file-names
-		(vm-delete-auto-save-file-names
-		 (directory-files default-directory))))
+    (setq list (directory-files default-directory))
     (vm-show-list list 'vm-mouse-read-file-name-event-handler)
     (setq buffer-read-only t)))
 
 (defun vm-mouse-read-file-name-quit-handler (&optional normal-exit)
   (interactive)
-  (vm-maybe-delete-windows-or-frames-on (current-buffer))
-  (if normal-exit
-      (throw 'exit nil)
-    (throw 'exit t)))
+  (let ((vm-mutable-frames t))
+    (vm-delete-windows-or-frames-on (current-buffer))
+    (if normal-exit
+	(throw 'exit nil)
+      (throw 'exit t))))
 
 (defvar vm-mouse-read-string-prompt)
 (defvar vm-mouse-read-string-completion-list)
@@ -410,10 +351,8 @@
     (setq vm-mouse-read-string-completion-list completion-list)
     (setq vm-mouse-read-string-multi-word multi-word)
     (setq vm-mouse-read-string-return-value nil)
-    (if (and vm-mutable-frames vm-frame-per-completion
-	     (vm-multiple-frames-possible-p))
-	(save-excursion
-	  (vm-goto-new-frame 'completion)))
+    (save-excursion
+      (vm-goto-new-frame 'completion))
     (switch-to-buffer (current-buffer))
     (vm-mouse-read-string-event-handler)
     (save-excursion
@@ -430,12 +369,15 @@
 (defun vm-mouse-read-string-event-handler (&optional string)
   (let ((key-doc  "Click here for keyboard interface.")
 	(bs-doc   "      .... to go back one word.")
-	(done-doc "      .... when you're done.")
+	(done-doc "      .... to when you're done.")
 	start list)
     (if string
 	(cond ((equal string key-doc)
 	       (condition-case nil
 		   (save-excursion
+		     (save-excursion
+		       (let ((vm-mutable-frames t))
+			 (vm-delete-windows-or-frames-on (current-buffer))))
 		     (setq vm-mouse-read-string-return-value
 			   (vm-keyboard-read-string
 			    vm-mouse-read-string-prompt
@@ -486,7 +428,8 @@
 
 (defun vm-mouse-read-string-quit-handler (&optional normal-exit)
   (interactive)
-  (vm-maybe-delete-windows-or-frames-on (current-buffer))
-  (if normal-exit
-      (throw 'exit nil)
-    (throw 'exit t)))
+  (let ((vm-mutable-frames t))
+    (vm-delete-windows-or-frames-on (current-buffer))
+    (if normal-exit
+	(throw 'exit nil)
+      (throw 'exit t))))