1 Return-Path: <sojkam1@fel.cvut.cz>
\r
2 X-Original-To: notmuch@notmuchmail.org
\r
3 Delivered-To: notmuch@notmuchmail.org
\r
4 Received: from localhost (localhost [127.0.0.1])
\r
5 by olra.theworths.org (Postfix) with ESMTP id 962CA431FB6
\r
6 for <notmuch@notmuchmail.org>; Tue, 29 Jul 2014 09:58:27 -0700 (PDT)
\r
7 X-Virus-Scanned: Debian amavisd-new at olra.theworths.org
\r
11 X-Spam-Status: No, score=-2.3 tagged_above=-999 required=5
\r
12 tests=[RCVD_IN_DNSWL_MED=-2.3] autolearn=disabled
\r
13 Received: from olra.theworths.org ([127.0.0.1])
\r
14 by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)
\r
15 with ESMTP id fVGPxr6qEdKe for <notmuch@notmuchmail.org>;
\r
16 Tue, 29 Jul 2014 09:58:19 -0700 (PDT)
\r
17 Received: from max.feld.cvut.cz (max.feld.cvut.cz [147.32.192.36])
\r
18 by olra.theworths.org (Postfix) with ESMTP id 4231A431FAE
\r
19 for <notmuch@notmuchmail.org>; Tue, 29 Jul 2014 09:58:19 -0700 (PDT)
\r
20 Received: from localhost (unknown [192.168.200.7])
\r
21 by max.feld.cvut.cz (Postfix) with ESMTP id 99CCD3CFEBF;
\r
22 Tue, 29 Jul 2014 18:58:18 +0200 (CEST)
\r
23 X-Virus-Scanned: IMAP STYX AMAVIS
\r
24 Received: from max.feld.cvut.cz ([192.168.200.1])
\r
25 by localhost (styx.feld.cvut.cz [192.168.200.7]) (amavisd-new,
\r
27 with ESMTP id CVB3oBt-YdlU; Tue, 29 Jul 2014 18:58:14 +0200 (CEST)
\r
28 Received: from imap.feld.cvut.cz (imap.feld.cvut.cz [147.32.192.34])
\r
29 by max.feld.cvut.cz (Postfix) with ESMTP id D1F9A3CFE9F;
\r
30 Tue, 29 Jul 2014 18:58:14 +0200 (CEST)
\r
31 Received: from wsh by steelpick.2x.cz with local (Exim 4.82_1-5b7a7c0-XX)
\r
32 (envelope-from <sojkam1@fel.cvut.cz>)
\r
33 id 1XCAj8-0003R5-LU; Tue, 29 Jul 2014 18:58:14 +0200
\r
34 From: Michal Sojka <sojkam1@fel.cvut.cz>
\r
35 To: notmuch@notmuchmail.org
\r
36 Subject: [PATCH RFC] Emacs: Add address completion mechanism implemented in
\r
38 Date: Tue, 29 Jul 2014 18:57:50 +0200
\r
39 Message-Id: <1406653070-13174-1-git-send-email-sojkam1@fel.cvut.cz>
\r
40 X-Mailer: git-send-email 2.0.1
\r
41 In-Reply-To: <87bns8f6hi.fsf@steelpick.2x.cz>
\r
42 References: <87bns8f6hi.fsf@steelpick.2x.cz>
\r
44 X-BeenThere: notmuch@notmuchmail.org
\r
45 X-Mailman-Version: 2.1.13
\r
47 List-Id: "Use and development of the notmuch mail system."
\r
48 <notmuch.notmuchmail.org>
\r
49 List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,
\r
50 <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>
\r
51 List-Archive: <http://notmuchmail.org/pipermail/notmuch>
\r
52 List-Post: <mailto:notmuch@notmuchmail.org>
\r
53 List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>
\r
54 List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,
\r
55 <mailto:notmuch-request@notmuchmail.org?subject=subscribe>
\r
56 X-List-Received-Date: Tue, 29 Jul 2014 16:58:27 -0000
\r
58 Notmuch currently has an address completion mechanism that requires
\r
59 external script to provide completion candidates. This patch adds a
\r
60 completion mechanism found in https://github.com/tjim/nevermore, which
\r
61 is implemented in elisp only.
\r
63 notmuch-lib.el is extended with function notmuch-async-harvest that
\r
64 collects the completion candidates from notmuch database and stores
\r
65 them in notmuch-completion-addresses.
\r
67 notmuch-company.el hooks itself into message-mode and uses
\r
68 company-mode to offer the completion to the user. The file is put into
\r
69 the contrib directory which means that the use has to install it
\r
70 himself. This is because company-mode is not a part of Emacs and
\r
71 bytecompiling notmuch-company.el fails due to used --quick option that
\r
72 causes user installed packages to be ignored. Moreover, Debian
\r
73 bytecompiles elisp files during installation which would require
\r
74 having company-mode packaged for Debian. This would be possible but
\r
75 company-mode requires emacs24 which would complicate notmuch Debian
\r
78 It would probably make sense to implement another completion frontend
\r
79 based only on Emacs built-in functionality and integrate it with
\r
80 notmuch-addresses.el.
\r
82 The original nevermore code was modified in the following ways:
\r
83 1) Prefix was changes from nm- to notmuch-.
\r
84 2) A few docstrings and comments were added.
\r
85 3) notmuch-flatten-* functions were renamed to match match
\r
88 debian/notmuch-emacs.examples | 1 +
\r
89 emacs/contrib/notmuch-company.el | 62 ++++++++++++++++++++++++++++
\r
90 emacs/notmuch-lib.el | 87 ++++++++++++++++++++++++++++++++++++++++
\r
91 3 files changed, 150 insertions(+)
\r
92 create mode 100644 debian/notmuch-emacs.examples
\r
93 create mode 100644 emacs/contrib/notmuch-company.el
\r
95 diff --git a/debian/notmuch-emacs.examples b/debian/notmuch-emacs.examples
\r
96 new file mode 100644
\r
97 index 0000000..4a42a47
\r
99 +++ b/debian/notmuch-emacs.examples
\r
101 +emacs/contrib/notmuch-company.el
\r
102 diff --git a/emacs/contrib/notmuch-company.el b/emacs/contrib/notmuch-company.el
\r
103 new file mode 100644
\r
104 index 0000000..228de94
\r
106 +++ b/emacs/contrib/notmuch-company.el
\r
108 +;; notmuch-company.el --- Mail address completion for notmuch via company-mode
\r
110 +;; Author: Trevor Jim <tjim@mac.com>
\r
111 +;; Keywords: mail, completion
\r
113 +;; This program is free software; you can redistribute it and/or modify
\r
114 +;; it under the terms of the GNU General Public License as published by
\r
115 +;; the Free Software Foundation, either version 3 of the License, or
\r
116 +;; (at your option) any later version.
\r
118 +;; This program is distributed in the hope that it will be useful,
\r
119 +;; but WITHOUT ANY WARRANTY; without even the implied warranty of
\r
120 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\r
121 +;; GNU General Public License for more details.
\r
123 +;; You should have received a copy of the GNU General Public License
\r
124 +;; along with this program. If not, see <http://www.gnu.org/licenses/>.
\r
128 +;; To enable this, install company mode (https://company-mode.github.io/)
\r
131 +;; (require 'notmuch-company)
\r
133 +;; to your .emacs.
\r
135 +;; NB company-minimum-prefix-length defaults to 3 so you don't get
\r
136 +;; completion unless you type 3 characters
\r
141 +(require 'company)
\r
142 +(require 'message)
\r
143 +(require 'notmuch-lib)
\r
145 +(defvar-local notmuch-company-last-prefix nil)
\r
147 +(defun notmuch-company (command &optional arg &rest ignore)
\r
148 + "`company-mode' completion back-end for `nevermore (nm)'."
\r
149 + (interactive (list 'interactive))
\r
150 + (let ((case-fold-search t))
\r
152 + (`interactive (company-begin-backend 'notmuch-company))
\r
153 + (`prefix (and (eq major-mode 'message-mode)
\r
154 + (looking-back "^\\(To\\|Cc\\|Bcc\\):.*"
\r
155 + (line-beginning-position))
\r
156 + (setq notmuch-company-last-prefix (company-grab-symbol))))
\r
157 + (`candidates (let ((results (completion-substring--all-completions arg notmuch-completion-addresses nil 0)))
\r
158 + (when results (car results))))
\r
159 + (`match (if (string-match notmuch-company-last-prefix arg)
\r
164 +(add-hook 'message-mode-hook '(lambda ()
\r
166 + (make-local-variable 'company-backends)
\r
167 + (setq company-backends '(notmuch-company))
\r
168 + (when (not notmuch-completion-addresses) (notmuch-async-harvest))))
\r
169 +(provide 'notmuch-company)
\r
170 diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
\r
171 index 2941da3..c0f4ba0 100644
\r
172 --- a/emacs/notmuch-lib.el
\r
173 +++ b/emacs/notmuch-lib.el
\r
174 @@ -216,6 +216,9 @@ on the command line, and then retry your notmuch command")))
\r
175 "Return the user.other_email value (as a list) from the notmuch configuration."
\r
176 (split-string (notmuch-config-get "user.other_email") "\n" t))
\r
178 +(defun notmuch-user-emails ()
\r
179 + (cons (notmuch-user-primary-email) (notmuch-user-other-email)))
\r
181 (defun notmuch-poll ()
\r
182 "Run \"notmuch new\" or an external script to import mail.
\r
184 @@ -845,6 +848,90 @@ status."
\r
185 (defvar notmuch-show-process-crypto nil)
\r
186 (make-variable-buffer-local 'notmuch-show-process-crypto)
\r
188 +(defun notmuch-flatten-thread-set (thread-set)
\r
189 + "Convert the result of 'notmuch show' to the plain list of messages."
\r
190 +;; (display-message-or-buffer (format "Before: %S" thread-set))
\r
193 + (mapcar 'notmuch-flatten-thread thread-set))))
\r
194 +;; (display-message-or-buffer (format "After: %S" result))
\r
197 +(defun notmuch-flatten-thread (thread)
\r
199 + (mapcar 'notmuch-flatten-thread-node thread)))
\r
201 +(defun notmuch-flatten-thread-node (thread-node)
\r
202 + (let ((msg (car thread-node))
\r
203 + (replies (cadr thread-node)))
\r
205 + (cons msg (notmuch-flatten-thread replies))
\r
206 + (notmuch-flatten-thread replies))))
\r
208 +;;; async address harvesting
\r
209 +(defvar notmuch-completion-addresses nil
\r
210 + "Hash of email addresses for completion during email composition.
\r
211 + This variable is set by `notmuch-async-harvest'.")
\r
213 +(defvar notmuch-async-harvest-pending-proc nil) ; the process of a harvest underway
\r
214 +(defvar notmuch-async-harvest-pending-output nil) ; holds the not-yet-processed part of the output of the harvest process
\r
215 +(defun notmuch-async-harvest ()
\r
216 + "Collect possible addresses for completion. It queries the
\r
217 +notmuch database for all emails sent by the user and collects the
\r
218 +destination addresses from them in
\r
219 +`notmuch-completion-addresses'. This takes some time so the
\r
220 +address collection runs asynchronously."
\r
221 + (when notmuch-async-harvest-pending-proc
\r
222 + (ignore-errors (kill-process notmuch-async-harvest-pending-proc))
\r
223 + ; kill-process sends signal, actual process death is asynchronous, so indicate that we want the process dead
\r
224 + (setq notmuch-async-harvest-pending-proc nil))
\r
225 + (setq notmuch-completion-addresses (make-hash-table :test 'equal))
\r
226 + (setq notmuch-async-harvest-pending-output nil) ; indicate that we have not gotten any output yet
\r
227 + (setq notmuch-async-harvest-pending-proc
\r
228 + (notmuch-start-notmuch
\r
229 + "notmuch-async-harvest" ; process name
\r
230 + nil ; process buffer
\r
231 + nil ; process sentinel
\r
232 + "show" ; notmuch command
\r
234 + "--format-version=2"
\r
236 + "--entire-thread=false"
\r
237 + (mapconcat (lambda (x) (concat "from:" x)) (notmuch-user-emails) " or ")
\r
239 + (set-process-filter
\r
240 + notmuch-async-harvest-pending-proc
\r
241 + (lambda (proc string)
\r
242 + (when (and notmuch-async-harvest-pending-proc (equal (process-id proc) (process-id notmuch-async-harvest-pending-proc)))
\r
243 + (if notmuch-async-harvest-pending-output
\r
244 + ; This is not the first time we have seen output, add it to anything remaining from last time
\r
245 + (setq notmuch-async-harvest-pending-output (concat notmuch-async-harvest-pending-output string))
\r
246 + ; This is the first time we have seen output. Skip the initial open paren
\r
247 + (setq notmuch-async-harvest-pending-output (substring string 1)))
\r
249 + (let ((result (ignore-errors (read-from-string notmuch-async-harvest-pending-output))))
\r
251 + (let ((obj (car result))
\r
252 + (offset (cdr result)))
\r
253 + (setq notmuch-async-harvest-pending-output (substring notmuch-async-harvest-pending-output offset))
\r
254 + (let ((msgs (notmuch-flatten-thread-set (list obj))))
\r
257 + (let* ((headers (plist-get msg :headers))
\r
258 + (to (ignore-errors (mail-extract-address-components (plist-get headers :To) t)))
\r
259 + (cc (ignore-errors (mail-extract-address-components (plist-get headers :Cc) t)))
\r
260 + (bcc (ignore-errors (mail-extract-address-components (plist-get headers :Bcc) t))))
\r
261 + (mapc (lambda (parts)
\r
262 + (let* ((name (car parts))
\r
263 + (email (cadr parts))
\r
264 + (entry (if name (format "%s <%s>" name email) email)))
\r
265 + (puthash entry t notmuch-completion-addresses)))
\r
266 + (append to cc bcc))))
\r
272 (provide 'notmuch-lib)
\r
274 ;; Local Variables:
\r
projects / notmuch-archives.git / blob