[PATCH] better links to Gnus articles

[PATCH] better links to Gnus articles

[Tassilo Horn]

[-- Attachment #1: Type: text/plain, Size: 592 bytes --]

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:

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001--Rename-org-usenet-links-prefer-google-to-org-gnus.patch --]
[-- Type: text/x-patch, Size: 6170 bytes --]

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


[-- Attachment #3: Type: text/plain, Size: 122 bytes --]

Bye,
Tassilo
-- 
Some  people check  their  computers for  viruses.  Viruses check  their
computers for Richard Stallman.

[-- Attachment #4: Type: text/plain, Size: 204 bytes --]

_______________________________________________
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

Re: [PATCH] better links to Gnus articles

[Carsten Dominik]

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.

Re: [PATCH] better links to Gnus articles

[Ulf Stegemann]

Carsten Dominik <dominik@science.uva.nl> wrote:

> 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.

I've just updated to the latest git version and it seems that the patch
in questions breaks linking to Gnus articles. I'm using XEmacs 21.4.21
and No Gnus v0.9.

Unfortunately, I hadn't had the time to dive deeper into this but what's
not working anymore is `org-store-link' in an article or summary buffer
... 

,----
| Debugger entered--Lisp error: (error "Cannot link to a buffer which is
| not visiting a file")
|   signal(error ("Cannot link to a buffer which is not visiting a file"))
|   cerror("Cannot link to a buffer which is not visiting a file")
|   apply(cerror "Cannot link to a buffer which is not visiting a file" nil)
|   error("Cannot link to a buffer which is not visiting a file")
|   org-store-link(nil)
|   call-interactively(org-store-link)
`----

... as well as opening a stored link to a Gnus article in an org buffer
(giving me "No Match"). Maybe I have the time to investigate this
further tomorrow or next week but I already wanted to let you know that
the patch in question probably needs some further attention.

Ulf

Re: [PATCH] better links to Gnus articles

[Tassilo Horn]

Ulf Stegemann <ulf-news@zeitform.de> writes:

Hi Ulf,

> I've just updated to the latest git version and it seems that the
> patch in questions breaks linking to Gnus articles. I'm using XEmacs
> 21.4.21 and No Gnus v0.9.

Hm, I tried to setup XEmacs 21.4.21 and ngnus-0.10 (0.9 is not listed at
gnus.org), but when do (require 'gnus) I get:

Debugger entered--Lisp error: (file-error "Cannot open load file" "jka-compr") 
  load-internal("jka-compr" nil t nil nil nil) 
  load("jka-compr" nil t nil) 
  require(jka-compr) 
  (progn (require (quote jka-compr))) 
  (eval-when-compile (require (quote jka-compr))) 
  load-internal("mm-util" nil t nil nil nil) 
  load("mm-util" nil t nil) 
  require(mm-util) 
  load-internal("gnus" nil t nil nil nil) 
  load("gnus" nil t nil) 
  require(gnus) 
  eval((require (quote gnus))) 
  eval-interactive((require (quote gnus))) 
  eval-last-sexp(nil) 
  call-interactively(eval-last-sexp)

Where do I get jka-compr for XEmacs?

> Unfortunately, I hadn't had the time to dive deeper into this but
> what's not working anymore is `org-store-link' in an article or
> summary buffer ...
>
> ,----
> | Debugger entered--Lisp error: (error "Cannot link to a buffer which is
> | not visiting a file")
> |   signal(error ("Cannot link to a buffer which is not visiting a file"))
> |   cerror("Cannot link to a buffer which is not visiting a file")
> |   apply(cerror "Cannot link to a buffer which is not visiting a file" nil)
> |   error("Cannot link to a buffer which is not visiting a file")
> |   org-store-link(nil)
> |   call-interactively(org-store-link)
> `----

Hm, that indicates that `org-gnus-store-link' returned nil.  You could
do me a favour and edebug `org-gnus-store-link' and see what's going
wrong.  There might me some differences between emacs and XEmacs I'm not
aware of.

> ... as well as opening a stored link to a Gnus article in an org
> buffer (giving me "No Match"). Maybe I have the time to investigate
> this further tomorrow or next week but I already wanted to let you
> know that the patch in question probably needs some further attention.

I'll try to fix it as soon as you figured aut where it all fails or I
got XEmacs and Gnus running.  At least with my normal emacs, the linking
works just fine...

Bye,
Tassilo

Re: [PATCH] better links to Gnus articles

[Ulf Stegemann]

Tassilo Horn <tassilo@member.fsf.org> wrote:

> Ulf Stegemann <ulf-news@zeitform.de> writes:
>
>> I've just updated to the latest git version and it seems that the
>> patch in questions breaks linking to Gnus articles. I'm using XEmacs
>> 21.4.21 and No Gnus v0.9.
>
> Hm, I tried to setup XEmacs 21.4.21 and ngnus-0.10 (0.9 is not listed at
> gnus.org), but when do (require 'gnus) I get:
>
> Debugger entered--Lisp error: (file-error "Cannot open load file"
> "jka-compr")

[...]

> Where do I get jka-compr for XEmacs?

It's part of the 'os-utils' package.

> Hm, that indicates that `org-gnus-store-link' returned nil.  You could
> do me a favour and edebug `org-gnus-store-link' and see what's going
> wrong.  There might me some differences between emacs and XEmacs I'm not
> aware of.

In fact org-gnus wasn't even loaded. The reason was that XEmacs'
`defvaralias' (line 41) doesn't accept an optional third argument as
Emacs does. Once this had been fixed, org-gnus was loaded without
problems and worked right away.

While testing the new version I've noticed that links are now made up of
<group>#<message-id> instead of <group>#<article number>, at least for
nnml groups. This means that links created with the new version are not
usable with older versions. And this might be a problem since the same set
of org files is often used on different computers with possibly
different versions of org-mode.

Ulf

Re: Re: [PATCH] better links to Gnus articles

[Carsten Dominik]

Hi Ulf and Tassilo,

I have fixed this issue by removing the docstring from the definition
of the defvaralias, to make the definition compatible for both Emacsen.

Also:

On Nov 28, 2008, at 3:58 PM, Ulf Stegemann wrote:
>
> While testing the new version I've noticed that links are now made  
> up of
> <group>#<message-id> instead of <group>#<article number>, at least for
> nnml groups. This means that links created with the new version are  
> not
> usable with older versions. And this might be a problem since the  
> same set
> of org files is often used on different computers with possibly
> different versions of org-mode.

This is of course always a problem.  However, links created with older
versions of Org-mode will work just fine with Tassilos modifications
of org-gnus.el.  So as long as you use the latest version of Org,
everything is fine.  I can see that someone might be annoyed getting
a ling that does not work, but the same would be true for any other
new link types added over time.  Linking to message ID's is so much
better than using message numbers that I have trouble to remember
why we ever implemented in this stupid way.... :-)

- Carsten