Install org-mode version 7.3

1 files changed, 57 insertions, 4 deletions

diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el
index f2fca8c29f4..6d782759a75 100644
--- a/lisp/org/org-gnus.el
+++ b/lisp/org/org-gnus.el
@@ -7,7 +7,7 @@
 ;;         Tassilo Horn <tassilo at member dot fsf dot org>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://orgmode.org
-;; Version: 7.01
+;; Version: 7.3
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -39,9 +39,9 @@
 ;; Declare external functions and variables
 (declare-function message-fetch-field "message" (header &optional not-all))
 (declare-function message-narrow-to-head-1 "message" nil)
+(declare-function nnimap-group-overview-filename "nnimap" (group server))
 ;; The following line suppresses a compiler warning stemming from gnus-sum.el
 (declare-function gnus-summary-last-subject "gnus-sum" nil)
-
 ;; Customization variables
 
 (when (fboundp 'defvaralias)
@@ -55,6 +55,17 @@ negates this setting for the duration of the command."
   :group 'org-link-store
   :type 'boolean)
 
+(defcustom org-gnus-nnimap-query-article-no-from-file nil
+  "If non-nil, `org-gnus-follow-link' will try to translate
+Message-Ids to article numbers by querying the .overview file.
+Normally, this translation is done by querying the IMAP server,
+which is usually very fast.  Unfortunately, some (maybe badly
+configured) IMAP servers don't support this operation quickly.
+So if following a link to a Gnus article takes ages, try setting
+this variable to `t'."
+  :group 'org-link-store
+  :type 'boolean)
+
 
 ;; Install the link type
 (org-add-link-type "gnus" 'org-gnus-open)
@@ -62,6 +73,22 @@ negates this setting for the duration of the command."
 
 ;; Implementation
 
+(defun org-gnus-nnimap-cached-article-number (group server message-id)
+  "Return cached article number (uid) of message in GROUP on SERVER.
+MESSAGE-ID is the message-id header field that identifies the
+message.  If the uid is not cached, return nil."
+  (with-temp-buffer
+    (let ((nov (nnimap-group-overview-filename group server)))
+      (when (file-exists-p nov)
+	(mm-insert-file-contents nov)
+	(set-buffer-modified-p nil)
+	(goto-char (point-min))
+	(catch 'found
+	  (while (search-forward message-id nil t)
+	    (let ((hdr (split-string (thing-at-point 'line) "\t")))
+	      (if (string= (nth 4 hdr) message-id)
+		  (throw 'found (nth 0 hdr))))))))))
+
 (defun org-gnus-group-link (group)
   "Create a link to the Gnus group GROUP.
 If GROUP is a newsgroup and `org-gnus-prefer-web-links' is
@@ -125,6 +152,11 @@ If `org-store-link' was called with a prefix arg the meaning of
 	   (from (mail-header-from header))
 	   (message-id (org-remove-angle-brackets (mail-header-id header)))
 	   (date (mail-header-date header))
+	   (date-ts (and date (format-time-string
+			       (org-time-stamp-format t) (date-to-time date))))
+	   (date-ts-ia (and date (format-time-string
+				  (org-time-stamp-format t t)
+				  (date-to-time date))))
 	   (subject (copy-sequence (mail-header-subject header)))
 	   (to (cdr (assq 'To (mail-header-extra header))))
 	   newsgroups x-no-archive desc link)
@@ -140,14 +172,27 @@ If `org-store-link' was called with a prefix arg the meaning of
 	(setq to (or to (gnus-fetch-original-field "To"))
 	      newsgroups (gnus-fetch-original-field "Newsgroups")
 	      x-no-archive (gnus-fetch-original-field "x-no-archive")))
-      (org-store-link-props :type "gnus" :from from :subject subject
+      (org-store-link-props :type "gnus" :from from :subject subject 
 			    :message-id message-id :group group :to to)
+      (when date
+	(org-add-link-props :date date :date-timestamp date-ts
+			    :date-timestamp-inactive date-ts-ia))
       (setq desc (org-email-link-description)
 	    link (org-gnus-article-link
 		  group	newsgroups message-id x-no-archive))
       (org-add-link-props :link link :description desc)
       link))))
 
+(defun org-gnus-open-nntp (path)
+  "Follow the nntp: link specified by PATH."
+  (let* ((spec (split-string path "/"))
+	 (server (split-string (nth 2 spec) "@"))
+	 (group (nth 3 spec))
+	 (article (nth 4 spec)))
+    (org-gnus-follow-link
+     (format "nntp+%s:%s" (or (cdr server) (car server)) group)
+     article)))
+
 (defun org-gnus-open (path)
   "Follow the Gnus message or folder link specified by PATH."
   (let (group article)
@@ -173,7 +218,9 @@ If `org-store-link' was called with a prefix arg the meaning of
   (cond ((and group article)
 	 (gnus-activate-group group t)
 	 (condition-case nil
-	     (let ((backend (car (gnus-find-method-for-group group))))
+	     (let* ((method (gnus-find-method-for-group group))
+		    (backend (car method))
+		    (server (cadr method)))
 	       (cond
 		((eq backend 'nndoc)
 		 (if (gnus-group-read-group t nil group)
@@ -183,6 +230,12 @@ If `org-store-link' was called with a prefix arg the meaning of
 		(t
 		 (let ((articles 1)
 		       group-opened)
+		   (when (and (eq backend 'nnimap)
+			      org-gnus-nnimap-query-article-no-from-file)
+		     (setq article
+			   (or (org-gnus-nnimap-cached-article-number
+				(nth 1 (split-string group ":"))
+				server (concat "<" article ">")) article)))
 		   (while (and (not group-opened)
 			       ;; stop on integer overflows
 			       (> articles 0))