Browse Source

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.
Tokuya Kameshima 12 years ago
parent
commit
7604fe1e80
1 changed files with 275 additions and 45 deletions
  1. 275 45
      lisp/org-mew.el

+ 275 - 45
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)