From mboxrd@z Thu Jan 1 00:00:00 1970 From: Carsten Dominik Subject: Re: [PATCH] better links to Gnus articles Date: Wed, 19 Nov 2008 12:27:39 +0100 Message-ID: <8E2682E8-0BF5-405A-B8BA-94E2782D8AFB@uva.nl> References: <87k5b0rw7w.fsf@thinkpad.tsdh.de> Mime-Version: 1.0 (Apple Message framework v929.2) Content-Type: text/plain; charset=US-ASCII; format=flowed; delsp=yes Content-Transfer-Encoding: 7bit Return-path: Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1L2lEK-0007UL-BR for emacs-orgmode@gnu.org; Wed, 19 Nov 2008 06:28:20 -0500 Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1L2lEJ-0007Ty-5t for emacs-orgmode@gnu.org; Wed, 19 Nov 2008 06:28:19 -0500 Received: from [199.232.76.173] (port=43540 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1L2lEJ-0007Tv-0R for emacs-orgmode@gnu.org; Wed, 19 Nov 2008 06:28:19 -0500 Received: from ug-out-1314.google.com ([66.249.92.174]:41596) by monty-python.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1L2lEI-0001Pq-4K for emacs-orgmode@gnu.org; Wed, 19 Nov 2008 06:28:18 -0500 Received: by ug-out-1314.google.com with SMTP id 36so548192uga.17 for ; Wed, 19 Nov 2008 03:27:42 -0800 (PST) In-Reply-To: <87k5b0rw7w.fsf@thinkpad.tsdh.de> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Sender: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: Tassilo Horn Cc: org-mode Org-Mode I have applied this patch without testing it thoroughly myself, I'd appreciate if some of you could test this and make sure that it does not break anything. Thanks - Carsten On Nov 19, 2008, at 8:49 AM, Tassilo Horn wrote: > Hi Carsten and Org-crew, > > here's the promised refactoring of org-gnus.el: > > - Rename org-usenet-links-prefer-google to org-gnus-prefer-web-links > - Make that option work for gmane > - Only make weblinks if the article is in a newsgroup > - Only make weblinks if the article has no X-No-Archive header > > There is little drawback: > > - Gnus stored some headers in an array and makes them instantly > available. Unfortunately that doesn't apply to X-No-Archive, so I > have to select and widen the article buffer and parse anew. > > But I guess that's not a real problem... > > So here's the patch: > From b252dea93a851e42c649b94db08ea0b115712a6a Mon Sep 17 00:00:00 2001 > From: Tassilo Horn > Date: Tue, 18 Nov 2008 21:59:04 +0100 > Subject: [PATCH] - Rename org-usenet-links-prefer-google to org-gnus- > prefer-web-links > - Make that option work for gmane > - Only make weblinks if the article is in a newsgroup > - Only make weblinks if the article has no X-No-Archive header > > --- > lisp/org-gnus.el | 77 ++++++++++++++++++++++++++++++++ > +-------------------- > lisp/org.el | 2 +- > 2 files changed, 49 insertions(+), 30 deletions(-) > > diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el > index 851425e..42f7798 100644 > --- a/lisp/org-gnus.el > +++ b/lisp/org-gnus.el > @@ -3,6 +3,7 @@ > ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software > Foundation, Inc. > > ;; Author: Carsten Dominik > +;; Tassilo Horn > ;; Keywords: outlines, hypermedia, calendar, wp > ;; Homepage: http://orgmode.org > ;; Version: 6.12trans > @@ -37,7 +38,7 @@ > > ;; Customization variables > > -(defcustom org-usenet-links-prefer-google nil > +(defcustom org-gnus-prefer-web-links nil > "Non-nil means, `org-store-link' will create web links to Google > groups. > When nil, Gnus will be used for such links. > Using a prefix arg to the command \\[org-store-link] (`org-store- > link') > @@ -45,6 +46,9 @@ negates this setting for the duration of the > command." > :group 'org-link-store > :type 'boolean) > > +(defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web- > links > + "Deprecated name for `org-gnus-prefer-web-links'.") > + > ;; Declare external functions and variables > (declare-function gnus-article-show-summary "gnus-art" ()) > (declare-function gnus-summary-last-subject "gnus-sum" ()) > @@ -57,50 +61,65 @@ negates this setting for the duration of the > command." > (add-hook 'org-store-link-functions 'org-gnus-store-link) > > ;; Implementation > + > +(defun org-gnus-group-link (group) > + (let ((unprefixed-group (replace-regexp-in-string "^[^:]+:" "" > group))) > + (if (and (string-match "^nntp" group) ;; Only for nntp groups > + (org-xor current-prefix-arg > + org-gnus-prefer-web-links)) > + (concat (if (string-match "gmane" unprefixed-group) > + "http://news.gmane.org/" > + "http://groups.google.com/group/") > + unprefixed-group) > + (concat "gnus:" group)))) > + > +(defun org-gnus-article-link (group newsgroups message-id x-no- > archive) > + (if (and (org-xor current-prefix-arg org-gnus-prefer-web-links) > + newsgroups ;; Make web links only for nntp groups > + (not x-no-archive)) ;; and if X-No-Archive isn't set. > + (format (if (string-match "gmane\\." newsgroups) > + "http://mid.gmane.org/%s" > + "http://groups.google.com/groups/search?as_umsgid=%s") > + (org-fixup-message-id-for-http > + (replace-regexp-in-string "[<>]" "" message-id))) > + (org-make-link "gnus:" group "#" message-id))) > + > (defun org-gnus-store-link () > "Store a link to a Gnus folder or message." > (cond > ((eq major-mode 'gnus-group-mode) > - (let ((group (cond ((fboundp 'gnus-group-group-name) ; > depending on Gnus > - (gnus-group-group-name)) ; version > - ((fboundp 'gnus-group-name) > - (gnus-group-name)) > - (t "???"))) > - desc link) > + (let* ((group (cond ((fboundp 'gnus-group-group-name) ; > depending on Gnus > + (gnus-group-group-name)) ; version > + ((fboundp 'gnus-group-name) > + (gnus-group-name)) > + (t "???"))) > + desc link) > (unless group (error "Not on a group")) > (org-store-link-props :type "gnus" :group group) > - (setq desc (concat > - (if (org-xor current-prefix-arg > - org-usenet-links-prefer-google) > - "http://groups.google.com/groups?group=" > - "gnus:") > - group) > + (setq desc (org-gnus-group-link group) > link (org-make-link desc)) > (org-add-link-props :link link :description desc) > link)) > > ((memq major-mode '(gnus-summary-mode gnus-article-mode)) > - (and (eq major-mode 'gnus-article-mode) (gnus-article-show- > summary)) > + (and (eq major-mode 'gnus-summary-mode) (gnus-summary-show- > article)) > (let* ((group gnus-newsgroup-name) > - (article (gnus-summary-article-number)) > - (header (gnus-summary-article-header article)) > - (from (mail-header-from header)) > - (message-id (mail-header-id header)) > - (date (mail-header-date header)) > - (extra (mail-header-extra header)) > - (to (cdr (assoc 'To extra))) > + (header (with-current-buffer gnus-article-buffer > + (gnus-summary-toggle-header 1) > + (goto-char (point-min)) > + (mail-header-extract-no-properties))) > + (from (mail-header 'from header)) > + (message-id (mail-header 'message-id header)) > + (date (mail-header 'date header)) > + (to (mail-header 'to header)) > + (newsgroups (mail-header 'newsgroups header)) > + (x-no-archive (mail-header 'x-no-archive header)) > (subject (gnus-summary-subject-string)) > desc link) > (org-store-link-props :type "gnus" :from from :subject subject > :message-id message-id :group group :to to) > - (setq desc (org-email-link-description)) > - (if (org-xor current-prefix-arg org-usenet-links-prefer-google) > - (setq link > - (format "http://groups.google.com/groups?as_umsgid=%s" > - (org-fixup-message-id-for-http message-id))) > - (setq link (org-make-link "gnus:" group "#" > - (or message-id > - (number-to-string article))))) > + (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)))) > > diff --git a/lisp/org.el b/lisp/org.el > index b660f96..1390fc4 100644 > --- a/lisp/org.el > +++ b/lisp/org.el > @@ -6082,7 +6082,7 @@ This link is added to `org-stored-links' and > can later be inserted > into an org-buffer with \\[org-insert-link]. > > For some link types, a prefix arg is interpreted: > -For links to usenet articles, arg negates `org-usenet-links-prefer- > google'. > +For links to usenet articles, arg negates `org-gnus-prefer-web- > links'. > For file links, arg negates `org-context-in-file-links'." > (interactive "P") > (org-load-modules-maybe) > -- > 1.6.0.4 > > Bye, > Tassilo > -- > Some people check their computers for viruses. Viruses check > their > computers for Richard Stallman.