org-mew.el 5.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141
  1. ;;; org-mew.el --- Support for links to Mew messages from within Org-mode
  2. ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
  3. ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
  4. ;; Keywords: outlines, hypermedia, calendar, wp
  5. ;; Homepage: http://orgmode.org
  6. ;; Version: 7.5
  7. ;; This file is part of GNU Emacs.
  8. ;; GNU Emacs is free software: you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  18. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19. ;;
  20. ;;; Commentary:
  21. ;; This file implements links to Mew messages from within Org-mode.
  22. ;; Org-mode loads this module by default - if this is not what you want,
  23. ;; configure the variable `org-modules'.
  24. ;;; Code:
  25. (require 'org)
  26. (defgroup org-mew nil
  27. "Options concerning the Mew link."
  28. :tag "Org Startup"
  29. :group 'org-link)
  30. (defcustom org-mew-link-to-refile-destination t
  31. "Create a link to the refile destination if the message is marked as refile."
  32. :group 'org-mew
  33. :type 'boolean)
  34. ;; Declare external functions and variables
  35. (declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit))
  36. (declare-function mew-case-folder "ext:mew-func" (case folder))
  37. (declare-function mew-header-get-value "ext:mew-header"
  38. (field &optional as-list))
  39. (declare-function mew-init "ext:mew" ())
  40. (declare-function mew-refile-get "ext:mew-refile" (msg))
  41. (declare-function mew-sinfo-get-case "ext:mew-summary" ())
  42. (declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay))
  43. (declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext))
  44. (declare-function mew-summary-get-mark "ext:mew-mark" ())
  45. (declare-function mew-summary-message-number2 "ext:mew-syntax" ())
  46. (declare-function mew-summary-pick-with-mewl "ext:mew-pick"
  47. (pattern folder src-msgs))
  48. (declare-function mew-summary-search-msg "ext:mew-const" (msg))
  49. (declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg))
  50. (declare-function mew-summary-visit-folder "ext:mew-summary4"
  51. (folder &optional goend no-ls))
  52. (declare-function mew-window-push "ext:mew" ())
  53. (defvar mew-init-p)
  54. (defvar mew-summary-goto-line-then-display)
  55. ;; Install the link type
  56. (org-add-link-type "mew" 'org-mew-open)
  57. (add-hook 'org-store-link-functions 'org-mew-store-link)
  58. ;; Implementation
  59. (defun org-mew-store-link ()
  60. "Store a link to a Mew folder or message."
  61. (when (memq major-mode '(mew-summary-mode mew-virtual-mode))
  62. (let* ((msgnum (mew-summary-message-number2))
  63. (mark-info (mew-summary-get-mark))
  64. (folder-name
  65. (if (and org-mew-link-to-refile-destination
  66. (eq mark-info ?o)) ; marked as refile
  67. (mew-case-folder (mew-sinfo-get-case)
  68. (nth 1 (mew-refile-get msgnum)))
  69. (mew-summary-folder-name)))
  70. message-id from to subject desc link date date-ts date-ts-ia)
  71. (save-window-excursion
  72. (if (fboundp 'mew-summary-set-message-buffer)
  73. (mew-summary-set-message-buffer folder-name msgnum)
  74. (set-buffer (mew-cache-hit folder-name msgnum t)))
  75. (setq message-id (mew-header-get-value "Message-Id:"))
  76. (setq from (mew-header-get-value "From:"))
  77. (setq to (mew-header-get-value "To:"))
  78. (setq date (mew-header-get-value "Date:"))
  79. (setq date-ts (and date (format-time-string
  80. (org-time-stamp-format t)
  81. (date-to-time date))))
  82. (setq date-ts-ia (and date (format-time-string
  83. (org-time-stamp-format t t)
  84. (date-to-time date))))
  85. (setq subject (mew-header-get-value "Subject:")))
  86. (org-store-link-props :type "mew" :from from :to to
  87. :subject subject :message-id message-id)
  88. (when date
  89. (org-add-link-props :date date :date-timestamp date-ts
  90. :date-timestamp-inactive date-ts-ia))
  91. (setq message-id (org-remove-angle-brackets message-id))
  92. (setq desc (org-email-link-description))
  93. (setq link (org-make-link "mew:" folder-name
  94. "#" message-id))
  95. (org-add-link-props :link link :description desc)
  96. link)))
  97. (defun org-mew-open (path)
  98. "Follow the Mew message link specified by PATH."
  99. (let (folder msgnum)
  100. (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's
  101. (setq folder (match-string 1 path))
  102. (setq msgnum (match-string 2 path)))
  103. ((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)
  104. (setq folder (match-string 1 path))
  105. (setq msgnum (match-string 4 path)))
  106. (t (error "Error in Mew link")))
  107. (require 'mew)
  108. (mew-window-push)
  109. (unless mew-init-p (mew-init))
  110. (mew-summary-visit-folder folder)
  111. (when msgnum
  112. (if (not (string-match "\\`[0-9]+\\'" msgnum))
  113. (let* ((pattern (concat "message-id=" msgnum))
  114. (msgs (mew-summary-pick-with-mewl pattern folder nil)))
  115. (setq msgnum (car msgs))))
  116. (if (mew-summary-search-msg msgnum)
  117. (if mew-summary-goto-line-then-display
  118. (mew-summary-display))
  119. (error "Message not found")))))
  120. (provide 'org-mew)
  121. ;; arch-tag: 07ccdca7-6020-4941-a593-588a1e51b870
  122. ;;; org-mew.el ends here