diff options
Diffstat (limited to 'lisp/org-mhe.el')
| -rw-r--r-- | lisp/org-mhe.el | 227 |
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 |