From 1f48ce1fad323503c6c7f79c5cd7c2b3b05370ba Mon Sep 17 00:00:00 2001 From: David Maus Date: Sun, 15 Aug 2010 20:41:59 +0200 Subject: [PATCH] Try fix 1. --- lisp/org-gnus.el | 38 +++++++++++++++++++++++++++++++++++++- 1 files changed, 37 insertions(+), 1 deletions(-) diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el index 10a0426..f98256f 100644 --- a/lisp/org-gnus.el +++ b/lisp/org-gnus.el @@ -54,12 +54,40 @@ negates this setting for the duration of the command." :group 'org-link-store :type 'boolean) +(defcustom org-gnus-nnimap-query-article-no-from-file t + "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) (add-hook 'org-store-link-functions 'org-gnus-store-link) ;; 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 @@ -171,7 +199,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) @@ -181,6 +211,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)) -- 1.7.1