Install org-mode version 7.3

[bpt/emacs.git] / lisp / org / org-gnus.el

diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el
index f2fca8c..6d78275 100644 (file)
--- 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))