From 7697fa4daf3ec84f85711a84035d8f0224afd4e3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Delafond?= Date: Sun, 13 Jul 2014 13:35:01 +0200 Subject: Imported Upstream version 7.9.2 --- contrib/lisp/org-mairix.el | 332 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 332 insertions(+) create mode 100644 contrib/lisp/org-mairix.el (limited to 'contrib/lisp/org-mairix.el') diff --git a/contrib/lisp/org-mairix.el b/contrib/lisp/org-mairix.el new file mode 100644 index 0000000..367a866 --- /dev/null +++ b/contrib/lisp/org-mairix.el @@ -0,0 +1,332 @@ +;;; org-mairix.el - Support for hooking mairix search into Org for different MUAs +;; +;; Copyright (C) 2007-2012 Georg C. F. Greve +;; mutt support by Adam Spiers +;; +;; Author: Georg C. F. Greve +;; Keywords: outlines, hypermedia, calendar, wp, email, mairix +;; Purpose: Integrate mairix email searching into Org mode +;; See http://orgmode.org and http://www.rpcurnow.force9.co.uk/mairix/ +;; Version: 0.5 +;; +;; This file 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, or (at your option) +;; any later version. + +;; It 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; USAGE NOTE +;; +;; You will need to configure mairix first, which involves setting up your +;; .mairixrc in your home directory. Once it is working, you should set up +;; your way to display results in your favorite way -- usually a MUA. +;; Currently gnus and mutt are supported. +;; +;; After both steps are done, all you should need to hook mairix, org +;; and your MUA together is to do (require 'org-mairix) in your +;; startup file. Everything can then be configured normally through +;; Emacs customisation. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(require 'org) + +;;; The custom variables + +(defgroup org-mairix nil + "Mairix support/integration in org." + :tag "Org Mairix" + :group 'org) + +(defcustom org-mairix-threaded-links t + "Should new links be created as threaded links? +If t, links will be stored as threaded searches. +If nil, links will be stored as non-threaded searches." + :group 'org-mairix + :type 'boolean) + +(defcustom org-mairix-augmented-links nil + "Should new links be created as augmenting searches? +If t, links will be stored as augmenting searches. +If nil, links will be stored as normal searches. + +Attention: When activating this option, you will need +to remove old articles from your mairix results group +in some other way, mairix will not do it for you." + :group 'org-mairix + :type 'boolean) + +(defcustom org-mairix-display-hook 'org-mairix-gnus-display-results + "Hook to call to display the results of a successful mairix search. +Defaults to Gnus, feel free to add your own MUAs or methods." + :group 'org-mairix + :type 'hook) + +(defcustom org-mairix-open-command "mairix %args% '%search%'" + "The mairix command-line to use. If your paths are set up +correctly, you should not need to change this. + +'%search%' will get substituted with the search expression, and +'%args%' with any additional arguments." + :group 'org-mairix + :type 'string) + +;;; The hooks to integrate mairix into org + +(org-add-link-type "mairix" 'org-mairix-open) +(add-hook 'org-store-link-functions 'org-mairix-store-gnus-link) + +;;; Generic org-mairix functions + +(defun org-mairix-construct-link (message-id) + "Construct a mairix: hyperlink based on message-id." + (concat "mairix:" + (if org-mairix-threaded-links "t:") + (if org-mairix-augmented-links "a:") + "@@" + (org-remove-angle-brackets message-id))) + +(defun org-store-mairix-link-props (&rest plist) + "Take a property list describing a mail, and add mairix link +and description properties so that org can build a mairix link to +it." + ;; We have to call `org-store-link-props' twice: + ;; + ;; - It extracts 'fromname'/'fromaddress' from 'from' property, + ;; and stores the updated plist to `org-store-link-plist'. + ;; + ;; - `org-email-link-description' uses these new properties to + ;; build a description from the previously stored plist. I + ;; wrote a tiny patch to `org-email-link-description' so it + ;; could take a non-stored plist as an optional 2nd argument, + ;; but the plist provided still needs 'fromname'/'fromaddress'. + ;; + ;; - Ideally we would decouple the storing bit of + ;; `org-store-link-props' from the extraction bit, but lots of + ;; stuff in `org-store-link' which calls it would need to be + ;; changed. Maybe just factor out the extraction so it can be + ;; reused separately? + (let ((mid (plist-get plist :message-id))) + (apply 'org-store-link-props + (append plist + (list :type "mairix" + :link (org-mairix-construct-link mid)))) + (apply 'org-store-link-props + (append org-store-link-plist + (list :description (org-email-link-description)))))) + +(defun org-mairix-message-send-and-exit-with-link () + "Function that can be assigned as an alternative sending function, +it sends the message and then stores a mairix link to it before burying +the buffer just like 'message-send-and-exit' does." + (interactive) + (message-send) + (let* ((message-id (message-fetch-field "Message-Id")) + (subject (message-fetch-field "Subject")) + (link (org-mairix-construct-link message-id)) + (desc (concat "Email: '" subject "'"))) + (setq org-stored-links + (cons (list link desc) org-stored-links))) + (message-bury (current-buffer))) + +(defun org-mairix-open (search) + "Function to open mairix link. + +We first need to split it into its individual parts, and then +extract the message-id to be passed on to the display function +before call mairix, evaluate the number of matches returned, and +make sure to only call display of mairix succeeded in matching." + (let* ((args "")) + (if (equal (substring search 0 2) "t:" ) + (progn (setq search (substring search 2 nil)) + (setq args (concat args " --threads")))) + (if (equal (substring search 0 2) "a:") + (progn (setq search (substring search 2 nil)) + (setq args (concat args " --augment")))) + (let ((cmdline (org-mairix-command-substitution + org-mairix-open-command search args))) + (print cmdline) + (setq retval (shell-command-to-string cmdline)) + (string-match "\[0-9\]+" retval) + (setq matches (string-to-number (match-string 0 retval))) + (if (eq matches 0) (message "Link failed: no matches, sorry") + (message "Link returned %d matches" matches) + (run-hook-with-args 'org-mairix-display-hook search args))))) + +(defun org-mairix-command-substitution (cmd search args) + "Substitute '%search%' and '%args% in mairix search command." + (while (string-match "%search%" cmd) + (setq cmd (replace-match search 'fixedcase 'literal cmd))) + (while (string-match "%args%" cmd) + (setq cmd (replace-match args 'fixedcase 'literal cmd))) + cmd) + +;;; Functions necessary for integration of external MUAs. + +;; Of course we cannot call `org-store-link' from within an external +;; MUA, so we need some other way of storing a link for later +;; retrieval by org-mode and/or remember-mode. To do this we use a +;; temporary file as a kind of dedicated clipboard. + +(defcustom org-mairix-link-clipboard "~/.org-mairix-link" + "Pseudo-clipboard file where mairix URLs get copied to by external +applications in order to mimic `org-store-link'. Used by +`org-mairix-insert-link'." + :group 'org-mairix + :type 'string) + +;; When we resolve some of the issues with `org-store-link' detailed +;; at , +;; we might not need org-mairix-insert-link. + +(defun org-mairix-insert-link () + "Insert link from file defined by `org-mairix-link-clipboard'." + (interactive) + (let ((bytes (cadr (insert-file-contents + (expand-file-name org-mairix-link-clipboard))))) + (forward-char bytes) + (save-excursion + (forward-char -1) + (if (looking-at "\n") + (delete-char 1))))) + +;;; Functions necessary for mutt integration + +(defgroup org-mairix-mutt nil + "Use mutt for mairix support in org." + :tag "Org Mairix Mutt" + :group 'org-mairix) + +(defcustom org-mairix-mutt-display-command + "xterm -title 'mairix search: %search%' -e 'unset COLUMNS; mutt -f +~/mail/mairix -e \"push \"' &" + "Command to execute to display mairix search results via mutt within +an xterm. + +'%search%' will get substituted with the search expression, and +'%args%' with any additional arguments used in the search." + :group 'org-mairix-mutt + :type 'string) + +(defun org-mairix-mutt-display-results (search args) + "Display results of mairix search in mutt, using the command line +defined in `org-mairix-mutt-display-command'." + ;; By default, async `shell-command' invocations display the temp + ;; buffer, which is annoying here. We choose a deterministic + ;; buffer name so we can hide it again immediately. + ;; Note: `call-process' is synchronous so not useful here. + (let ((cmd (org-mairix-command-substitution + org-mairix-mutt-display-command search args)) + (tmpbufname (generate-new-buffer-name " *mairix-view*"))) + (shell-command cmd tmpbufname) + (delete-windows-on (get-buffer tmpbufname)))) + +;;; Functions necessary for gnus integration + +(defgroup org-mairix-gnus nil + "Use gnus for mairix support in org." + :tag "Org Mairix Gnus" + :group 'org-mairix) + +(defcustom org-mairix-gnus-results-group "nnmaildir:mairix" + "The group that is configured to hold the mairix search results, +which needs to be setup independently of the org-mairix integration, +along with general mairix configuration." + :group 'org-mairix-gnus + :type 'string) + +(defcustom org-mairix-gnus-select-display-group-function +'org-mairix-gnus-select-display-group-function-gg + "Hook to call to select the group that contains the matching articles. +We should not need this, it is owed to a problem of gnus that people were +not yet able to figure out, see + http://article.gmane.org/gmane.emacs.gnus.general/65248 + http://article.gmane.org/gmane.emacs.gnus.general/65265 + http://article.gmane.org/gmane.emacs.gnus.user/9596 +for reference. + +It seems gnus needs a 'forget/ignore everything you think you +know about that group' function. Volunteers?" + :group 'org-mairix-gnus + :type 'hook) + +(defun org-mairix-store-gnus-link () + "Store a link to the current gnus message as a Mairix search for its +Message ID." + + ;; gnus integration + (when (memq major-mode '(gnus-summary-mode gnus-article-mode)) + (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) + (let* ((article (gnus-summary-article-number)) + (header (gnus-summary-article-header article)) + (from (mail-header-from header)) + (message-id (mail-header-id header)) + (subject (gnus-summary-subject-string))) + (org-store-mairix-link-props :from from + :subject subject + :message-id message-id)))) + +(defun org-mairix-gnus-display-results (search args) + "Display results of mairix search in Gnus. + +Note: This does not work as cleanly as I would like it to. The +problem being that Gnus should simply reread the group cleanly, +without remembering anything. At the moment it seems to be unable +to do that -- so you're likely to see zombies floating around. + +If you can improve this, please do!" + (if (not (equal (substring search 0 2) "m:" )) + (error "org-mairix-gnus-display-results: display of search other than +message-id not implemented yet")) + (setq message-id (substring search 2 nil)) + (require 'gnus) + (require 'gnus-sum) + ;; FIXME: (bzg/gg) We might need to make sure gnus is running here, + ;; and to start it in case it isn't running already. Does + ;; anyone know a function to do that? It seems main org mode + ;; does not do this, either. + (funcall (cdr (assq 'gnus org-link-frame-setup))) + (if gnus-other-frame-object (select-frame gnus-other-frame-object)) + + ;; FIXME: This is horribly broken. Please see + ;; http://article.gmane.org/gmane.emacs.gnus.general/65248 + ;; http://article.gmane.org/gmane.emacs.gnus.general/65265 + ;; http://article.gmane.org/gmane.emacs.gnus.user/9596 + ;; for reference. + ;; + ;; It seems gnus needs a "forget/ignore everything you think you + ;; know about that group" function. Volunteers? + ;; + ;; For now different methods seem to work differently well for + ;; different people. So we're playing hook-selection here to make + ;; it easy to play around until we found a proper solution. + (run-hook-with-args 'org-mairix-gnus-select-display-group-function) + (gnus-summary-select-article + nil t t (car (gnus-find-matching-articles "message-id" message-id)))) + +(defun org-mairix-gnus-select-display-group-function-gg () + "Georg's hack to select a group that gnus (falsely) believes to be +empty to then call rebuilding of the summary. It leaves zombies of +old searches around, though." + (gnus-group-quick-select-group 0 org-mairix-gnus-results-group) + (gnus-group-clear-data) + (gnus-summary-reselect-current-group t t)) + +(defun org-mairix-gnus-select-display-group-function-bzg () + "This is the classic way the org mode is using, and it seems to be +using better for Bastien, so it may work for you." + (gnus-group-clear-data org-mairix-gnus-results-group) + (gnus-group-read-group t nil org-mairix-gnus-results-group)) + +(provide 'org-mairix) + +;;; org-mairix.el ends here -- cgit v1.2.3