Each time a message is sent, put a link to the thread into the org

link ring

elisp/autoload.d/wl-setup.el

@@ -749,19 +749,25 @@ so that the appropriate emacs mode is selected according to the file extension."
 (defvar egh:wl-summary-prev-folder-name nil)
 (defvar dwa:wl-summary-prev-message-id nil)
 
-(defun dwa:wl-current-thread-location ()
-  "Return a pair consisting of the message-id of the current
-message and of the root of its thread (both surrounded by <...>)"
-  (save-window-excursion
-    (wl-summary-set-message-buffer-or-redisplay)
-    (set-buffer (wl-message-get-original-buffer))
 
+(defun dwa:wl-buffer-thread-location ()
+  "Return a pair consisting of the message-id of the message in
+the current buffer and of the root of its thread (both surrounded
+by <...>)"
     (let ((message-id (std11-field-body "Message-Id")))
      ;; The thread root is the first UID in References, if any, or
      ;; else is the current message
       (cons message-id
             (car (split-string (or (std11-field-body "References") message-id)))))
-    ))
+    )
+
+(defun dwa:wl-current-thread-location ()
+  "Return a pair consisting of the message-id of the current
+message and of the root of its thread (both surrounded by <...>)"
+  (save-window-excursion
+    (wl-summary-set-message-buffer-or-redisplay)
+    (set-buffer (wl-message-get-original-buffer))
+    (dwa:wl-buffer-thread-location)))
 
 (defun dwa:wl-thread-root-folder (thread-root)
   (let ((root-uid (substring thread-root 1 -1)))
@@ -792,7 +798,27 @@ message and of the root of its thread (both surrounded by <...>)"
      (make-local-variable 'dwa:wl-summary-prev-message-id)
      )))
 
+(defun dwa:org-message-buffer-store-link-impl ()
+  "Store an org link to the message in the current buffer, in the
+context of its thread"
+  (let* ((thread-location (dwa:wl-buffer-thread-location))
+         (message-id (car thread-location))
+         (folder-name (dwa:wl-thread-root-folder (cdr thread-location)))
+         (message-id-no-brackets (org-remove-angle-brackets message-id))
+         (link (org-make-link "wl:" folder-name "#" message-id-no-brackets))
+             )
+        (org-store-link-props :type "wl" :from (std11-field-body "From") :to (std11-field-body "To")
+                              :subject (std11-field-body "Subject") :message-id message-id
+                              :link link)
+        (org-add-link-props :description (org-email-link-description))
+    )
+  t)
+
+(defun dwa:org-message-buffer-store-link ()
+  (let ((org-store-link-functions '(dwa:org-message-buffer-store-link-impl)))
+    (call-interactively 'org-store-link)))
 
+(add-to-list 'wl-mail-send-pre-hook 'dwa:org-message-buffer-store-link)
 
 (defadvice org-wl-store-link-message (after dwa:org-wl-store-link activate protect)
   (if (string= (substring ad-return-value 0 3) "wl:")