diff lisp/vm/vm-mouse.el @ 20:859a2309aef8 r19-15b93

Import from CVS: tag r19-15b93
author cvs
date Mon, 13 Aug 2007 08:50:05 +0200
parents 376386a54a3c
children 4103f0995bd7
line wrap: on
line diff
--- a/lisp/vm/vm-mouse.el	Mon Aug 13 08:49:44 2007 +0200
+++ b/lisp/vm/vm-mouse.el	Mon Aug 13 08:50:05 2007 +0200
@@ -1,5 +1,5 @@
 ;;; Mouse related functions and commands
-;;; Copyright (C) 1995 Kyle E. Jones
+;;; Copyright (C) 1995-1997 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
@@ -48,14 +48,11 @@
 	 (beginning-of-line)
 	 (if (let ((vm-follow-summary-cursor t))
 	       (vm-follow-summary-cursor))
-	     (progn
-	       (vm-select-folder-buffer)
-	       (vm-preview-current-message))
+	     nil
 	   (setq this-command 'vm-scroll-forward)
 	   (call-interactively 'vm-scroll-forward)))
-	((memq major-mode '(vm-mode vm-virtual-mode))
-	 (cond ((and (vm-mouse-fsfemacs-mouse-p) vm-url-browser)
-		(vm-mouse-popup-or-select event))))))
+	((memq major-mode '(vm-mode vm-virtual-mode vm-presentation-mode))
+	 (vm-mouse-popup-or-select event))))
 
 (defun vm-mouse-button-3 (event)
   (interactive "e")
@@ -73,12 +70,15 @@
 	       (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-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)
@@ -114,25 +114,33 @@
   (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 o menu (found nil))
+	 (let (o-list (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)))
+		    (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))))
 	     (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 attached.
+	;; objects that don't have an extent or extent keymap
+	;; attached.
 	((vm-mouse-xemacs-mouse-p)
 	 (set-buffer (window-buffer (event-window event)))
 	 (and (event-point event) (goto-char (event-point event)))
-	 (if (extent-at (point) (current-buffer) 'vm-url)
-	     (vm-mouse-send-url-at-event event)
-	   (vm-menu-popup-context-menu 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)))))))
 
 (defun vm-mouse-send-url-at-event (event)
   (interactive "e")
@@ -146,35 +154,39 @@
 	 (vm-mouse-send-url-at-position (posn-point (event-start event))))))
 
 (defun vm-mouse-send-url-at-position (pos &optional 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))))))
+  (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)))))))
 
 (defun vm-mouse-send-url (url &optional 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)))))
+  (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)
+	     (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)
   (vm-unsaved-message "Sending URL to Netscape...")
@@ -221,7 +233,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 (null (lookup-key vm-mode-map [down-mouse-3]))
+	 (if vm-popup-menu-on-mouse-3
 	     (progn
 	       (define-key vm-mode-map [mouse-3] 'ignore)
 	       (define-key vm-mode-map [down-mouse-3] 'vm-mouse-button-3))))))
@@ -232,6 +244,31 @@
 (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) 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)
+		((zerop (save-excursion
+			  (set-buffer (find-file-noselect tempfile))
+			  (buffer-size)))
+		 t)
+		(t (save-excursion
+		     (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)
@@ -266,8 +303,9 @@
     (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)
-    (save-excursion
-      (vm-goto-new-frame 'completion))
+    (if (and vm-frame-per-completion (vm-multiple-frames-possible-p))
+	(save-excursion
+	  (vm-goto-new-frame 'completion)))
     (switch-to-buffer (current-buffer))
     (vm-mouse-read-file-name-event-handler)
     (save-excursion
@@ -321,7 +359,9 @@
     (vm-mouse-set-mouse-track-highlight start (point))
     (vm-set-region-face start (point) 'italic)
     (insert ?\n ?\n)
-    (setq list (directory-files default-directory))
+    (setq list (vm-delete-backup-file-names
+		(vm-delete-auto-save-file-names
+		 (directory-files default-directory))))
     (vm-show-list list 'vm-mouse-read-file-name-event-handler)
     (setq buffer-read-only t)))
 
@@ -351,8 +391,9 @@
     (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)
-    (save-excursion
-      (vm-goto-new-frame 'completion))
+    (if (and vm-frame-per-completion (vm-multiple-frames-possible-p))
+	(save-excursion
+	  (vm-goto-new-frame 'completion)))
     (switch-to-buffer (current-buffer))
     (vm-mouse-read-string-event-handler)
     (save-excursion
@@ -369,7 +410,7 @@
 (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 "      .... to when you're done.")
+	(done-doc "      .... when you're done.")
 	start list)
     (if string
 	(cond ((equal string key-doc)