Re: Store link in message mode

From: Ulf Stegemann <ulf-news@zeitform.de>
To: emacs-orgmode@gnu.org
Cc: Bastien <bastien.guerry@wikimedia.fr>
Subject: Re: Store link in message mode
Date: Wed, 09 Feb 2011 15:41:46 +0100	[thread overview]
Message-ID: <zf.upnipwte0d1.fsf@zeitform.de> (raw)
In-Reply-To: 87hbcea53d.fsf@gnu.org

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

Bastien <bastien.guerry@wikimedia.fr> wrote:

> Ulf Stegemann <ulf-news@zeitform.de> writes:
>
>> If you think --despite of those issues-- it's worth adding the creation
>> of gnus links while in message mode I could provide a patch.
>
> FWIW, I think it would be useful.
>
>> I'd probably add the functionality to `org-gnus-store-link' but I'm
>> not an org code expert and a different location may be more
>> appropriate.  What do you think?
>
> Such a change belongs to `org-gnus-store-link' -- I'd be glad to apply a
> patch to this effect.

Please find a patch attached. I works for me with latest Emacs, Org,
Gnus from bzr/git but with all the limitations mentioned earlier in this
thread.

The patch includes the generation of the `Message-ID' header if none is
present.  It also removes the `message-deletable' property from that
header to prevent Gnus from re-generating the message id and thus
breaking the org link.  This should (hopefully) work regardless of the
value of `message-generate-headers-first', `message-deletable-headers'
et al.

Ulf


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-gnus-store-link-message-mode.diff --]
[-- Type: text/x-patch, Size: 1793 bytes --]

--- org-gnus.el.orig	2011-02-09 10:20:37.003314968 +0100
+++ org-gnus.el	2011-02-09 14:50:55.320440970 +0100
@@ -186,7 +186,35 @@
 	    link (org-gnus-article-link
 		  group	newsgroups message-id x-no-archive))
       (org-add-link-props :link link :description desc)
-      link))))
+      link))
+   ((eq major-mode 'message-mode)
+    (setq org-store-link-plist nil)  ; reset
+    (save-excursion
+      (save-restriction
+        (message-narrow-to-headers)
+        (and (not (message-fetch-field "Message-ID"))
+             (message-generate-headers '(Message-ID)))
+        (goto-char (point-min))
+        (re-search-forward "^Message-ID: *.*$" nil t)
+        (put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil)
+        (let ((gcc (car (last
+                         (message-unquote-tokens
+                          (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,")))))
+              (id (org-remove-angle-brackets (mail-fetch-field "Message-ID")))
+              (to (mail-fetch-field "To"))
+              (from (mail-fetch-field "From"))
+              (subject (mail-fetch-field "Subject"))
+              desc link
+              newsgroup xarchive)       ; those are always nil for gcc
+          (and (not gcc)
+               (error "Can not create link: No Gcc header found."))
+          (org-store-link-props :type "gnus" :from from :subject subject
+                                :message-id id :group gcc :to to)
+          (setq desc (org-email-link-description)
+                link (org-gnus-article-link
+                      gcc newsgroup id xarchive))
+          (org-add-link-props :link link :description desc)
+          link))))))
 
 (defun org-gnus-open-nntp (path)
   "Follow the nntp: link specified by PATH."

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

_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
