From: Carsten Dominik <dominik@science.uva.nl>
To: Tassilo Horn <tassilo@member.fsf.org>
Cc: org-mode Org-Mode <emacs-orgmode@gnu.org>
Subject: Re: [PATCH] better links to Gnus articles
Date: Wed, 19 Nov 2008 12:27:39 +0100 [thread overview]
Message-ID: <8E2682E8-0BF5-405A-B8BA-94E2782D8AFB@uva.nl> (raw)
In-Reply-To: <87k5b0rw7w.fsf@thinkpad.tsdh.de>
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 <tassilo@member.fsf.org>
> 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 <carsten at orgmode dot org>
> +;; Tassilo Horn <tassilo at member dot fsf dot org>
> ;; 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.
next prev parent reply other threads:[~2008-11-19 11:28 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2008-11-19 7:49 [PATCH] better links to Gnus articles Tassilo Horn
2008-11-19 11:27 ` Carsten Dominik [this message]
2008-11-27 16:12 ` Ulf Stegemann
2008-11-28 9:35 ` Tassilo Horn
2008-11-28 14:58 ` Ulf Stegemann
2008-11-30 8:52 ` Carsten Dominik
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=8E2682E8-0BF5-405A-B8BA-94E2782D8AFB@uva.nl \
--to=dominik@science.uva.nl \
--cc=emacs-orgmode@gnu.org \
--cc=tassilo@member.fsf.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).