diff lisp/vm/vm-menu.el @ 54:05472e90ae02 r19-16-pre2

Import from CVS: tag r19-16-pre2
author cvs
date Mon, 13 Aug 2007 08:57:55 +0200
parents ec9a17fef872
children 131b0175ea99
line wrap: on
line diff
--- a/lisp/vm/vm-menu.el	Mon Aug 13 08:57:25 2007 +0200
+++ b/lisp/vm/vm-menu.el	Mon Aug 13 08:57:55 2007 +0200
@@ -44,17 +44,29 @@
 
 (provide 'vm-menu)
 
+;; copied from vm-vars.el because vm-xemacs-p, vm-xemacs-mule-p
+;; and vm-fsfemacs-19-p are needed below at load time and
+;; vm-note-emacs-version may not be autoloadable.
+(or (fboundp 'vm-note-emacs-version)
+    (defun vm-note-emacs-version ()
+      (setq vm-xemacs-p (string-match "XEmacs" emacs-version)
+	    vm-xemacs-mule-p (and vm-xemacs-p (featurep 'mule)
+				  ;; paranoia
+				  (fboundp 'set-file-coding-system))
+	    vm-fsfemacs-19-p (not vm-xemacs-p))))
+
+;; make sure the emacs/xemacs version variables are set, as they
+;; are needed below at load time.
+(vm-note-emacs-version)
+
 (defun vm-menu-fsfemacs-menus-p ()
-  (and (vm-fsfemacs-19-p)
+  (and vm-fsfemacs-19-p
        (fboundp 'menu-bar-mode)))
 
 (defun vm-menu-xemacs-menus-p ()
-  (and (vm-xemacs-p)
+  (and vm-xemacs-p
        (fboundp 'set-buffer-menubar)))
 
-;; defined again in vm-misc.el but we need it here for some
-;; initializations.  The "noautoload" vm.elc won't work without
-;; this.
 (defun vm-fsfemacs-19-p ()
   (and (string-match "^19" emacs-version)
        (not (string-match "XEmacs\\|Lucid" emacs-version))))
@@ -67,7 +79,7 @@
 (defconst vm-menu-folder-menu
   (list
    "Folder"
-   (if (vm-fsfemacs-19-p)
+   (if vm-fsfemacs-19-p
        ["Manipulate Folders" ignore (ignore)]
      vm-menu-folders-menu)
    "---"
@@ -368,7 +380,8 @@
 	      :selected (eq vm-mime-8bit-text-transfer-encoding 'base64)]))
 	   "----"
 	   ["Attach File..."	vm-mime-attach-file vm-send-using-mime]
-	   ["Attach MIME File..." vm-mime-attach-mime-file vm-send-using-mime]
+;;	   ["Attach MIME Message..." vm-mime-attach-mime-file
+;;	    vm-send-using-mime]
 	   ["Encode MIME, But Don't Send" vm-mime-encode-composition
 	    (and vm-send-using-mime
 		 (null (vm-mail-mode-get-header-contents "MIME-Version:")))]
@@ -431,6 +444,17 @@
 					   'vm-mouse-send-url-to-netscape)
 	    t]))))
 
+(defconst vm-menu-mailto-url-browser-menu
+  (let ((title (if (vm-menu-fsfemacs-menus-p)
+		   (list "Send Mail using ..."
+			 "Send Mail using ..."
+			 "---"
+			 "---")
+		 (list "Send Mail using ..."))))
+    (append
+     title
+     (list ["VM" (vm-mouse-send-url-at-position (point) 'ignore) t]))))
+
 (defconst vm-menu-subject-menu
   (let ((title (if (vm-menu-fsfemacs-menus-p)
 		   (list "Take Action on Subject..."
@@ -532,50 +556,56 @@
   (apply command args))
 
 (defun vm-menu-can-revert-p ()
-  (save-excursion
-    (vm-check-for-killed-folder)
-    (vm-select-folder-buffer)
-    (and (buffer-modified-p) buffer-file-name)))
+  (condition-case nil
+      (save-excursion
+	(vm-select-folder-buffer)
+	(and (buffer-modified-p) buffer-file-name))
+    (error nil)))
 
 (defun vm-menu-can-recover-p ()
-  (save-excursion
-    (vm-check-for-killed-folder)
-    (vm-select-folder-buffer)
-    (and buffer-file-name
-	 buffer-auto-save-file-name
-	 (file-newer-than-file-p
-	  buffer-auto-save-file-name
-	  buffer-file-name))))
+  (condition-case nil
+      (save-excursion
+	(vm-select-folder-buffer)
+	(and buffer-file-name
+	     buffer-auto-save-file-name
+	     (file-newer-than-file-p
+	      buffer-auto-save-file-name
+	      buffer-file-name)))
+    (error nil)))
 
 (defun vm-menu-can-save-p ()
-  (save-excursion
-    (vm-check-for-killed-folder)
-    (vm-select-folder-buffer)
-    (or (eq major-mode 'vm-virtual-mode)
-	(buffer-modified-p))))
+  (condition-case nil
+      (save-excursion
+	(vm-select-folder-buffer)
+	(or (eq major-mode 'vm-virtual-mode)
+	    (buffer-modified-p)))
+    (error nil)))
 
 (defun vm-menu-can-get-new-mail-p ()
-  (save-excursion
-    (vm-check-for-killed-folder)
-    (vm-select-folder-buffer)
-    (or (eq major-mode 'vm-virtual-mode)
-	(and (not vm-block-new-mail) (not vm-folder-read-only)))))
+  (condition-case nil
+      (save-excursion
+	(vm-select-folder-buffer)
+	(or (eq major-mode 'vm-virtual-mode)
+	    (and (not vm-block-new-mail) (not vm-folder-read-only))))
+    (error nil)))
 
 (defun vm-menu-can-undo-p ()
-  (save-excursion
-    (vm-check-for-killed-folder)
-    (vm-select-folder-buffer)
-    vm-undo-record-list))
+  (condition-case nil
+      (save-excursion
+	(vm-select-folder-buffer)
+	vm-undo-record-list)
+    (error nil)))
 
 (defun vm-menu-can-decode-mime-p ()
-  (save-excursion
-    (vm-check-for-killed-folder)
-    (vm-select-folder-buffer)
-    (and vm-display-using-mime
-	 vm-message-pointer
-	 vm-presentation-buffer
-	 (not vm-mime-decoded)
-	 (not (vm-mime-plain-message-p (car vm-message-pointer))))))
+  (condition-case nil
+      (save-excursion
+	(vm-select-folder-buffer)
+	(and vm-display-using-mime
+	     vm-message-pointer
+	     vm-presentation-buffer
+	     (not vm-mime-decoded)
+	     (not (vm-mime-plain-message-p (car vm-message-pointer)))))
+    (error nil)))
 
 (defun vm-menu-yank-original ()
   (interactive)
@@ -665,6 +695,10 @@
 	;; url browser menu
 	(vm-easy-menu-define vm-menu-fsfemacs-url-browser-menu (list dummy) nil
 			     vm-menu-url-browser-menu)
+	;; mailto url browser menu
+	(vm-easy-menu-define vm-menu-fsfemacs-mailto-url-browser-menu
+			     (list dummy) nil
+			     vm-menu-url-browser-menu)
 	;; mime dispose menu
 	(vm-easy-menu-define vm-menu-fsfemacs-mime-dispose-menu
 			     (list dummy) nil
@@ -802,6 +836,7 @@
 
 ;; to quiet the byte-compiler
 (defvar vm-menu-fsfemacs-url-browser-menu)
+(defvar vm-menu-fsfemacs-mailto-url-browser-menu)
 (defvar vm-menu-fsfemacs-mime-dispose-menu)
 
 (defun vm-menu-goto-event (event)
@@ -811,7 +846,8 @@
 	 ;; selection.  This will cause the command loop to
 	 ;; resume which might undo what set-buffer does.
 	 (select-window (event-window event))
-	 (and (event-point event) (goto-char (event-point event))))
+	 (and (event-closest-point event)
+	      (goto-char (event-closest-point event))))
 	((vm-menu-fsfemacs-menus-p)
 	 (set-buffer (window-buffer (posn-window (event-start event))))
 	 (goto-char (posn-point (event-start event))))))
@@ -825,6 +861,15 @@
 	 (vm-menu-popup-fsfemacs-menu
 	  event vm-menu-fsfemacs-url-browser-menu))))
 
+(defun vm-menu-popup-mailto-url-browser-menu (event)
+  (interactive "e")
+  (vm-menu-goto-event event)
+  (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus)
+	 (popup-menu vm-menu-mailto-url-browser-menu))
+	((and (vm-menu-fsfemacs-menus-p) vm-use-menus)
+	 (vm-menu-popup-fsfemacs-menu
+	  event vm-menu-fsfemacs-mailto-url-browser-menu))))
+
 (defun vm-menu-popup-mime-dispose-menu (event)
   (interactive "e")
   (vm-menu-goto-event event)