CONTRIB/org-mairix.el

   1 ;;; org-mairix.el ---
   2
   3 ;; Copyright 2007 Bastien Guerry
   4 ;;
   5 ;; Author: Bastien.Guerry@ens.fr
   6 ;; Version: $Id: org-mairix.el,v 0.0 2007/08/11 17:23:40 guerry Exp $
   7 ;; Keywords:
   8 ;; X-URL: not distributed yet
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program; if not, write to the Free Software
  22 ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; Code and ideas from Carsten Dominik, Adam Spiers and Georg C. F. Greve.
  27
  28 ;; Put this file into your load-path and the following into your ~/.emacs:
  29 ;;   (require 'org-mairix)
  30
  31 ;;; Code:
  32
  33 (require 'org)
  34
  35 (defgroup org-mairix nil
  36   "Mairix link support for Org."
  37   :tag "Org Mairix"
  38   :group 'org)
  39
  40 (defcustom mairix-results-group "nnmaildir+index:mfolder"
  41   "Gnus groupe where to list mairix search results."
  42   :group 'org-mairix
  43   :type '(string))
  44
  45 (defun org-add-link-type (type &optional follow publish)
  46   "Add TYPE to the list of `org-link-types'.
  47 Re-compute all regular expressions depending on `org-link-types'."
  48   (add-to-list 'org-link-types type t)
  49   (setq org-link-re-with-space
  50         (concat
  51          "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
  52          "\\([^" org-non-link-chars " ]"
  53          "[^" org-non-link-chars "]*"
  54          "[^" org-non-link-chars " ]\\)>?"))
  55   (setq org-link-re-with-space2
  56         (concat
  57          "<?\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
  58          "\\([^" org-non-link-chars " ]"
  59          "[^]\t\n\r]*"
  60          "[^" org-non-link-chars " ]\\)>?"))
  61   (setq org-angle-link-re
  62         (concat
  63          "<\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
  64          "\\([^" org-non-link-chars " ]"
  65          "[^" org-non-link-chars "]*"
  66          "\\)>"))
  67   (setq org-plain-link-re
  68         (concat
  69          "\\(" (mapconcat 'identity org-link-types "\\|") "\\):"
  70          "\\([^]\t\n\r<>,;() ]+\\)"))
  71   (setq org-bracket-link-analytic-regexp
  72         (concat
  73          "\\[\\["
  74          "\\(\\(" (mapconcat 'identity org-link-types "\\|") "\\):\\)?"
  75          "\\([^]]+\\)"
  76          "\\]"
  77          "\\(\\[" "\\([^]]+\\)" "\\]\\)?"
  78          "\\]"))
  79   (add-hook 'org-follow-link-functions follow)
  80   (add-hook 'org-publish-link-functions publish))
  81
  82 (defun org-mairix-follow-link (path)
  83   "Follow a Mairix link."
  84   (require 'gnus)
  85   (funcall (cdr (assq 'gnus org-link-frame-setup)))
  86   (if gnus-other-frame-object (select-frame gnus-other-frame-object))
  87   (mairix-search path))
  88
  89 (defun org-mairix-publish-link (path)
  90   "Convert mairix PATH into a (dummy) raw link."
  91   ;; FIXME: should we have a format argument for HTML/LaTeX publishing?
  92   (if (string-match org-bracket-link-analytic-regexp path)
  93     (match-string 5 path) path))
  94
  95 (defun org-mairix-store-link (path)
  96   "Store a mairix link."
  97   (when (memq major-mode '(gnus-summary-mode gnus-article-mode))
  98     (let* ((group gnus-newsgroup-name)
  99            (article (gnus-summary-article-number))
 100            (header (gnus-summary-article-header article))
 101            (from (mail-header-from header))
 102            (message-id (mail-header-id header))
 103            (date (mail-header-date header))
 104            (subject (gnus-summary-subject-string)))
 105       (org-store-link-props :type "mairix"
 106                             :from from
 107                             :subject subject
 108                             :message-id message-id
 109                             :group group)
 110 ;; FIXME: what about cpltxt and link vars we used so far?
 111 ;;       (setq cpltxt (org-email-link-description))
 112 ;;       (setq link (org-make-link "mairix:m:"
 113 ;;                              (substring message-id 1 -1))))))
 114       (org-make-link "mairix:m:" (substring message-id 1 -1)))))
 115
 116 ;; mairix internals
 117 (defun mairix-result-evaluate (string)
 118   "Display search results of previous mairix process."
 119   (let ((mmatches (string-to-number (substring string 7 -8))))
 120     (if (eq mmatches 0)
 121         (message "Mairix returned no matches, sorry.")
 122       (message "Mairix returned %d matches." mmatches)
 123       (gnus-group-quick-select-group 0 mairix-results-group)
 124       (gnus-summary-reselect-current-group t t))))
 125
 126
 127 (org-add-link-type "mairix"
 128                    'org-mairix-follow-link
 129                    'org-mairix-publish-link)
 130
 131 (add-hook 'org-store-link-functions 'org-mairix-store-link)
 132
 133 (defun mairix-search (string)
 134   "Uses mairix to search through my mail, replacing current search results."
 135   (interactive "MMairix search: ")
 136   (mairix-result-evaluate
 137         (shell-command-to-string (concat "mairix " string))))
 138
 139 (provide 'org-mairix)
 140 (eval-when-compile
 141   (require 'cl))
 142
 143
 144 \f
 145 ;;;;##########################################################################
 146 ;;;;  User Options, Variables
 147 ;;;;##########################################################################
 148
 149
 150
 151
 152
 153 ;;; org-mairix.el ends here