Warp via the registry if enabled

* gnus-int.el (gnus-select-group-with-message-id): New function.
(gnus-try-warping-via-registry): Ditto.
(gnus-warp-to-article): Fall back on the registry.

* gnus-sum.el (gnus-summary-insert-subject): Record information in the
registry about each article retrieved.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7fdc86c..0508574 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2012-03-22  Dave Abrahams  <dave@boostpro.com>
+
+       * gnus-sum.el (gnus-summary-insert-subject): Record information in the
+       registry about each article retrieved.
+
+       * gnus-int.el (gnus-select-group-with-message-id): New function.
+       (gnus-try-warping-via-registry): Ditto.
+       (gnus-warp-to-article): Fall back on the registry.
+
 2012-03-22  Sergio Martínez  <samf0xb58@gmail.com>  (tiny change)
 
        * nnimap.el (nnimap-request-scan): Allow `nnimap-inbox' to be a list of

diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el
index 1190d79..d858c3a 100644 (file)
--- a/lisp/gnus-int.el
+++ b/lisp/gnus-int.el
@@ -533,15 +533,110 @@ If BUFFER, insert the article in that group."
             header
             (gnus-group-real-name group))))
 
+(defun gnus-select-group-with-message-id (group message-id)
+  "Activate and select GROUP with the given MESSAGE-ID selected.
+Returns the article number of the message.
+
+If GROUP is not already selected, the message will be the only one in
+the group's summary.
+"
+  ;; TODO: is there a way to know at this point whether the group will
+  ;; be newly-selected?  If so we could clean up the logic at the end
+  ;;
+  ;; save the new group's display parameter, if any, so we
+  ;; can replace it temporarily with zero.
+  (let ((saved-display
+         (gnus-group-get-parameter group 'display :allow-list)))
+
+    ;; Tell gnus we really don't want any articles 
+    (gnus-group-set-parameter group 'display 0)
+
+    (unwind-protect
+        (gnus-summary-read-group-1
+         group (not :show-all) :no-article (not :kill-buffer)
+         ;; The combination of no-display and this dummy list of
+         ;; articles to select somehow makes it possible to open a
+         ;; group with no articles in it.  Black magic.
+         :no-display '(-1); select-articles
+         )
+      ;; Restore the new group's display parameter
+      (gnus-group-set-parameter group 'display saved-display)))
+
+  ;; The summary buffer was suppressed by :no-display above.
+  ;; Create it now and insert the message
+  (let ((group-is-new (gnus-summary-setup-buffer group)))
+    (condition-case err
+        (let ((article-number 
+               (gnus-summary-insert-subject message-id)))
+          (unless article-number
+            (signal 'error "message-id not in group"))
+          (gnus-summary-select-article nil nil nil article-number)
+          article-number)
+      ;; Clean up the new summary and propagate the error
+      (error (when group-is-new (gnus-summary-exit))
+             (apply 'signal err)))))
+
+(defun gnus-simplify-group-name (group)
+  "Return the simplest representation of the name of GROUP.
+This is the string that Gnus uses to identify the group."
+  (gnus-group-prefixed-name
+   (gnus-group-real-name group)
+   (gnus-group-method group)))
+
+;; largely based on nnir-warp-to-article
+(defun gnus-try-warping-via-registry ()
+  "Attempt to warp to the current article's source group based on
+data stored in the registry."
+  (interactive)
+  (when (gnus-summary-article-header)
+    (let* ((message-id (mail-header-id (gnus-summary-article-header)))
+           ;; Retrieve the message's group(s) from the registry
+           (groups (gnus-registry-get-id-key message-id 'group))
+           ;; If starting from an ephemeral group, this describes
+           ;; how to restore the window configuration
+           (quit-config
+            (gnus-ephemeral-group-p gnus-newsgroup-name))
+           (seen-groups (list (gnus-group-group-name))))
+
+      (catch 'found
+        (dolist (group (mapcar 'gnus-simplify-group-name groups))
+
+          ;; skip over any groups we really don't want to warp to.
+          (unless (or (member group seen-groups)
+                      (gnus-ephemeral-group-p group)          ;; any ephemeral group
+                      (memq (car (gnus-find-method-for-group group))
+                            '(nnir))) ;; Specific methods; this list may need to expand.
+
+            ;; remember that we've seen this group already
+            (push group seen-groups)
+
+            ;; first exit from any ephemeral summary buffer.
+            (when quit-config
+              (gnus-summary-exit)
+              ;; and if the ephemeral summary buffer in turn came from another
+              ;; summary buffer we have to clean that summary up too.
+              (when (eq (cdr quit-config) 'summary)
+                (gnus-summary-exit))
+              ;; remember that we've already done this part
+              (setq quit-config nil))
+
+            ;; Try to activate the group.  If that fails, just move
+            ;; along.  We may have more groups to work with
+            (ignore-errors
+                (gnus-select-group-with-message-id group message-id))
+            (throw 'found t)))))))
+
 (defun gnus-warp-to-article ()
   "Warps from an article in a virtual group to the article in its
 real group. Does nothing on a real group."
   (interactive)
   (let ((gnus-command-method
         (gnus-find-method-for-group gnus-newsgroup-name)))
-    (when (gnus-check-backend-function
-          'warp-to-article (car gnus-command-method))
-      (funcall (gnus-get-function gnus-command-method 'warp-to-article)))))
+    (or
+     (when (gnus-check-backend-function
+            'warp-to-article (car gnus-command-method))
+       (funcall (gnus-get-function gnus-command-method 'warp-to-article)))
+     (gnus-try-warping-via-registry))))
 
 (defun gnus-request-head (article group)
   "Request the head of ARTICLE in GROUP."

diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index 46e246f..b37562d 100644 (file)
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -6626,9 +6626,9 @@ too, instead of trying to fetch new headers."
       ;; article if ID is a number -- so that the next `P' or `N'
       ;; command will fetch the previous (or next) article even
       ;; if the one we tried to fetch this time has been canceled.
-      (when (> number gnus-newsgroup-end)
+      (unless (and gnus-newsgroup-end (< number gnus-newsgroup-end))
        (setq gnus-newsgroup-end number))
-      (when (< number gnus-newsgroup-begin)
+      (unless (and gnus-newsgroup-begin (> number gnus-newsgroup-begin))
        (setq gnus-newsgroup-begin number))
       (setq gnus-newsgroup-unselected
            (delq number gnus-newsgroup-unselected)))
@@ -12428,6 +12428,13 @@ If REVERSE, save parts that do not match TYPE."
                (not (setq header (car (gnus-get-newsgroup-headers nil t)))))
            ()                          ; Malformed head.
          (unless (gnus-summary-article-sparse-p (mail-header-number header))
+            (when (and (bound-and-true-p gnus-registry-enabled)
+                       (not (gnus-ephemeral-group-p (car where))))
+              (gnus-registry-handle-action
+               (mail-header-id header) nil
+               (gnus-group-prefixed-name (car where) gnus-override-method)
+               (mail-header-subject header)
+               (mail-header-from header)))
            (when (and (stringp id)
                       (or
                        (not (string= (gnus-group-real-name group)