summaryrefslogtreecommitdiff
path: root/lisp/org-mhe.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:01 +0200
committerS├ębastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:01 +0200
commit7697fa4daf3ec84f85711a84035d8f0224afd4e3 (patch)
tree24d0f1d2a9751ca8c063409fd2ab71478b296efb /lisp/org-mhe.el
Imported Upstream version 7.9.2
Diffstat (limited to 'lisp/org-mhe.el')
-rw-r--r--lisp/org-mhe.el227
1 files changed, 227 insertions, 0 deletions
diff --git a/lisp/org-mhe.el b/lisp/org-mhe.el
new file mode 100644
index 0000000..7c8b0b2
--- /dev/null
+++ b/lisp/org-mhe.el
@@ -0,0 +1,227 @@
+;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode
+
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
+
+;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file implements links to MH-E messages from within Org-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+
+;;; Code:
+
+(require 'org)
+
+;; Customization variables
+
+(defcustom org-mhe-search-all-folders nil
+ "Non-nil means the search for the mh-message may extend to all folders.
+When non-nil, the search for a message will extend to all other
+folders if it cannot be found in the folder given in the link.
+Searching all folders may be slow with the default pick based
+search but is very efficient with one of the other search engines
+supported by MH-E."
+ :group 'org-link-follow
+ :type 'boolean)
+
+;; Declare external functions and variables
+(declare-function mh-display-msg "mh-show" (msg-num folder-name))
+(declare-function mh-find-path "mh-utils" ())
+(declare-function mh-get-header-field "mh-utils" (field))
+(declare-function mh-get-msg-num "mh-utils" (error-if-no-message))
+(declare-function mh-header-display "mh-show" ())
+(declare-function mh-index-previous-folder "mh-search" ())
+(declare-function mh-normalize-folder-name "mh-utils"
+ (folder &optional empty-string-okay dont-remove-trailing-slash
+ return-nil-if-folder-empty))
+(declare-function mh-search "mh-search"
+ (folder search-regexp &optional redo-search-flag
+ window-config))
+(declare-function mh-search-choose "mh-search" (&optional searcher))
+(declare-function mh-show "mh-show" (&optional message redisplay-flag))
+(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer))
+(declare-function mh-show-header-display "mh-show" t t)
+(declare-function mh-show-msg "mh-show" (msg))
+(declare-function mh-show-show "mh-show" t t)
+(declare-function mh-visit-folder "mh-folder" (folder &optional
+ range index-data))
+(defvar mh-progs)
+(defvar mh-current-folder)
+(defvar mh-show-folder-buffer)
+(defvar mh-index-folder)
+(defvar mh-searcher)
+(defvar mh-search-regexp-builder)
+
+;; Install the link type
+(org-add-link-type "mhe" 'org-mhe-open)
+(add-hook 'org-store-link-functions 'org-mhe-store-link)
+
+;; Implementation
+(defun org-mhe-store-link ()
+ "Store a link to an MH-E folder or message."
+ (when (or (equal major-mode 'mh-folder-mode)
+ (equal major-mode 'mh-show-mode))
+ (save-window-excursion
+ (let* ((from (org-mhe-get-header "From:"))
+ (to (org-mhe-get-header "To:"))
+ (message-id (org-mhe-get-header "Message-Id:"))
+ (subject (org-mhe-get-header "Subject:"))
+ (date (org-mhe-get-header "Date:"))
+ (date-ts (and date (format-time-string
+ (org-time-stamp-format t) (date-to-time date))))
+ (date-ts-ia (and date (format-time-string
+ (org-time-stamp-format t t)
+ (date-to-time date))))
+ link desc)
+ (org-store-link-props :type "mh" :from from :to to
+ :subject subject :message-id message-id)
+ (when date
+ (org-add-link-props :date date :date-timestamp date-ts
+ :date-timestamp-inactive date-ts-ia))
+ (setq desc (org-email-link-description))
+ (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#"
+ (org-remove-angle-brackets message-id)))
+ (org-add-link-props :link link :description desc)
+ link))))
+
+(defun org-mhe-open (path)
+ "Follow an MH-E message link specified by PATH."
+ (let (folder article)
+ (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
+ (error "Error in MH-E link"))
+ (setq folder (match-string 1 path)
+ article (match-string 3 path))
+ (org-mhe-follow-link folder article)))
+
+;;; mh-e integration based on planner-mode
+(defun org-mhe-get-message-real-folder ()
+ "Return the name of the real folder for the current message.
+So if you use sequences, it will now work."
+ (save-excursion
+ (let* ((folder
+ (if (equal major-mode 'mh-folder-mode)
+ mh-current-folder
+ ;; Refer to the show buffer
+ mh-show-folder-buffer))
+ (end-index
+ (if (boundp 'mh-index-folder)
+ (min (length mh-index-folder) (length folder))))
+ )
+ ;; a simple test on mh-index-data does not work, because
+ ;; mh-index-data is always nil in a show buffer.
+ (if (and (boundp 'mh-index-folder)
+ (string= mh-index-folder (substring folder 0 end-index)))
+ (if (equal major-mode 'mh-show-mode)
+ (save-window-excursion
+ (let (pop-up-frames)
+ (when (buffer-live-p (get-buffer folder))
+ (progn
+ (pop-to-buffer folder)
+ (org-mhe-get-message-folder-from-index)
+ )
+ )))
+ (org-mhe-get-message-folder-from-index)
+ )
+ folder
+ )
+ )))
+
+(defun org-mhe-get-message-folder-from-index ()
+ "Return the name of the message folder in an index folder buffer."
+ (save-excursion
+ (mh-index-previous-folder)
+ (if (re-search-forward "^\\(+.*\\)$" nil t)
+ (message "%s" (match-string 1)))))
+
+(defun org-mhe-get-message-folder ()
+ "Return the name of the current message folder.
+Be careful if you use sequences."
+ (save-excursion
+ (if (equal major-mode 'mh-folder-mode)
+ mh-current-folder
+ ;; Refer to the show buffer
+ mh-show-folder-buffer)))
+
+(defun org-mhe-get-message-num ()
+ "Return the number of the current message.
+Be careful if you use sequences."
+ (save-excursion
+ (if (equal major-mode 'mh-folder-mode)
+ (mh-get-msg-num nil)
+ ;; Refer to the show buffer
+ (mh-show-buffer-message-number))))
+
+(defun org-mhe-get-header (header)
+ "Return the field for HEADER of the message in folder mode.
+This will create a show buffer for the corresponding message. If
+you have a better idea of how to do this then please let us know."
+ (let* ((folder (org-mhe-get-message-folder))
+ (num (org-mhe-get-message-num))
+ (buffer (get-buffer-create (concat "show-" folder)))
+ (header-field))
+ (with-current-buffer buffer
+ (mh-display-msg num folder)
+ (if (equal major-mode 'mh-folder-mode)
+ (mh-header-display)
+ (mh-show-header-display))
+ (set-buffer buffer)
+ (setq header-field (mh-get-header-field header))
+ (if (equal major-mode 'mh-folder-mode)
+ (mh-show)
+ (mh-show-show))
+ (org-trim header-field))))
+
+(defun org-mhe-follow-link (folder article)
+ "Follow an MH-E link to FOLDER and ARTICLE.
+If ARTICLE is nil FOLDER is shown. If the configuration variable
+`org-mhe-search-all-folders' is t and `mh-searcher' is pick,
+ARTICLE is searched in all folders. Indexed searches (swish++,
+namazu, and others supported by MH-E) will always search in all
+folders."
+ (require 'mh-e)
+ (require 'mh-search)
+ (require 'mh-utils)
+ (mh-find-path)
+ (if (not article)
+ (mh-visit-folder (mh-normalize-folder-name folder))
+ (mh-search-choose)
+ (if (equal mh-searcher 'pick)
+ (progn
+ (setq article (org-add-angle-brackets article))
+ (mh-search folder (list "--message-id" article))
+ (when (and org-mhe-search-all-folders
+ (not (org-mhe-get-message-real-folder)))
+ (kill-this-buffer)
+ (mh-search "+" (list "--message-id" article))))
+ (if mh-search-regexp-builder
+ (mh-search "+" (funcall mh-search-regexp-builder
+ (list (cons 'message-id article))))
+ (mh-search "+" article)))
+ (if (org-mhe-get-message-real-folder)
+ (mh-show-msg 1)
+ (kill-this-buffer)
+ (error "Message not found"))))
+
+(provide 'org-mhe)
+
+;;; org-mhe.el ends here