summaryrefslogtreecommitdiff
path: root/contrib/lisp/org-mew.el
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/lisp/org-mew.el')
-rw-r--r--contrib/lisp/org-mew.el364
1 files changed, 364 insertions, 0 deletions
diff --git a/contrib/lisp/org-mew.el b/contrib/lisp/org-mew.el
new file mode 100644
index 0000000..ca6a352
--- /dev/null
+++ b/contrib/lisp/org-mew.el
@@ -0,0 +1,364 @@
+;;; org-mew.el --- Support for links to Mew messages from within Org-mode
+
+;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+
+;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+
+;; This file is not part of GNU Emacs.
+
+;; This program 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.
+
+;; This program 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 Mew messages from within Org-mode.
+;; Org-mode loads this module by default - if this is not what you want,
+;; configure the variable `org-modules'.
+;;
+;; Here is an example of workflow:
+
+;; In your ~/.mew.el configuration file:
+;;
+;; (define-key mew-summary-mode-map "'" 'org-mew-search)
+;; (eval-after-load "mew-summary"
+;; '(define-key mew-summary-mode-map "\C-o" 'org-mew-capture))
+
+;; 1. In the Mew's inbox folder, take a glance at new messages to find
+;; a message that requires any action.
+
+;; 2. If the message is a reply from somebody and associated with the
+;; existing orgmode entry, type M-x `org-mew-search' RET (or press
+;; the ' key simply) to find the entry. If you can find the entry
+;; successfully and think you should start the task right now,
+;; start the task by M-x `org-agenda-clock-in' RET.
+
+;; 3. If the message is a new message, type M-x `org-mew-capture' RET,
+;; enter the refile folder, and the buffer to capture the message
+;; is shown up (without selecting the template by hand). Then you
+;; can fill the template and type C-c C-c to complete the capture.
+;; Note that you can configure `org-capture-templates' so that the
+;; captured entry has a link to the message.
+
+;;; Code:
+
+(require 'org)
+
+(defgroup org-mew nil
+ "Options concerning the Mew link."
+ :tag "Org Startup"
+ :group 'org-link)
+
+(defcustom org-mew-link-to-refile-destination t
+ "Create a link to the refile destination if the message is marked as refile."
+ :group 'org-mew
+ :type 'boolean)
+
+(defcustom org-mew-inbox-folder nil
+ "The folder where new messages are incorporated.
+If `org-mew-inbox-folder' is non-nil, `org-mew-open' locates the message
+in this inbox folder as well as the folder specified by the link."
+ :group 'org-mew
+ :type 'string)
+
+(defcustom org-mew-use-id-db t
+ "Use ID database to locate the message if id.db is created."
+ :group 'org-mew
+ :type 'boolean)
+
+(defcustom org-mew-subject-alist
+ (list (cons (concat "^\\(?:\\(?:re\\|fwd?\\): *\\)*"
+ "\\(?:[[(][a-z0-9._-]+[:,]? [0-9]+[])]\\)? *"
+ "\\(?:\\(?:re\\|fwd?\\): *\\)*"
+ "\\(.*\\)[ \t]*")
+ 1))
+ "Alist of subject regular expression and matched group number for search."
+ :group 'org-mew
+ :type '(repeat (cons (regexp) (integer))))
+
+(defcustom org-mew-capture-inbox-folders nil
+ "List of inbox folders whose messages need refile marked before capture.
+`org-mew-capture' will ask you to put the refile mark on the
+message if the message's folder is any of these folders and the
+message is not marked. Nil means `org-mew-capture' never ask you
+destination folders before capture."
+ :group 'org-mew
+ :type '(repeat string))
+
+(defcustom org-mew-capture-guess-alist nil
+ "Alist of the regular expression of the folder name and the capture
+template selection keys.
+
+For example,
+ '((\"^%emacs-orgmode$\" . \"o\")
+ (\"\" . \"t\"))
+the messages in \"%emacs-orgmode\" folder will be captured with
+the capture template associated with \"o\" key, and any other
+messages will be captured with the capture template associated
+with \"t\" key."
+ :group 'org-mew
+ :type '(repeat (cons regexp string)))
+
+;; Declare external functions and variables
+(declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit))
+(declare-function mew-case-folder "ext:mew-func" (case folder))
+(declare-function mew-folder-path-to-folder
+ "ext:mew-func" (path &optional has-proto))
+(declare-function mew-idstr-to-id-list "ext:mew-header" (idstr &optional rev))
+(declare-function mew-folder-remotep "ext:mew-func" (folder))
+(declare-function mew-folder-virtualp "ext:mew-func" (folder))
+(declare-function mew-header-get-value "ext:mew-header"
+ (field &optional as-list))
+(declare-function mew-init "ext:mew" ())
+(declare-function mew-refile-get "ext:mew-refile" (msg))
+(declare-function mew-sinfo-get-case "ext:mew-summary" ())
+(declare-function mew-summary-diag-global "ext:mew-thread" (id opt who))
+(declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay))
+(declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext))
+(declare-function mew-summary-get-mark "ext:mew-mark" ())
+(declare-function mew-summary-message-number2 "ext:mew-syntax" ())
+(declare-function mew-summary-pick-with-mewl "ext:mew-pick"
+ (pattern folder src-msgs))
+(declare-function mew-summary-refile "ext:mew-refile" (&optional report))
+(declare-function mew-summary-search-msg "ext:mew-const" (msg))
+(declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg))
+(declare-function mew-summary-visit-folder "ext:mew-summary4"
+ (folder &optional goend no-ls))
+(declare-function mew-window-push "ext:mew" ())
+(declare-function mew-expand-folder "ext:mew-func" (folder))
+(declare-function mew-case:folder-folder "ext:mew-func" (case:folder))
+(declare-function mew "ext:mew" (&optional arg))
+(declare-function mew-message-goto-summary "ext:mew-message" ())
+(declare-function mew-summary-mode "ext:mew-summary" ())
+
+(defvar mew-init-p)
+(defvar mew-mark-afterstep-spec)
+(defvar mew-summary-goto-line-then-display)
+
+;; Install the link type
+(org-add-link-type "mew" 'org-mew-open)
+(add-hook 'org-store-link-functions 'org-mew-store-link)
+
+;; Implementation
+(defun org-mew-store-link ()
+ "Store a link to a Mew folder or message."
+ (save-window-excursion
+ (if (eq major-mode 'mew-message-mode)
+ (mew-message-goto-summary))
+ (when (memq major-mode '(mew-summary-mode mew-virtual-mode))
+ (let ((msgnum (mew-summary-message-number2))
+ (folder-name (org-mew-folder-name)))
+ (if (fboundp 'mew-summary-set-message-buffer)
+ (mew-summary-set-message-buffer folder-name msgnum)
+ (set-buffer (mew-cache-hit folder-name msgnum t)))
+ (let* ((message-id (mew-header-get-value "Message-Id:"))
+ (from (mew-header-get-value "From:"))
+ (to (mew-header-get-value "To:"))
+ (date (mew-header-get-value "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))))
+ (subject (mew-header-get-value "Subject:"))
+ desc link)
+ (org-store-link-props :type "mew" :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 message-id (org-remove-angle-brackets message-id))
+ (setq desc (org-email-link-description))
+ (setq link (concat "mew:" folder-name "#" message-id))
+ (org-add-link-props :link link :description desc)
+ link)))))
+
+(defun org-mew-folder-name ()
+ "Return the folder name of the current message."
+ (save-window-excursion
+ (if (eq major-mode 'mew-message-mode)
+ (mew-message-goto-summary))
+ (let* ((msgnum (mew-summary-message-number2))
+ (mark-info (mew-summary-get-mark)))
+ (if (and org-mew-link-to-refile-destination
+ (eq mark-info ?o)) ; marked as refile
+ (mew-case-folder (mew-sinfo-get-case)
+ (nth 1 (mew-refile-get msgnum)))
+ (let ((folder-or-path (mew-summary-folder-name)))
+ (mew-folder-path-to-folder folder-or-path t))))))
+
+(defun org-mew-open (path)
+ "Follow the Mew message link specified by PATH."
+ (let (folder message-id)
+ (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's
+ (setq folder (match-string 1 path))
+ (setq message-id (match-string 2 path)))
+ ((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)
+ (setq folder (match-string 1 path))
+ (setq message-id (match-string 4 path)))
+ ((and org-mew-use-id-db (string-match "\\`#\\(.+\\)" path))
+ (setq folder nil)
+ (setq message-id (match-string 1 path)))
+ (t (error "Error in Mew link")))
+ (require 'mew)
+ (mew-window-push)
+ (unless mew-init-p (mew-init))
+ (if (null folder)
+ (progn
+ (mew t)
+ (org-mew-open-by-message-id message-id))
+ (or (org-mew-follow-link folder message-id)
+ (and org-mew-inbox-folder (not (string= org-mew-inbox-folder folder))
+ (org-mew-follow-link org-mew-inbox-folder message-id))
+ (and org-mew-use-id-db
+ (org-mew-open-by-message-id message-id))
+ (error "Message not found")))))
+
+(defun org-mew-follow-link (folder message-id)
+ (unless (org-mew-folder-exists-p folder)
+ (error "No such folder or wrong folder %s" folder))
+ (mew-summary-visit-folder folder)
+ (when message-id
+ (let ((msgnum (org-mew-get-msgnum folder message-id)))
+ (when (mew-summary-search-msg msgnum)
+ (if mew-summary-goto-line-then-display
+ (mew-summary-display))
+ t))))
+
+(defun org-mew-folder-exists-p (folder)
+ (let ((dir (mew-expand-folder folder)))
+ (cond
+ ((mew-folder-virtualp folder) (get-buffer folder))
+ ((null dir) nil)
+ ((mew-folder-remotep (mew-case:folder-folder folder)) t)
+ (t (file-directory-p dir)))))
+
+(defun org-mew-get-msgnum (folder message-id)
+ (if (string-match "\\`[0-9]+\\'" message-id)
+ message-id
+ (let* ((pattern (concat "message-id=" message-id))
+ (msgs (mew-summary-pick-with-mewl pattern folder nil)))
+ (car msgs))))
+
+(defun org-mew-open-by-message-id (message-id)
+ "Open message using ID database."
+ (let ((result (mew-summary-diag-global (format "<%s>" message-id)
+ "-p" "Message")))
+ (unless (eq result t)
+ (error "Message not found"))))
+
+;; In ~/.mew.el, add the following line:
+;; (define-key mew-summary-mode-map "'" 'org-mew-search)
+(defun org-mew-search (&optional arg)
+ "Show all entries related to the message using `org-search-view'.
+
+It shows entries which contains the message ID, the reference
+IDs, or the subject of the message.
+
+With C-u prefix, search for the entries that contains the message
+ID or any of the reference IDs. With C-u C-u prefix, search for
+the message ID or the last reference ID.
+
+The search phase for the subject is extracted with
+`org-mew-subject-alist', which defines the regular expression of
+the subject and the group number to extract. You can get rid of
+\"Re:\" and some other prefix from the subject text."
+ (interactive "P")
+ (when (memq major-mode '(mew-summary-mode mew-virtual-mode))
+ (let ((last-reference-only (equal arg '(16)))
+ (by-subject (null arg))
+ (msgnum (mew-summary-message-number2))
+ (folder-name (mew-summary-folder-name))
+ subject message-id references id-list)
+ (save-window-excursion
+ (if (fboundp 'mew-summary-set-message-buffer)
+ (mew-summary-set-message-buffer folder-name msgnum)
+ (set-buffer (mew-cache-hit folder-name msgnum t)))
+ (setq subject (mew-header-get-value "Subject:"))
+ (setq message-id (mew-header-get-value "Message-Id:"))
+ (setq references (mew-header-get-value "References:")))
+ (setq id-list (mapcar (lambda (id) (org-remove-angle-brackets id))
+ (mew-idstr-to-id-list references)))
+ (if last-reference-only
+ (setq id-list (last id-list))
+ (if message-id
+ (setq id-list (cons (org-remove-angle-brackets message-id)
+ id-list))))
+ (when (and by-subject (stringp subject))
+ (catch 'matched
+ (mapc (lambda (elem)
+ (let ((regexp (car elem))
+ (num (cdr elem)))
+ (when (string-match regexp subject)
+ (setq subject (match-string num subject))
+ (throw 'matched t))))
+ org-mew-subject-alist))
+ (setq id-list (cons subject id-list)))
+ (cond ((null id-list)
+ (error "No message ID to search."))
+ ((equal (length id-list) 1)
+ (org-search-view nil (car id-list)))
+ (t
+ (org-search-view nil (format "{\\(%s\\)}"
+ (mapconcat 'regexp-quote
+ id-list "\\|"))))))
+ (delete-other-windows)))
+
+(defun org-mew-capture (arg)
+ "Guess the capture template from the folder name and invoke `org-capture'.
+
+This selects a capture template in `org-capture-templates' by
+searching for capture template selection keys defined in
+`org-mew-capture-guess-alist' which are associated with the
+regular expression that matches the message's folder name, and
+then invokes `org-capture'.
+
+If the message's folder is a inbox folder, you are prompted to
+put the refile mark on the message and the capture template is
+guessed from the refile destination folder. You can customize
+the inbox folders by `org-mew-capture-inbox-folders'.
+
+If ARG is non-nil, this does not guess the capture template but
+asks you to select the capture template."
+ (interactive "P")
+ (or (not (member (org-mew-folder-name)
+ org-mew-capture-inbox-folders))
+ (eq (mew-summary-get-mark) ?o)
+ (save-window-excursion
+ (if (eq major-mode 'mew-message-mode)
+ (mew-message-goto-summary))
+ (let ((mew-mark-afterstep-spec '((?o 0 0 0 0 0 0 0))))
+ (mew-summary-refile)))
+ (error "No refile folder selected."))
+ (let* ((org-mew-link-to-refile-destination t)
+ (folder-name (org-mew-folder-name))
+ (keys (if arg
+ nil
+ (org-mew-capture-guess-selection-keys folder-name))))
+ (org-capture nil keys)))
+
+(defun org-mew-capture-guess-selection-keys (folder-name)
+ (catch 'found
+ (let ((alist org-mew-capture-guess-alist))
+ (while alist
+ (let ((elem (car alist)))
+ (if (string-match (car elem) folder-name)
+ (throw 'found (cdr elem))))
+ (setq alist (cdr alist))))))
+
+(provide 'org-mew)
+
+;;; org-mew.el ends here
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-16 11:25:25 +0000