From: Pieter Praet <pieter@praet.org>
To: David Edmondson <dme@dme.org>
Subject: [PATCH v2 2/2] emacs: add `notmuch-show-stash-mlarchive-link{,
	-and-go}'
Date: Mon, 30 Jan 2012 08:12:54 +0100
Message-Id: <1327907574-12760-2-git-send-email-pieter@praet.org>
In-Reply-To: <1327397873-20596-1-git-send-email-dme@dme.org>
References: <1327397873-20596-1-git-send-email-dme@dme.org>
Cc: Notmuch Mail <notmuch@notmuchmail.org>
Precedence: list

* emacs/notmuch-show.el

  (notmuch-show-stash-mlarchive-link-alist):
    New defcustom of type `alist' (key = name, value = URI),
    containing Mailing List Archive URI's for searching by Message-Id.

  (notmuch-show-stash-mlarchive-link-default):
    New defcustom, default MLA to use when `notmuch-show-stash-mlarchive-link'
    received no user input whatsoever.  Available choices are generated using
    the contents of `notmuch-show-stash-mlarchive-link-alist'.

  (notmuch-show-stash-map):
    Added keybinds "l" and "L" for `notmuch-show-stash-mlarchive-link'
    respectively `notmuch-show-stash-mlarchive-link-and-go'.

  (notmuch-show-stash-mlarchive-link):
    New function, stashes a URI pointing to the current message at one
    of the MLAs configured in `notmuch-show-stash-mlarchive-link-alist'.
    Prompts user with `completing-read' if not provided with an MLA key.

  (notmuch-show-stash-mlarchive-link-and-go):
    New function, uses `notmuch-show-stash-mlarchive-link' to
    stash a URI, and then visits it using the browser configured
    in `browse-url-browser-function'.

* test/emacs

  Expanded subtest "Stashing in notmuch-show" wrt new functions
  `notmuch-show-stash-mlarchive-link{,-and-go}'.


Based on original work [1] by David Edmondson <dme@dme.org>.

[1] id:"1327397873-20596-1-git-send-email-dme@dme.org"

---

Addressed comments by David Edmondson [2] and Dmitry Kurochkin [3].

[2] id:"cunsjj1jyfj.fsf@hotblack-desiato.hh.sledj.net"
[3] id:"87zkd9je5j.fsf@gmail.com"

 emacs/notmuch-show.el |   61 +++++++++++++++++++++++++++++++++++++++++++++++++
 test/emacs            |    8 +++++-
 2 files changed, 68 insertions(+), 1 deletions(-)

diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
index b13d088..3d1312c 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -124,6 +124,35 @@ indentation."
 		 (const :tag "View interactively"
 			notmuch-show-interactively-view-part)))
 
+(defcustom notmuch-show-stash-mlarchive-link-alist
+  '(("Gmane" . "http://mid.gmane.org/")
+    ("MARC" . "http://marc.info/?i=")
+    ("Mail Archive, The" . "http://mail-archive.com/search?l=mid&q=")
+    ;; FIXME: can these services be searched by `Message-Id' ?
+    ;; ("MarkMail" . "http://markmail.org/")
+    ;; ("Nabble" . "http://nabble.com/")
+    ;; ("opensubscriber" . "http://opensubscriber.com/")
+    )
+  "List of Mailing List Archives to use when stashing links.
+
+These URIs are concatenated with the current message's
+Message-Id in `notmuch-show-stash-mlarchive-link'."
+  :type '(alist :key-type (string :tag "Name")
+		:value-type (string :tag "URL"))
+  :group 'notmuch-show)
+
+(defcustom notmuch-show-stash-mlarchive-link-default "Gmane"
+  "Default Mailing List Archive to use when stashing links.
+
+This is used when `notmuch-show-stash-mlarchive-link' isn't
+provided with an MLA argument nor `completing-read' input."
+  :type `(choice
+	  ,@(mapcar
+	     (lambda (mla)
+	       (list 'const :tag (car mla) :value (car mla)))
+	     notmuch-show-stash-mlarchive-link-alist))
+  :group 'notmuch-show)
+
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message"
   `(save-excursion
@@ -1048,6 +1077,8 @@ thread id.  If a prefix is given, crypto processing is toggled."
     (define-key map "s" 'notmuch-show-stash-subject)
     (define-key map "T" 'notmuch-show-stash-tags)
     (define-key map "t" 'notmuch-show-stash-to)
+    (define-key map "l" 'notmuch-show-stash-mlarchive-link)
+    (define-key map "L" 'notmuch-show-stash-mlarchive-link-and-go)
     map)
   "Submap for stash commands")
 (fset 'notmuch-show-stash-map notmuch-show-stash-map)
@@ -1640,6 +1671,36 @@ buffer."
   (interactive)
   (notmuch-common-do-stash (notmuch-show-get-to)))
 
+(defun notmuch-show-stash-mlarchive-link (&optional mla)
+  "Copy an ML Archive URI for the current message to the kill-ring.
+
+This presumes that the message is available at the selected Mailing List Archive.
+
+If optional argument MLA is non-nil, use the provided key instead of prompting
+the user (see `notmuch-show-stash-mlarchive-link-alist')."
+  (interactive)
+  (notmuch-common-do-stash
+   (concat (cdr (assoc
+		 (or mla
+		     (let ((completion-ignore-case t))
+		       (completing-read
+			"Mailing List Archive: "
+			notmuch-show-stash-mlarchive-link-alist
+			nil t nil nil notmuch-show-stash-mlarchive-link-default)))
+		 notmuch-show-stash-mlarchive-link-alist))
+	   (notmuch-show-get-message-id t))))
+
+(defun notmuch-show-stash-mlarchive-link-and-go (&optional mla)
+  "Copy an ML Archive URI for the current message to the kill-ring and visit it.
+
+This presumes that the message is available at the selected Mailing List Archive.
+
+If optional argument MLA is non-nil, use the provided key instead of prompting
+the user (see `notmuch-show-stash-mlarchive-link-alist')."
+  (interactive)
+  (notmuch-show-stash-mlarchive-link mla)
+  (browse-url (current-kill 0 t)))
+
 ;; Commands typically bound to buttons.
 
 (defun notmuch-show-part-button-default (&optional button)
diff --git a/test/emacs b/test/emacs
index 8ca4c8a..38df3a3 100755
--- a/test/emacs
+++ b/test/emacs
@@ -382,9 +382,12 @@ test_emacs '(notmuch-show "id:\"bought\"")
 	(notmuch-show-stash-message-id-stripped)
 	(notmuch-show-stash-tags)
 	(notmuch-show-stash-filename)
+	(notmuch-show-stash-mlarchive-link "Gmane")
+	(notmuch-show-stash-mlarchive-link "MARC")
+	(notmuch-show-stash-mlarchive-link "Mail Archive, The")
 	(switch-to-buffer
 	  (generate-new-buffer "*test-stashing*"))
-	(dotimes (i 9)
+	(dotimes (i 12)
 	  (yank)
 	  (insert "\n")
 	  (rotate-yank-pointer 1))
@@ -400,6 +403,9 @@ id:"bought"
 bought
 inbox,stashtest
 ${gen_msg_filename}
+http://mid.gmane.org/bought
+http://marc.info/?i=bought
+http://mail-archive.com/search?l=mid&q=bought
 EOF
 test_expect_equal_file OUTPUT EXPECTED
 
-- 
1.7.8.1