[Emacs-diffs] Changes to org-mhe.el

[Carsten Dominik]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Carsten Dominik <cdominik>      08/04/27 18:33:39

Index: org-mhe.el
===================================================================
RCS file: org-mhe.el
diff -N org-mhe.el
--- /dev/null   1 Jan 1970 00:00:00 -0000
+++ org-mhe.el  27 Apr 2008 18:33:38 -0000      1.1
@@ -0,0 +1,216 @@
+;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode
+
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008 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
+;; Version: 6.02b
+;;
+;; 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, 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; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; 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)
+
+;; 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))
+    (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:"))
+         link desc)
+      (org-store-link-props :type "mh" :from from :to to
+                           :subject subject :message-id message-id)
+      (setq desc (org-email-link-description))
+      (setq link (org-make-link "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 a index folder buffer."
+  (save-excursion
+    (mh-index-previous-folder)
+    (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))
+    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))
+    (setq article (org-add-angle-brackets article))
+    (mh-search-choose)
+    (if (equal mh-searcher 'pick)
+        (progn
+          (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))))
+      (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