changeset 101811:85596010327a

(rmail-show-message): Update declaration. (rmail-buffer, rmail-view-buffer): Declare. (org-rmail-store-link, org-rmail-follow-link): Handle mbox Rmail.
author Glenn Morris <rgm@gnu.org>
date Thu, 05 Feb 2009 06:40:58 +0000
parents 57264a933a63
children 6da807f80bc8
files lisp/org/ChangeLog lisp/org/org-rmail.el
diffstat 2 files changed, 57 insertions(+), 34 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/org/ChangeLog	Thu Feb 05 06:40:01 2009 +0000
+++ b/lisp/org/ChangeLog	Thu Feb 05 06:40:58 2009 +0000
@@ -1,3 +1,9 @@
+2009-02-05  Glenn Morris  <rgm@gnu.org>
+
+	* org-rmail.el (rmail-show-message): Update declaration.
+	(rmail-buffer, rmail-view-buffer): Declare.
+	(org-rmail-store-link, org-rmail-follow-link): Handle mbox Rmail.
+
 2009-02-04  Carsten Dominik  <dominik@science.uva.nl>
 
 	* org.el (org-return-follows-link): Revert setting
--- a/lisp/org/org-rmail.el	Thu Feb 05 06:40:01 2009 +0000
+++ b/lisp/org/org-rmail.el	Thu Feb 05 06:40:58 2009 +0000
@@ -35,9 +35,12 @@
 (require 'org)
 
 ;; Declare external functions and variables
-(declare-function rmail-show-message "rmail" (&optional n no-summary))
+(declare-function rmail-show-message "rmail")
+(declare-function rmail-get-header "rmail" (name &optional msgnum))
 (declare-function rmail-what-message "rmail" ())
 (defvar rmail-current-message)
+(defvar rmail-buffer)
+(defvar rmail-view-buffer)
 
 ;; Install the link type
 (org-add-link-type "rmail" 'org-rmail-open)
@@ -46,29 +49,35 @@
 ;; Implementation
 (defun org-rmail-store-link ()
   "Store a link to an Rmail folder or message."
-  (when (or (eq major-mode 'rmail-mode)
-	    (eq major-mode 'rmail-summary-mode))
-    (save-window-excursion
-      (save-restriction
-	(when (eq major-mode 'rmail-summary-mode)
-	  (rmail-show-message rmail-current-message))
-	(when (fboundp 'rmail-narrow-to-non-pruned-header)
-	  (rmail-narrow-to-non-pruned-header))
-	(let* ((folder buffer-file-name)
-	       (message-id (mail-fetch-field "message-id"))
-	       (from (mail-fetch-field "from"))
-	       (to (mail-fetch-field "to"))
-	       (subject (mail-fetch-field "subject"))
-	       desc link)
-	  (org-store-link-props
-	   :type "rmail" :from from :to to
-	   :subject subject :message-id message-id)
-	  (setq message-id (org-remove-angle-brackets message-id))
-	  (setq desc (org-email-link-description))
-	  (setq link (org-make-link "rmail:" folder "#" message-id))
-	  (org-add-link-props :link link :description desc)
-	  (rmail-show-message rmail-current-message)
-	  link)))))
+  (when (memq major-mode '(rmail-mode rmail-summary-mode))
+    (let (message-id from to subject desc link)
+      (if (fboundp 'rmail-get-header)	; Emacs 23
+	  (setq message-id (rmail-get-header "message-id")
+		from (rmail-get-header "from")
+		to (rmail-get-header "to")
+		subject (rmail-get-header "subject"))
+	(save-window-excursion		; Emacs 22
+	  (save-restriction
+	    (when (eq major-mode 'rmail-summary-mode)
+	      (rmail-show-message rmail-current-message))
+	    (with-no-warnings	  ; don't warn when compiling Emacs 23
+	      (rmail-narrow-to-non-pruned-header))
+	    (setq message-id (mail-fetch-field "message-id")
+		  from (mail-fetch-field "from")
+		  to (mail-fetch-field "to")
+		  subject (mail-fetch-field "subject"))
+	    (rmail-show-message rmail-current-message))))
+      (org-store-link-props
+       :type "rmail" :from from :to to
+       :subject subject :message-id message-id)
+      (setq message-id (org-remove-angle-brackets message-id))
+      (setq desc (org-email-link-description))
+      (setq link (org-make-link "rmail:"
+				(with-current-buffer rmail-buffer
+				  buffer-file-name)
+				"#" message-id))
+      (org-add-link-props :link link :description desc)
+      link)))
 
 (defun org-rmail-open (path)
   "Follow an Rmail message link to the specified PATH."
@@ -83,19 +92,27 @@
   "Follow an Rmail link to FOLDER and ARTICLE."
   (require 'rmail)
   (setq article (org-add-angle-brackets article))
-  (let (message-number)
+  (let (message-number buff)
     (save-excursion
       (save-window-excursion
 	(rmail (if (string= folder "RMAIL") rmail-file-name folder))
-	(setq message-number
-	      (save-restriction
-		(widen)
-		(goto-char (point-max))
-		(if (re-search-backward
-		     (concat "^Message-ID:\\s-+" (regexp-quote
-						  (or article "")))
-		     nil t)
-		    (rmail-what-message))))))
+	(setq buff (current-buffer)
+	      message-number
+	      (with-current-buffer
+		  (if (and (fboundp 'rmail-buffers-swapped-p)
+			   (rmail-buffers-swapped-p))
+		      rmail-view-buffer
+		    (current-buffer))
+		(save-restriction
+		  (widen)
+		  (goto-char (point-max))
+		  (if (re-search-backward
+		       (concat "^Message-ID:\\s-+" (regexp-quote
+						    (or article "")))
+		       nil t)
+		      ;; This is an rmail "debugging" function. :(
+		      (with-current-buffer buff
+			(rmail-what-message))))))))
     (if message-number
 	(progn
 	  (rmail (if (string= folder "RMAIL") rmail-file-name folder))