Fetching contributors…
Cannot retrieve contributors at this time
204 lines (173 sloc) 7.82 KB
;;; org-smart-capture --- Capture Gnus messages as tasks, with context
;; Copyright (C) 2011 John Wiegley
;; Author: John Wiegley <>
;; Created: 16 Sep 2011
;; Version: 1.0
;; Keywords: gnus message org capture task todo context
;; X-URL:
;; 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 2, 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
;; 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; I use: (define-key global-map [(meta ?m)] 'org-smart-capture)
(require 'gnus-sum)
(require 'org-capture)
(defgroup org-smart-capture nil
"Capture Gnus messages as tasks, with context"
:group 'org)
(defcustom org-smart-capture-use-lastname nil
"If non-nil, include last names in smart captures."
:type 'boolean
:group 'org-smart-capture)
(defcustom org-subject-transforms nil
"Transformations to apply to Subject lines after capture."
:type '(alist :key-type regexp :value-type regexp)
:group 'org-smart-capture)
(defcustom org-author-transforms nil
"Transformations to apply to author names after capture."
:type '(alist :key-type regexp :value-type regexp)
:group 'org-smart-capture)
(defun convert-dates ()
(while (re-search-forward ":Date:\\s-*\\(.+\\)" nil t)
(let ((date-sent (match-string 1)))
(goto-char (match-beginning 1))
(delete-region (match-beginning 1) (match-end 1))
(insert ?\[ (time-to-org-timestamp
(apply 'encode-time
(parse-time-string date-sent)) t t)
(defun org-smart-capture-article (&optional article multiple)
(let* ((body (and (eq major-mode 'gnus-article-mode)
(buffer-substring-no-properties (region-beginning)
(article (or article (cdr gnus-article-current)))
(data (gnus-data-find-list article))
(ghead (gnus-data-header (car data)))
(message-id (mail-header-message-id ghead))
(raw-subject (mail-header-subject ghead))
(subject (and raw-subject (rfc2047-decode-string raw-subject)))
(date-sent (mail-header-date ghead))
(from (mail-header-from ghead))
(from (if from (rfc2047-decode-string from) "unknown"))
(name (car (ignore-errors
(mail-extract-address-components from))))
fname lname)
(when name
(let ((new-name name))
(dolist (transform org-author-transforms)
(setq new-name
(replace-regexp-in-string (car transform)
(cdr transform) new-name)))
(setq name new-name)))
(when (stringp name)
;; Guess first name and last name:
(cond ((string-match
"\\`\\(\\w\\|[-.]\\)+ \\(\\w\\|[-.]\\)+\\'" name)
(setq fname (nth 0 (split-string name "[ \t]+"))
lname (nth 1 (split-string name "[ \t]+"))))
"\\`\\(\\w\\|[-.]\\)+, \\(\\w\\|[-.]\\)+\\'" name)
(setq fname (nth 1 (split-string name "[ \t,]+"))
lname (nth 0 (split-string name "[ \t,]+"))))
((string-match "\\`\\(\\w\\|[-.]\\)+\\'" name)
(setq fname name
lname ""))
((string-match "\\`\\(\\w+?\\) " name)
(setq fname (match-string 1 name)
lname ""))))
(org-capture nil "a")
(when (stringp fname)
(insert ?\( fname)
(if (and org-smart-capture-use-lastname (stringp lname)
(> (length lname) 0))
(insert ? lname))
(insert ?\) ? ))
(if subject
(let ((new-subject subject))
(dolist (transform org-subject-transforms)
(setq new-subject
(replace-regexp-in-string (car transform)
(cdr transform) new-subject)))
(insert new-subject))))
(when body
(flet ((trim-string
"\\(\\`[[:space:]\n]*\\|[[:space:]\n]*\\'\\)" "" str)))
(forward-line 2)
(insert body))))
(org-set-property "Date"
(or date-sent
(apply 'encode-time
(parse-time-string date-sent)) t t)))
(org-set-property "Message"
(format "[[message://%s][%s]]"
(substring message-id 1 -1)
?\[ ?\{ (subst-char-in-string
?\] ?\} subject))))
(org-set-property "Author" from)
(when multiple
(message "Captured: (%s) %s" fname subject))))
(defun org-smart-capture (&optional arg)
(interactive "P")
(if (not (memq major-mode '(gnus-summary-mode gnus-article-mode)))
(call-interactively #'org-capture)
(cond ((eq major-mode 'gnus-article-mode)
(with-current-buffer gnus-summary-buffer
nil (unless (string= (buffer-name) "*Summary INBOX*")
((eq major-mode 'gnus-summary-mode)
(let* ((current-article (gnus-summary-article-number))
(articles (gnus-summary-work-articles nil))
(multiple (> (length articles) 1)))
(dolist (article articles)
(gnus-summary-remove-process-mark article)
article (unless (string= (buffer-name gnus-summary-buffer)
"*Summary INBOX*")
(unless arg
(org-smart-capture-article article multiple))))
(when arg
(let ((index 1))
(org-smart-capture-article current-article)
(dolist (article articles)
(unless (eq article current-article)
(let* ((ghead (gnus-data-header
(car (gnus-data-find-list article))))
(message-id (mail-header-message-id ghead))
(raw-subject (mail-header-subject ghead))
(subject (and raw-subject
(rfc2047-decode-string raw-subject))))
(format "Message%d" (setq index (1+ index)))
(format "[[message://%s][%s]]"
(substring message-id 1 -1)
?\[ ?\{ (subst-char-in-string
?\] ?\} subject)))))))))))
(gnus-set-mode-line 'summary)))))
(provide 'org-smart-capture)
;;; org-smart-capture.el ends here