瀏覽代碼

Make gnus links use message-id.

Carsten Dominik 16 年之前
父節點
當前提交
17c55f1b10
共有 3 個文件被更改,包括 39 次插入16 次删除
  1. 13 0
      lisp/ChangeLog
  2. 14 7
      lisp/org-gnus.el
  3. 12 9
      lisp/org.el

+ 13 - 0
lisp/ChangeLog

@@ -1,3 +1,16 @@
+2008-10-29  Carsten Dominik  <dominik@science.uva.nl>
+
+	* org.el (org-link-frame-setup): Add `org-gnus-no-new-news' as an
+	option.
+	(org-store-link-props): Make sure adding to the plist works
+	correctly.
+
+	* org-gnus.el (org-gnus-no-new-news): New function.
+	(org-gnus-follow-link): Allow the article ID to be a message-id,
+	in addition to allowing article numbers.  Message IDs make much
+	more roubust links.
+	(org-gnus-store-link): Use message-id to create link.
+
 2008-10-28  Carsten Dominik  <dominik@science.uva.nl>
 
 	* org.el (org-emphasize): Reverse the selection array.

+ 14 - 7
lisp/org-gnus.el

@@ -96,12 +96,11 @@ negates this setting for the duration of the command."
       (setq desc (org-email-link-description))
       (if (org-xor current-prefix-arg org-usenet-links-prefer-google)
 	  (setq link
-		(concat
-		 desc "\n  "
-		 (format "http://groups.google.com/groups?as_umsgid=%s"
-			 (org-fixup-message-id-for-http message-id))))
-	(setq link (org-make-link "gnus:" group
-				  "#" (number-to-string article))))
+		(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)))))
       (org-add-link-props :link link :description desc)
       link))))
 
@@ -121,9 +120,17 @@ negates this setting for the duration of the command."
   (if gnus-other-frame-object (select-frame gnus-other-frame-object))
   (cond ((and group article)
 	 (gnus-group-read-group 1 nil group)
-	 (gnus-summary-goto-article (string-to-number article) nil t))
+	 (gnus-summary-goto-article
+	  (if (string-match "[^0-9]" article)
+	      article
+	    (string-to-number article))
+	  nil t))
 	(group (gnus-group-jump-to-group group))))
 
+(defun org-gnus-no-new-news ()
+  "Like `M-x gnus' but doesn't check for new news."
+  (if (not (gnus-alive-p)) (gnus)))
+
 (provide 'org-gnus)
 
 ;; arch-tag: 512e0840-58fa-45b3-b456-71e10fa2376d

+ 12 - 9
lisp/org.el

@@ -1018,6 +1018,7 @@ For VM, use any of
 For Gnus, use any of
     `gnus'
     `gnus-other-frame'
+    `org-gnus-no-new-news'
 For FILE, use any of
     `find-file'
     `find-file-other-window'
@@ -1035,7 +1036,8 @@ another window."
 	  (cons (const gnus)
 		(choice
 		 (const gnus)
-		 (const gnus-other-frame)))
+		 (const gnus-other-frame)
+		 (const org-gnus-no-new-news)))
 	  (cons (const file)
 		(choice
 		 (const find-file)
@@ -6130,19 +6132,20 @@ For file links, arg negates `org-context-in-file-links'."
   (let (x adr)
     (when (setq x (plist-get plist :from))
       (setq adr (mail-extract-address-components x))
-      (plist-put plist :fromname (car adr))
-      (plist-put plist :fromaddress (nth 1 adr)))
+      (setq plist (plist-put plist :fromname (car adr)))
+      (setq plist (plist-put plist :fromaddress (nth 1 adr))))
     (when (setq x (plist-get plist :to))
       (setq adr (mail-extract-address-components x))
-      (plist-put plist :toname (car adr))
-      (plist-put plist :toaddress (nth 1 adr))))
+      (setq plist (plist-put plist :toname (car adr)))
+      (setq plist (plist-put plist :toaddress (nth 1 adr)))))
   (let ((from (plist-get plist :from))
 	(to (plist-get plist :to)))
     (when (and from to org-from-is-user-regexp)
-      (plist-put plist :fromto
-		 (if (string-match org-from-is-user-regexp from)
-		     (concat "to %t")
-		   (concat "from %f")))))
+      (setq plist
+	    (plist-put plist :fromto
+		       (if (string-match org-from-is-user-regexp from)
+			   (concat "to %t")
+			 (concat "from %f"))))))
   (setq org-store-link-plist plist))
 
 (defun org-add-link-props (&rest plist)