1 ;; notmuch-lib.el --- common variables, functions and function declarations
3 ;; Copyright © Carl Worth
5 ;; This file is part of Notmuch.
7 ;; Notmuch is free software: you can redistribute it and/or modify it
8 ;; under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; Notmuch is distributed in the hope that it will be useful, but
13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with Notmuch. If not, see <http://www.gnu.org/licenses/>.
20 ;; Authors: Carl Worth <cworth@cworth.org>
22 ;; This is an part of an emacs-based interface to the notmuch mail system.
26 (eval-when-compile (require 'cl))
28 (defvar notmuch-command "notmuch"
29 "Command to run the notmuch binary.")
32 "Notmuch mail reader for Emacs."
35 (defgroup notmuch-hello nil
36 "Overview of saved searches, tags, etc."
39 (defgroup notmuch-search nil
40 "Searching and sorting mail."
43 (defgroup notmuch-show nil
44 "Showing messages and threads."
47 (defgroup notmuch-send nil
48 "Sending messages from Notmuch."
51 (custom-add-to-group 'notmuch-send 'message 'custom-group)
53 (defgroup notmuch-crypto nil
54 "Processing and display of cryptographic MIME parts."
57 (defgroup notmuch-hooks nil
58 "Running custom code on well-defined occasions."
61 (defgroup notmuch-external nil
62 "Running external commands from within Notmuch."
65 (defgroup notmuch-faces nil
66 "Graphical attributes for displaying text"
69 (defcustom notmuch-search-oldest-first t
70 "Show the oldest mail first when searching."
72 :group 'notmuch-search)
76 (defvar notmuch-search-history nil
77 "Variable to store notmuch searches history.")
79 (defcustom notmuch-saved-searches nil
80 "A list of saved searches to display."
81 :type '(alist :key-type string :value-type string)
82 :group 'notmuch-hello)
84 (defvar notmuch-folders nil
85 "Deprecated name for what is now known as `notmuch-saved-searches'.")
87 (defun notmuch-saved-searches ()
88 "Common function for querying the notmuch-saved-searches variable.
90 We do this as a function to support the old name of the
91 variable (`notmuch-folders') as well as for the default value if
92 the user hasn't set this variable with the old or new value."
93 (if notmuch-saved-searches
94 notmuch-saved-searches
97 '(("inbox" . "tag:inbox")
98 ("unread" . "tag:unread")))))
100 (defun notmuch-version ()
101 "Return a string with the notmuch version number."
103 ;; Trim off the trailing newline.
104 (substring (shell-command-to-string
105 (concat notmuch-command " --version"))
107 (if (string-match "^notmuch\\( version\\)? \\(.*\\)$"
109 (match-string 2 long-string)
112 (defun notmuch-config-get (item)
113 "Return a value from the notmuch configuration."
114 ;; Trim off the trailing newline
115 (substring (shell-command-to-string
116 (concat notmuch-command " config get " item))
119 (defun notmuch-database-path ()
120 "Return the database.path value from the notmuch configuration."
121 (notmuch-config-get "database.path"))
123 (defun notmuch-user-name ()
124 "Return the user.name value from the notmuch configuration."
125 (notmuch-config-get "user.name"))
127 (defun notmuch-user-primary-email ()
128 "Return the user.primary_email value from the notmuch configuration."
129 (notmuch-config-get "user.primary_email"))
131 (defun notmuch-user-other-email ()
132 "Return the user.other_email value (as a list) from the notmuch configuration."
133 (split-string (notmuch-config-get "user.other_email") "\n"))
135 (defun notmuch-kill-this-buffer ()
136 "Kill the current buffer."
138 (kill-buffer (current-buffer)))
140 (defun notmuch-prettify-subject (subject)
141 ;; This function is used by `notmuch-search-process-filter' which
142 ;; requires that we not disrupt its' matching state.
145 (string-match "^[ \t]*$" subject))
149 (defun notmuch-id-to-query (id)
150 "Return a query that matches the message with id ID."
151 (concat "id:\"" (replace-regexp-in-string "\"" "\"\"" id t t) "\""))
155 (defun notmuch-common-do-stash (text)
156 "Common function to stash text in kill ring, and display in minibuffer."
158 (message "Stashed: %s" text))
162 (defun notmuch-remove-if-not (predicate list)
163 "Return a copy of LIST with all items not satisfying PREDICATE removed."
166 (when (funcall predicate (car list))
167 (push (car list) out))
168 (setq list (cdr list)))
171 ;; This lets us avoid compiling these replacement functions when emacs
172 ;; is sufficiently new enough to supply them alone. We do the macro
173 ;; treatment rather than just wrapping our defun calls in a when form
174 ;; specifically so that the compiler never sees the code on new emacs,
175 ;; (since the code is triggering warnings that we don't know how to get
178 ;; A more clever macro here would accept a condition and a list of forms.
179 (defmacro compile-on-emacs-prior-to-23 (form)
180 "Conditionally evaluate form only on emacs < emacs-23."
181 (list 'when (< emacs-major-version 23)
184 (defun notmuch-split-content-type (content-type)
185 "Split content/type into 'content' and 'type'"
186 (split-string content-type "/"))
188 (defun notmuch-match-content-type (t1 t2)
189 "Return t if t1 and t2 are matching content types, taking wildcards into account"
190 (let ((st1 (notmuch-split-content-type t1))
191 (st2 (notmuch-split-content-type t2)))
192 (if (or (string= (cadr st1) "*")
193 (string= (cadr st2) "*"))
194 ;; Comparison of content types should be case insensitive.
195 (string= (downcase (car st1)) (downcase (car st2)))
196 (string= (downcase t1) (downcase t2)))))
198 (defvar notmuch-multipart/alternative-discouraged
202 ;; multipart/related usually contain a text/html part and some associated graphics.
206 (defun notmuch-multipart/alternative-choose (types)
207 "Return a list of preferred types from the given list of types"
208 ;; Based on `mm-preferred-alternative-precedence'.
210 (dolist (pref (reverse notmuch-multipart/alternative-discouraged))
211 (dolist (elem (copy-sequence seq))
212 (when (string-match pref elem)
213 (setq seq (nconc (delete elem seq) (list elem))))))
216 (defun notmuch-parts-filter-by-type (parts type)
217 "Given a list of message parts, return a list containing the ones matching
220 (lambda (part) (notmuch-match-content-type (plist-get part :content-type) type))
223 ;; Helper for parts which are generally not included in the default
225 (defun notmuch-get-bodypart-internal (query part-number process-crypto)
226 (let ((args '("show" "--format=raw"))
227 (part-arg (format "--part=%s" part-number)))
228 (setq args (append args (list part-arg)))
230 (setq args (append args '("--decrypt"))))
231 (setq args (append args (list query)))
233 (let ((coding-system-for-read 'no-conversion))
235 (apply 'call-process (append (list notmuch-command nil (list t nil) nil) args))
238 (defun notmuch-get-bodypart-content (msg part nth process-crypto)
239 (or (plist-get part :content)
240 (notmuch-get-bodypart-internal (notmuch-id-to-query (plist-get msg :id)) nth process-crypto)))
242 (defun notmuch-mm-display-part-inline (msg part nth content-type process-crypto)
243 "Use the mm-decode/mm-view functions to display a part in the
244 current buffer, if possible."
245 (let ((display-buffer (current-buffer)))
247 ;; In case there is :content, the content string is already converted
248 ;; into emacs internal format. `gnus-decoded' is a fake charset,
249 ;; which means no further decoding (to be done by mm- functions).
250 (let* ((charset (if (plist-member part :content)
252 (plist-get part :content-charset)))
253 (handle (mm-make-handle (current-buffer) `(,content-type (charset . ,charset)))))
254 ;; If the user wants the part inlined, insert the content and
255 ;; test whether we are able to inline it (which includes both
256 ;; capability and suitability tests).
257 (when (mm-inlined-p handle)
258 (insert (notmuch-get-bodypart-content msg part nth process-crypto))
259 (when (mm-inlinable-p handle)
260 (set-buffer display-buffer)
261 (mm-display-part handle)
264 ;; Converts a plist of headers to an alist of headers. The input plist should
265 ;; have symbols of the form :Header as keys, and the resulting alist will have
266 ;; symbols of the form 'Header as keys.
267 (defun notmuch-headers-plist-to-alist (plist)
268 (loop for (key value . rest) on plist by #'cddr
269 collect (cons (intern (substring (symbol-name key) 1)) value)))
271 ;; Compatibility functions for versions of emacs before emacs 23.
273 ;; Both functions here were copied from emacs 23 with the following copyright:
275 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
276 ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
278 ;; and under the GPL version 3 (or later) exactly as notmuch itself.
279 (compile-on-emacs-prior-to-23
280 (defun apply-partially (fun &rest args)
281 "Return a function that is a partial application of FUN to ARGS.
282 ARGS is a list of the first N arguments to pass to FUN.
283 The result is a new function which does the same as FUN, except that
284 the first N arguments are fixed at the values with which this function
286 (lexical-let ((fun fun) (args1 args))
287 (lambda (&rest args2) (apply fun (append args1 args2))))))
289 (compile-on-emacs-prior-to-23
290 (defun mouse-event-p (object)
291 "Return non-nil if OBJECT is a mouse click event."
292 (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement))))
294 ;; This variable is used only buffer local, but it needs to be
295 ;; declared globally first to avoid compiler warnings.
296 (defvar notmuch-show-process-crypto nil)
297 (make-variable-buffer-local 'notmuch-show-process-crypto)
299 (provide 'notmuch-lib)
302 ;; byte-compile-warnings: (not cl-functions)