| 1 | ;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode |
| 2 | |
| 3 | ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> |
| 6 | ;; Keywords: outlines, hypermedia, calendar, wp |
| 7 | ;; Homepage: http://orgmode.org |
| 8 | ;; Version: 6.02b |
| 9 | ;; |
| 10 | ;; This file is part of GNU Emacs. |
| 11 | ;; |
| 12 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 13 | ;; it under the terms of the GNU General Public License as published by |
| 14 | ;; the Free Software Foundation; either version 3, or (at your option) |
| 15 | ;; any later version. |
| 16 | |
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 20 | ;; GNU General Public License for more details. |
| 21 | |
| 22 | ;; You should have received a copy of the GNU General Public License |
| 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 25 | ;; Boston, MA 02110-1301, USA. |
| 26 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 27 | ;; |
| 28 | ;;; Commentary: |
| 29 | |
| 30 | ;; This file implements links to Wanderlust messages from within Org-mode. |
| 31 | ;; Org-mode loads this module by default - if this is not what you want, |
| 32 | ;; configure the variable `org-modules'. |
| 33 | |
| 34 | ;;; Code: |
| 35 | |
| 36 | (require 'org) |
| 37 | |
| 38 | (defgroup org-wl nil |
| 39 | "Options concerning the Wanderlust link." |
| 40 | :tag "Org Startup" |
| 41 | :group 'org-link) |
| 42 | |
| 43 | (defcustom org-wl-link-to-refile-destination t |
| 44 | "Create a link to the refile destination if the message is marked as refile." |
| 45 | :group 'org-wl |
| 46 | :type 'boolean) |
| 47 | |
| 48 | ;; Declare external functions and variables |
| 49 | (declare-function elmo-folder-exists-p "ext:elmo" (folder) t) |
| 50 | (declare-function elmo-message-entity-field "ext:elmo-msgdb" |
| 51 | (entity field &optional type)) |
| 52 | (declare-function elmo-message-field "ext:elmo" |
| 53 | (folder number field &optional type) t) |
| 54 | (declare-function elmo-msgdb-overview-get-entity "ext:elmo" (id msgdb) t) |
| 55 | ;; Backward compatibility to old version of wl |
| 56 | (declare-function wl "ext:wl" () t) |
| 57 | (declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t) |
| 58 | (declare-function wl-folder-get-elmo-folder "ext:wl-folder" |
| 59 | (entity &optional no-cache)) |
| 60 | (declare-function wl-summary-goto-folder-subr "ext:wl-summary" |
| 61 | (&optional name scan-type other-window sticky interactive |
| 62 | scoring force-exit)) |
| 63 | (declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" |
| 64 | (&optional id)) |
| 65 | (declare-function wl-summary-line-from "ext:wl-summary" ()) |
| 66 | (declare-function wl-summary-line-subject "ext:wl-summary" ()) |
| 67 | (declare-function wl-summary-message-number "ext:wl-summary" ()) |
| 68 | (declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) |
| 69 | (declare-function wl-summary-registered-temp-mark "ext:wl-action" (number)) |
| 70 | (declare-function wl-folder-goto-folder-subr "ext:wl-folder" |
| 71 | (&optional folder sticky)) |
| 72 | (declare-function wl-thread-open-all "ext:wl-thread" ()) |
| 73 | (defvar wl-init) |
| 74 | (defvar wl-summary-buffer-elmo-folder) |
| 75 | (defvar wl-summary-buffer-folder-name) |
| 76 | |
| 77 | ;; Install the link type |
| 78 | (org-add-link-type "wl" 'org-wl-open) |
| 79 | (add-hook 'org-store-link-functions 'org-wl-store-link) |
| 80 | |
| 81 | ;; Implementation |
| 82 | (defun org-wl-store-link () |
| 83 | "Store a link to a WL folder or message." |
| 84 | (when (eq major-mode 'wl-summary-mode) |
| 85 | (let* ((msgnum (wl-summary-message-number)) |
| 86 | (mark-info (wl-summary-registered-temp-mark msgnum)) |
| 87 | (folder-name |
| 88 | (if (and org-wl-link-to-refile-destination |
| 89 | mark-info |
| 90 | (equal (nth 1 mark-info) "o")) ; marked as refile |
| 91 | (nth 2 mark-info) |
| 92 | wl-summary-buffer-folder-name)) |
| 93 | (message-id (elmo-message-field wl-summary-buffer-elmo-folder |
| 94 | msgnum 'message-id)) |
| 95 | (wl-message-entity |
| 96 | (if (fboundp 'elmo-message-entity) |
| 97 | (elmo-message-entity |
| 98 | wl-summary-buffer-elmo-folder msgnum) |
| 99 | (elmo-msgdb-overview-get-entity |
| 100 | msgnum (wl-summary-buffer-msgdb)))) |
| 101 | (from (wl-summary-line-from)) |
| 102 | (to (let ((to-field (elmo-message-entity-field wl-message-entity |
| 103 | 'to))) |
| 104 | (if (listp to-field) |
| 105 | (car to-field) |
| 106 | to-field))) |
| 107 | (subject (let (wl-thr-indent-string wl-parent-message-entity) |
| 108 | (wl-summary-line-subject))) |
| 109 | desc link) |
| 110 | (org-store-link-props :type "wl" :from from :to to |
| 111 | :subject subject :message-id message-id) |
| 112 | (setq message-id (org-remove-angle-brackets message-id)) |
| 113 | (setq desc (org-email-link-description)) |
| 114 | (setq link (org-make-link "wl:" folder-name |
| 115 | "#" message-id)) |
| 116 | (org-add-link-props :link link :description desc) |
| 117 | link))) |
| 118 | |
| 119 | (defun org-wl-open (path) |
| 120 | "Follow the WL message link specified by PATH." |
| 121 | (require 'wl) |
| 122 | (unless wl-init (wl)) |
| 123 | ;; XXX: The imap-uw's MH folder names start with "%#". |
| 124 | (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)) |
| 125 | (error "Error in Wanderlust link")) |
| 126 | (let ((folder (match-string 1 path)) |
| 127 | (article (match-string 3 path))) |
| 128 | (if (not (elmo-folder-exists-p (wl-folder-get-elmo-folder folder))) |
| 129 | (error "No such folder: %s" folder)) |
| 130 | (let ((old-buf (current-buffer)) |
| 131 | (old-point (point-marker))) |
| 132 | (wl-folder-goto-folder-subr folder) |
| 133 | (save-excursion |
| 134 | ;; XXX: `wl-folder-goto-folder-subr' moves point to the |
| 135 | ;; beginning of the current line. So, restore the point |
| 136 | ;; in the old buffer. |
| 137 | (set-buffer old-buf) |
| 138 | (goto-char old-point)) |
| 139 | (wl-thread-open-all) |
| 140 | (and (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets |
| 141 | article)) |
| 142 | (wl-summary-redisplay))))) |
| 143 | |
| 144 | (provide 'org-wl) |
| 145 | |
| 146 | ;; arch-tag: 29b75a0f-ef2e-430b-8abc-acff75bde54a |
| 147 | ;;; org-wl.el ends here |