From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/80253 Path: news.gmane.org!not-for-mail From: Dave Abrahams Newsgroups: gmane.emacs.gnus.general Subject: [PATCH 4/6] Add `gnus-try-warping-via-registry()' Date: Sun, 9 Oct 2011 00:11:25 -0400 Message-ID: <1318133487-45386-5-git-send-email-dave@boostpro.com> References: <1318133487-45386-1-git-send-email-dave@boostpro.com> NNTP-Posting-Host: lo.gmane.org X-Trace: dough.gmane.org 1318133545 5766 80.91.229.12 (9 Oct 2011 04:12:25 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sun, 9 Oct 2011 04:12:25 +0000 (UTC) Cc: Dave Abrahams To: ding@gnus.org Original-X-From: ding-owner+M28542@lists.math.uh.edu Sun Oct 09 06:12:20 2011 Return-path: Envelope-to: ding-account@gmane.org Original-Received: from util0.math.uh.edu ([129.7.128.18]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1RCkkN-00068c-8R for ding-account@gmane.org; Sun, 09 Oct 2011 06:12:19 +0200 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu) by util0.math.uh.edu with smtp (Exim 4.63) (envelope-from ) id 1RCkjy-0003u2-U1; Sat, 08 Oct 2011 23:11:54 -0500 Original-Received: from mx2.math.uh.edu ([129.7.128.33]) by util0.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.63) (envelope-from ) id 1RCkju-0003tH-UC for ding@lists.math.uh.edu; Sat, 08 Oct 2011 23:11:50 -0500 Original-Received: from quimby.gnus.org ([80.91.231.51]) by mx2.math.uh.edu with esmtps (TLSv1:AES256-SHA:256) (Exim 4.76) (envelope-from ) id 1RCkjk-00031a-1d for ding@lists.math.uh.edu; Sat, 08 Oct 2011 23:11:50 -0500 Original-Received: from mail-vx0-f172.google.com ([209.85.220.172]) by quimby.gnus.org with esmtp (Exim 4.72) (envelope-from ) id 1RCkji-0005pY-IJ for ding@gnus.org; Sun, 09 Oct 2011 06:11:38 +0200 Original-Received: by vcbfo11 with SMTP id fo11so6298253vcb.17 for ; Sat, 08 Oct 2011 21:11:32 -0700 (PDT) Original-Received: by 10.220.148.198 with SMTP id q6mr1018810vcv.118.1318133492742; Sat, 08 Oct 2011 21:11:32 -0700 (PDT) Original-Received: from pluto.luannocracy.com (207-172-223-249.c3-0.smr-ubr3.sbo-smr.ma.static.cable.rcn.com. [207.172.223.249]) by mx.google.com with ESMTPS id v8sm14099112vdg.22.2011.10.08.21.11.30 (version=TLSv1/SSLv3 cipher=OTHER); Sat, 08 Oct 2011 21:11:30 -0700 (PDT) Original-Received: by pluto.luannocracy.com (Postfix, from userid 501) id 0024210AD62B; Sun, 9 Oct 2011 00:11:30 -0400 (EDT) X-Mailer: git-send-email 1.7.6.1 In-Reply-To: <1318133487-45386-1-git-send-email-dave@boostpro.com> X-Spam-Score: -2.9 (--) List-ID: Precedence: bulk Xref: news.gmane.org gmane.emacs.gnus.general:80253 Archived-At: The new function attempts to warp to the article based on group information stored for the article in the registry. --- lisp/gnus-int.el | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 files changed, 50 insertions(+), 0 deletions(-) diff --git a/lisp/gnus-int.el b/lisp/gnus-int.el index 048f442..e241689 100644 --- a/lisp/gnus-int.el +++ b/lisp/gnus-int.el @@ -574,6 +574,56 @@ the group's summary. (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." -- 1.7.6.1