From mboxrd@z Thu Jan 1 00:00:00 1970 From: Tassilo Horn Subject: [PATCH] better links to Gnus articles Date: Wed, 19 Nov 2008 08:49:55 +0100 Message-ID: <87k5b0rw7w.fsf@thinkpad.tsdh.de> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43) id 1L2hpH-0001PV-24 for emacs-orgmode@gnu.org; Wed, 19 Nov 2008 02:50:15 -0500 Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43) id 1L2hpF-0001PJ-Ca for emacs-orgmode@gnu.org; Wed, 19 Nov 2008 02:50:13 -0500 Received: from [199.232.76.173] (port=55071 helo=monty-python.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1L2hpF-0001PG-6A for emacs-orgmode@gnu.org; Wed, 19 Nov 2008 02:50:13 -0500 Received: from mx20.gnu.org ([199.232.41.8]:46243) by monty-python.gnu.org with esmtps (TLS-1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.60) (envelope-from ) id 1L2hpE-0000Zo-Od for emacs-orgmode@gnu.org; Wed, 19 Nov 2008 02:50:13 -0500 Received: from main.gmane.org ([80.91.229.2] helo=ciao.gmane.org) by mx20.gnu.org with esmtp (Exim 4.60) (envelope-from ) id 1L2hpC-0002vZ-Go for emacs-orgmode@gnu.org; Wed, 19 Nov 2008 02:50:10 -0500 Received: from list by ciao.gmane.org with local (Exim 4.43) id 1L2hp9-0002ys-BR for emacs-orgmode@gnu.org; Wed, 19 Nov 2008 07:50:07 +0000 Received: from dhcp13.uni-koblenz.de ([141.26.71.13]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 19 Nov 2008 07:50:07 +0000 Received: from tassilo by dhcp13.uni-koblenz.de with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Wed, 19 Nov 2008 07:50:07 +0000 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: emacs-orgmode@gnu.org --=-=-= 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: --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001--Rename-org-usenet-links-prefer-google-to-org-gnus.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. --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Emacs-orgmode mailing list Remember: use `Reply All' to send replies to the list. Emacs-orgmode@gnu.org http://lists.gnu.org/mailman/listinfo/emacs-orgmode --=-=-=--