mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-11-26 07:33:39 +00:00
org-mew.el: Major enhancement
* org-mew.el (org-mew-inbox-folder, org-mew-use-id-db) (org-mew-subject-alist, org-mew-capture-inbox-folders) (org-mew-capture-guess-alist): New options. (org-mew-store-link, org-mew-open): Rewrite. (org-mew-folder-name, org-mew-follow-link) (org-mew-folder-eixsts-p, org-mew-get-msgnum) (org-mew-open-by-message-id, org-mew-search, org-mew-capture) (org-mew-capture-guess-selection-keys): New functions.
This commit is contained in:
Tokuya Kameshima
Bastien Guerry
parent
4a40c215f9
commit
7604fe1e80
320
lisp/org-mew.el
320
lisp/org-mew.el
@ -27,6 +27,30 @@
|
||||
;; 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:
|
||||
|
||||
@ -42,26 +66,88 @@
|
||||
: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
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.0")
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-mew-use-id-db t
|
||||
"Use ID database to locate the message if id.db is created."
|
||||
:group 'org-mew
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.0")
|
||||
: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
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.0")
|
||||
: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
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.0")
|
||||
: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
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.0")
|
||||
: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-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" ())
|
||||
(defvar mew-init-p)
|
||||
(defvar mew-mark-afterstep-spec)
|
||||
(defvar mew-summary-goto-line-then-display)
|
||||
|
||||
;; Install the link type
|
||||
@ -71,65 +157,209 @@
|
||||
;; Implementation
|
||||
(defun org-mew-store-link ()
|
||||
"Store a link to a Mew folder or message."
|
||||
(when (memq major-mode '(mew-summary-mode mew-virtual-mode))
|
||||
(let* ((msgnum (mew-summary-message-number2))
|
||||
(mark-info (mew-summary-get-mark))
|
||||
(folder-name
|
||||
(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)))
|
||||
(mew-summary-folder-name)))
|
||||
message-id from to subject desc link date date-ts date-ts-ia)
|
||||
(save-window-excursion
|
||||
(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)))
|
||||
(setq message-id (mew-header-get-value "Message-Id:"))
|
||||
(setq from (mew-header-get-value "From:"))
|
||||
(setq to (mew-header-get-value "To:"))
|
||||
(setq date (mew-header-get-value "Date:"))
|
||||
(setq date-ts (and date (format-time-string
|
||||
(org-time-stamp-format t)
|
||||
(date-to-time date))))
|
||||
(setq date-ts-ia (and date (format-time-string
|
||||
(org-time-stamp-format t t)
|
||||
(date-to-time date))))
|
||||
(setq subject (mew-header-get-value "Subject:")))
|
||||
(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)))
|
||||
(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
|
||||
(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 msgnum)
|
||||
(let (folder message-id)
|
||||
(cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's
|
||||
(setq folder (match-string 1 path))
|
||||
(setq msgnum (match-string 2 path)))
|
||||
(setq message-id (match-string 2 path)))
|
||||
((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)
|
||||
(setq folder (match-string 1 path))
|
||||
(setq msgnum (match-string 4 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))
|
||||
(mew-summary-visit-folder folder)
|
||||
(when msgnum
|
||||
(if (not (string-match "\\`[0-9]+\\'" msgnum))
|
||||
(let* ((pattern (concat "message-id=" msgnum))
|
||||
(msgs (mew-summary-pick-with-mewl pattern folder nil)))
|
||||
(setq msgnum (car msgs))))
|
||||
(if (mew-summary-search-msg msgnum)
|
||||
(if mew-summary-goto-line-then-display
|
||||
(mew-summary-display))
|
||||
(error "Message not found")))))
|
||||
(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)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user