Merge tag '0.31.4'
authorDavid Bremner <david@tethera.net>
Thu, 18 Feb 2021 12:47:53 +0000 (08:47 -0400)
committerDavid Bremner <david@tethera.net>
Thu, 18 Feb 2021 12:47:53 +0000 (08:47 -0400)
notmuch 0.31.4 release

76 files changed:
bindings/python-cffi/notmuch2/_build.py
bindings/python-cffi/notmuch2/_errors.py
bindings/python-cffi/tests/test_database.py
bindings/python/setup.py
devel/nmbug/notmuch-report
doc/doxygen.cfg
doc/man1/notmuch-config.rst
doc/man5/notmuch-hooks.rst
emacs/coolj.el
emacs/make-deps.el
emacs/notmuch-address.el
emacs/notmuch-company.el
emacs/notmuch-compat.el
emacs/notmuch-crypto.el
emacs/notmuch-draft.el
emacs/notmuch-hello.el
emacs/notmuch-jump.el
emacs/notmuch-lib.el
emacs/notmuch-maildir-fcc.el
emacs/notmuch-message.el
emacs/notmuch-mua.el
emacs/notmuch-parser.el
emacs/notmuch-print.el
emacs/notmuch-query.el
emacs/notmuch-show.el
emacs/notmuch-tag.el
emacs/notmuch-tree.el
emacs/notmuch-wash.el
emacs/notmuch.el
emacs/rstdoc.el
hooks.c
lib/Makefile.local
lib/config.cc
lib/database-private.h
lib/database.cc
lib/features.cc [new file with mode: 0644]
lib/notmuch-private.h
lib/notmuch.h
lib/open.cc [new file with mode: 0644]
lib/prefix.cc [new file with mode: 0644]
lib/string-map.c
notmuch-client.h
notmuch-compact.c
notmuch-config.c
notmuch-count.c
notmuch-dump.c
notmuch-insert.c
notmuch-new.c
notmuch-reindex.c
notmuch-reply.c
notmuch-restore.c
notmuch-search.c
notmuch-setup.c
notmuch-show.c
notmuch-tag.c
notmuch.c
test/README
test/T035-read-config.sh [new file with mode: 0755]
test/T040-setup.sh
test/T050-new.sh
test/T070-insert.sh
test/T140-excludes.sh
test/T240-dump-restore.sh
test/T391-python-cffi.sh
test/T400-hooks.sh
test/T530-upgrade.sh [new file with mode: 0755]
test/T560-lib-error.sh
test/T562-lib-database.sh
test/T590-libconfig.sh
test/T750-gzip.sh
test/T750-user-header.sh
test/json_check_nodes.py
test/test-lib.el
test/test-lib.sh
util/string-util.c
util/string-util.h

index f269f2a195b501437cbc70e932dea48fe1f5e5fa..f67b4de61001946f66f633ac1c91b2facd733ba7 100644 (file)
@@ -47,6 +47,11 @@ ffibuilder.cdef(
         NOTMUCH_STATUS_UPGRADE_REQUIRED,
         NOTMUCH_STATUS_PATH_ERROR,
         NOTMUCH_STATUS_ILLEGAL_ARGUMENT,
+        NOTMUCH_STATUS_MALFORMED_CRYPTO_PROTOCOL,
+        NOTMUCH_STATUS_FAILED_CRYPTO_CONTEXT_CREATION,
+        NOTMUCH_STATUS_UNKNOWN_CRYPTO_PROTOCOL,
+        NOTMUCH_STATUS_NO_CONFIG,
+        NOTMUCH_STATUS_DATABASE_EXISTS,
         NOTMUCH_STATUS_LAST_STATUS
     } notmuch_status_t;
     typedef enum {
index 13369445ffabd0b309f0a7a731335bf8b531a5ca..65064d4eda470cf8f90a25bf38f0c75bf53ac62f 100644 (file)
@@ -50,6 +50,10 @@ class NotmuchError(Exception):
                 PathError,
             capi.lib.NOTMUCH_STATUS_ILLEGAL_ARGUMENT:
                 IllegalArgumentError,
+            capi.lib.NOTMUCH_STATUS_NO_CONFIG:
+                NoConfigError,
+            capi.lib.NOTMUCH_STATUS_DATABASE_EXISTS:
+                DatabaseExistsError,
         }
         return types[status]
 
@@ -94,7 +98,8 @@ class UnsupportedOperationError(NotmuchError): pass
 class UpgradeRequiredError(NotmuchError): pass
 class PathError(NotmuchError): pass
 class IllegalArgumentError(NotmuchError): pass
-
+class NoConfigError(NotmuchError): pass
+class DatabaseExistsError(NotmuchError): pass
 
 class ObjectDestroyedError(NotmuchError):
     """The object has already been destroyed and it's memory freed.
index a2c69de61366f91aebebe5e6f9fc4f9255e918c0..9b3219c00e634a9e4d91fa6d3c7c329dd8e59aa2 100644 (file)
@@ -80,7 +80,7 @@ class TestCreate:
             db.create(tmppath)
 
     def test_create_existing(self, tmppath, db):
-        with pytest.raises(errors.FileError):
+        with pytest.raises(errors.DatabaseExistsError):
             dbmod.Database.create(path=tmppath)
 
     def test_close(self, db):
index d986f0c6651ee14ef9b4607b7668b82acde7fbdc..6308b9f933e8c9733025b79255c6151c1cc29e37 100644 (file)
@@ -1,4 +1,4 @@
-#!/usr/bin/env python
+#!/usr/bin/env python3
 
 """
 This file is part of notmuch.
index 18a0bc70c6aaebe0abe97ad04a9692ee0d846b0d..9a6a31cc6a1ba07f9d7b10567dfcf5a558d70670 100755 (executable)
@@ -370,9 +370,11 @@ header_template = config['meta'].get('header', '''<!DOCTYPE html>
       border-bottom-right-radius: {border_radius};
     }}
     tbody:nth-child(4n+1) tr td {{
+      color: #000;
       background-color: #ffd96e;
     }}
     tbody:nth-child(4n+3) tr td {{
+      color: #000;
       background-color: #bce;
     }}
     hr {{
index a2c4fd07400c9e0bdbfd885062c0531ee649dbd0..4a022de1ce9ea1fa6c3c09280c8f83289c81147a 100644 (file)
@@ -27,7 +27,6 @@ INHERIT_DOCS           = YES
 SEPARATE_MEMBER_PAGES  = NO
 TAB_SIZE               = 8
 ALIASES                =
-TCL_SUBST              =
 OPTIMIZE_OUTPUT_FOR_C  = YES
 OPTIMIZE_OUTPUT_JAVA   = NO
 OPTIMIZE_FOR_FORTRAN   = NO
index 769f336a33afac4dfeb54ec259940257777e7f71..bc597957f7bb93d5f2521303470fccc8b84a90df 100644 (file)
@@ -17,10 +17,6 @@ DESCRIPTION
 The **config** command can be used to get or set settings in the notmuch
 configuration file and corresponding database.
 
-Items marked **[STORED IN DATABASE]** are only in the database.  They
-should not be placed in the configuration file, and should be accessed
-programmatically as described in the SYNOPSIS above.
-
 **get**
     The value of the specified configuration item is printed to
     stdout. If the item has multiple values (it is a list), each value
@@ -54,6 +50,11 @@ The available configuration items are described below.
 
     Default: ``$MAILDIR`` variable if set, otherwise ``$HOME/mail``.
 
+**database.hook_dir**
+
+    Directory containing hooks run by notmuch commands. See
+    **notmuch-hooks(5)**.
+
 **user.name**
     Your full name.
 
@@ -134,7 +135,7 @@ The available configuration items are described below.
 
     Default: ``true``.
 
-**index.decrypt** **[STORED IN DATABASE]**
+**index.decrypt**
     Policy for decrypting encrypted messages during indexing.  Must be
     one of: ``false``, ``auto``, ``nostash``, or ``true``.
 
@@ -187,7 +188,7 @@ The available configuration items are described below.
 
     Default: ``auto``.
 
-**index.header.<prefix>** **[STORED IN DATABASE]**
+**index.header.<prefix>**
     Define the query prefix <prefix>, based on a mail header. For
     example ``index.header.List=List-Id`` will add a probabilistic
     prefix ``List:`` that searches the ``List-Id`` field.  User
@@ -202,7 +203,7 @@ The available configuration items are described below.
     (since notmuch 0.30, "compact" and "field_processor" are
     always included.)
 
-**query.<name>** **[STORED IN DATABASE]**
+**query.<name>**
     Expansion for named query called <name>. See
     **notmuch-search-terms(7)** for more information about named
     queries.
@@ -214,8 +215,32 @@ The following environment variables can be used to control the behavior
 of notmuch.
 
 **NOTMUCH\_CONFIG**
-    Specifies the location of the notmuch configuration file. Notmuch
-    will use ${HOME}/.notmuch-config if this variable is not set.
+    Specifies the location of the notmuch configuration file.
+
+**NOTMUCH_PROFILE**
+    Selects among notmuch configurations.
+
+FILES
+=====
+
+CONFIGURATION
+-------------
+
+If ``NOTMUCH_CONFIG`` is unset, notmuch tries (in order)
+
+- ``$XDG_CONFIG_HOME/notmuch/<profile>/config`` where ``<profile>`` is
+  defined by ``$NOTMUCH_PROFILE`` or "default"
+- ``${HOME}/.notmuch-config<profile>`` where ``<profile>`` is
+  ``.$NOTMUCH_PROFILE`` or ""
+
+Hooks
+-----
+
+If ``database.hook_dir`` is unset, notmuch tries (in order)
+
+- ``$XDG_CONFIG_HOME/notmuch/<profile>/hooks`` where ``<profile>`` is
+  defined by ``$NOTMUCH_PROFILE`` or "default"
+- ``<database.path>/.notmuch/hooks``
 
 SEE ALSO
 ========
index de2ed0c2358809746a6fcf8e73c7569ee0f00e01..c509afb39bb5944c72763769bb582ca89c183c9e 100644 (file)
@@ -5,15 +5,15 @@ notmuch-hooks
 SYNOPSIS
 ========
 
-$DATABASEDIR/.notmuch/hooks/*
+<hook_dir>/{pre-new, post-new, post-insert}
 
 DESCRIPTION
 ===========
 
 Hooks are scripts (or arbitrary executables or symlinks to such) that
 notmuch invokes before and after certain actions. These scripts reside
-in the .notmuch/hooks directory within the database directory and must
-have executable permissions.
+in a directory defined as described in **notmuch-config(1)**. They
+must have executable permissions.
 
 The currently available hooks are described below.
 
index 39a8de2bcd2dfb18bcb3426f39e361a9e0eba8be..d820525b3f0240a3afe0e41a5faa82b85cd16cd2 100644 (file)
@@ -1,4 +1,4 @@
-;;; coolj.el --- automatically wrap long lines  -*- coding:utf-8 -*-
+;;; coolj.el --- automatically wrap long lines  -*- lexical-binding: t; coding: utf-8 -*-
 
 ;; Copyright (C) 2000, 2001, 2004-2009 Free Software Foundation, Inc.
 
 
 ;;; Commentary:
 
-;;; This is a simple derivative of some functionality from
-;;; `longlines.el'. The key difference is that this version will
-;;; insert a prefix at the head of each wrapped line. The prefix is
-;;; calculated from the originating long line.
+;; This is a simple derivative of some functionality from
+;; `longlines.el'. The key difference is that this version will
+;; insert a prefix at the head of each wrapped line. The prefix is
+;; calculated from the originating long line.
 
-;;; No minor-mode is provided, the caller is expected to call
-;;; `coolj-wrap-region' to wrap the region of interest.
+;; No minor-mode is provided, the caller is expected to call
+;; `coolj-wrap-region' to wrap the region of interest.
 
 ;;; Code:
 
@@ -50,9 +50,7 @@ Otherwise respect `fill-column'."
   :group 'coolj
   :type 'regexp)
 
-(defvar coolj-wrap-point nil)
-
-(make-variable-buffer-local 'coolj-wrap-point)
+(defvar-local coolj-wrap-point nil)
 
 (defun coolj-determine-prefix ()
   "Determine the prefix for the current line."
index a7699fb1dd05cff9c167217d6671cb0b891dd628..8c9e0a27e988abf1e1da9d1230ea702c856bcdf7 100644 (file)
@@ -1,4 +1,4 @@
-;;; make-deps.el --- compute make dependencies for Elisp sources
+;;; make-deps.el --- compute make dependencies for Elisp sources  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Austin Clements
 ;;
index 8a6d299cb3061bc7234c932a59a73f7e6da87e21..f0af666754b798ac0f83b90db079f8aecd94422a 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-address.el --- address completion with notmuch
+;;; notmuch-address.el --- address completion with notmuch  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © David Edmondson
 ;;
 (require 'notmuch-parser)
 (require 'notmuch-lib)
 (require 'notmuch-company)
-;;
+
 (declare-function company-manual-begin "company")
 
+;;; Cache internals
+
 (defvar notmuch-address-last-harvest 0
   "Time of last address harvest.")
 
@@ -36,9 +38,9 @@
 This variable is set by calling `notmuch-address-harvest'.")
 
 (defvar notmuch-address-full-harvest-finished nil
-  "t indicates that full completion address harvesting has been finished.
-Use notmuch-address--harvest-ready to access as that will load a
-saved hash if necessary (and available).")
+  "Whether full completion address harvesting has finished.
+Use `notmuch-address--harvest-ready' to access as that will load
+saved hash if necessary (and available).")
 
 (defun notmuch-address--harvest-ready ()
   "Return t if there is a full address hash available.
@@ -47,24 +49,33 @@ If the hash is not present it attempts to load a saved hash."
   (or notmuch-address-full-harvest-finished
       (notmuch-address--load-address-hash)))
 
+;;; Options
+
 (defcustom notmuch-address-command 'internal
   "Determines how address completion candidates are generated.
 
-If it is a string then that string should be an external program
-which must take a single argument (searched string) and output a
-list of completion candidates, one per line.
+If this is a string, then that string should be an external
+program, which must take a single argument (searched string)
+and output a list of completion candidates, one per line.
+
+If this is the symbol `internal', then an implementation is used
+that relies on the \"notmuch address\" command, but does not use
+any third-party (i.e. \"external\") programs.
 
-Alternatively, it can be the symbol `internal', in which case
-internal completion is used; the variable
-`notmuch-address-internal-completion' can be used to customize
-this case.
+If this is the symbol `as-is', then Notmuch does not modify the
+value of `message-completion-alist'. This option has to be set to
+this value before `notmuch' is loaded, otherwise the modification
+to `message-completion-alist' may already have taken place. This
+setting obviously does not prevent `message-completion-alist'
+from being modified at all; the user or some third-party package
+may still modify it.
 
-Finally, if this variable is nil then address completion is
-disabled."
+Finally, if this is nil, then address completion is disabled."
   :type '(radio
-         (const :tag "Use internal address completion" internal)
-         (const :tag "Disable address completion" nil)
-         (string :tag "Use external completion command"))
+         (const  :tag "Use internal address completion" internal)
+         (string :tag "Use external completion command")
+         (const  :tag "Disable address completion" nil)
+         (const  :tag "Use default or third-party mechanism" as-is))
   :group 'notmuch-send
   :group 'notmuch-address
   :group 'notmuch-external)
@@ -133,6 +144,14 @@ matching `notmuch-address-completion-headers-regexp'."
   :group 'notmuch-address
   :group 'notmuch-hooks)
 
+(defcustom notmuch-address-use-company t
+  "If available, use company mode for address completion."
+  :type 'boolean
+  :group 'notmuch-send
+  :group 'notmuch-address)
+
+;;; Setup
+
 (defun notmuch-address-selection-function (prompt collection initial-input)
   "Call (`completing-read'
       PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
@@ -147,22 +166,14 @@ matching `notmuch-address-completion-headers-regexp'."
 (defun notmuch-address-message-insinuate ()
   (message "calling notmuch-address-message-insinuate is no longer needed"))
 
-(defcustom notmuch-address-use-company t
-  "If available, use company mode for address completion."
-  :type 'boolean
-  :group 'notmuch-send
-  :group 'notmuch-address)
-
 (defun notmuch-address-setup ()
-  (let* ((setup-company (and notmuch-address-use-company
-                            (require 'company nil t)))
-        (pair (cons notmuch-address-completion-headers-regexp
-                    #'notmuch-address-expand-name)))
-    (when setup-company
+  (unless (eq notmuch-address-command 'as-is)
+    (when (and notmuch-address-use-company
+              (require 'company nil t))
       (notmuch-company-setup))
-    (unless (member pair message-completion-alist)
-      (setq message-completion-alist
-           (push pair message-completion-alist)))))
+    (cl-pushnew (cons notmuch-address-completion-headers-regexp
+                     #'notmuch-address-expand-name)
+               message-completion-alist :test #'equal)))
 
 (defun notmuch-address-toggle-internal-completion ()
   "Toggle use of internal completion for current buffer.
@@ -178,12 +189,14 @@ toggles the setting in this buffer."
        (kill-local-variable 'company-idle-delay)
       (setq-local company-idle-delay nil))))
 
+;;; Completion
+
 (defun notmuch-address-matching (substring)
   "Returns a list of completion candidates matching SUBSTRING.
 The candidates are taken from `notmuch-address-completions'."
   (let ((candidates)
        (re (regexp-quote substring)))
-    (maphash (lambda (key val)
+    (maphash (lambda (key _val)
               (when (string-match re key)
                 (push key candidates)))
             notmuch-address-completions)
@@ -231,14 +244,8 @@ requiring external commands."
                    (t
                     (funcall notmuch-address-selection-function
                              (format "Address (%s matches): " num-options)
-                             ;; We put the first match as the initial
-                             ;; input; we put all the matches as
-                             ;; possible completions, moving the
-                             ;; first match to the end of the list
-                             ;; makes cursor up/down in the list work
-                             ;; better.
-                             (append (cdr options) (list (car options)))
-                             (car options))))))
+                             options
+                             orig)))))
       (if chosen
          (progn
            (push chosen notmuch-address-history)
@@ -250,31 +257,11 @@ requiring external commands."
        (ding))))
    (t nil)))
 
-;; Copied from `w3m-which-command'.
-(defun notmuch-address-locate-command (command)
-  "Return non-nil if `command' is an executable either on
-`exec-path' or an absolute pathname."
-  (and (stringp command)
-       (if (and (file-name-absolute-p command)
-               (file-executable-p command))
-          command
-        (setq command (file-name-nondirectory command))
-        (catch 'found-command
-          (let (bin)
-            (dolist (dir exec-path)
-              (setq bin (expand-file-name command dir))
-              (when (or (and (file-executable-p bin)
-                             (not (file-directory-p bin)))
-                        (and (file-executable-p (setq bin (concat bin ".exe")))
-                             (not (file-directory-p bin))))
-                (throw 'found-command bin))))))))
+;;; Harvest
 
 (defun notmuch-address-harvest-addr (result)
-  (let ((name-addr (plist-get result :name-addr)))
-    (puthash name-addr t notmuch-address-completions)))
-
-(defun notmuch-address-harvest-handle-result (obj)
-  (notmuch-address-harvest-addr obj))
+  (puthash (plist-get result :name-addr)
+          t notmuch-address-completions))
 
 (defun notmuch-address-harvest-filter (proc string)
   (when (buffer-live-p (process-buffer proc))
@@ -283,7 +270,7 @@ requiring external commands."
        (goto-char (point-max))
        (insert string))
       (notmuch-sexp-parse-partial-list
-       'notmuch-address-harvest-handle-result (process-buffer proc)))))
+       'notmuch-address-harvest-addr (process-buffer proc)))))
 
 (defvar notmuch-address-harvest-procs '(nil . nil)
   "The currently running harvests.
@@ -294,7 +281,7 @@ The car is a partial harvest, and the cdr is a full harvest.")
   "Collect addresses completion candidates.
 
 It queries the notmuch database for messages sent/received (as
-configured with `notmuch-address-command`) by the user, collects
+configured with `notmuch-address-command') by the user, collects
 destination/source addresses from those messages and stores them
 in `notmuch-address-completions'.
 
@@ -394,7 +381,7 @@ to be a saved address hash."
 (defun notmuch-address--save-address-hash ()
   (when notmuch-address-save-filename
     (if (or (not (file-exists-p notmuch-address-save-filename))
-           ;; The file exists, check it is a file we saved
+           ;; The file exists, check it is a file we saved.
            (notmuch-address--get-address-hash))
        (with-temp-file notmuch-address-save-filename
          (let ((save-plist
@@ -415,17 +402,16 @@ appear to be an address savefile.  Not overwriting."
       (setq notmuch-address-last-harvest now)
       (notmuch-address-harvest
        nil nil
-       (lambda (proc event)
+       (lambda (_proc event)
         ;; If harvest fails, we want to try
-        ;; again when the trigger is next
-        ;; called
+        ;; again when the trigger is next called.
         (if (string= event "finished\n")
             (progn
               (notmuch-address--save-address-hash)
               (setq notmuch-address-full-harvest-finished t))
           (setq notmuch-address-last-harvest 0)))))))
 
-;;
+;;; Standalone completion
 
 (defun notmuch-address-from-minibuffer (prompt)
   (if (not notmuch-address-command)
@@ -444,7 +430,7 @@ appear to be an address savefile.  Not overwriting."
       (let ((minibuffer-local-map rmap))
        (read-string prompt)))))
 
-;;
+;;; _
 
 (provide 'notmuch-address)
 
index 9ee8ceca2922076ce3e459f098939c0e3025c289..c6a004aebe92bcd447ee93729a54a2518052200b 100644 (file)
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
-
 (require 'notmuch-lib)
 
-(defvar notmuch-company-last-prefix nil)
-(make-variable-buffer-local 'notmuch-company-last-prefix)
+(defvar-local notmuch-company-last-prefix nil)
+
 (declare-function company-begin-backend "company")
 (declare-function company-grab "company")
 (declare-function company-mode "company")
@@ -55,8 +53,7 @@
 ;;;###autoload
 (defun notmuch-company-setup ()
   (company-mode)
-  (make-local-variable 'company-backends)
-  (setq company-backends '(notmuch-company))
+  (setq-local company-backends '(notmuch-company))
   ;; Disable automatic company completion unless an internal
   ;; completion method is configured. Company completion (using
   ;; internal completion) can still be accessed via standard company
        (run-hook-with-args 'notmuch-address-post-completion-functions arg))
       (no-cache t))))
 
-
 (provide 'notmuch-company)
 
 ;;; notmuch-company.el ends here
index 3ede6b36aeae6d7c0e7bfa90dfb9331e1dbb7ad6..ad134dfee99c273f7ffb5895730364902abe40af 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-compat.el --- compatibility functions for earlier versions of emacs
+;;; notmuch-compat.el --- compatibility functions for earlier versions of emacs  -*- lexical-binding: t -*-
 ;;
 ;; The functions in this file are copied from more modern versions of
 ;; emacs and are Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2017
 
 ;;; Code:
 
-;; emacs master has a bugfix for folding long headers when sending
-;; messages. Include the fix for earlier versions of emacs. To avoid
-;; interfering with gnus we only run the hook when called from
-;; notmuch-message-mode.
+;; Before Emacs 26.1 lines that are longer than 998 octets were not.
+;; folded. Commit 77bbca8c82f6e553c42abbfafca28f55fc995d00 fixed
+;; that. Until we drop support for Emacs 25 we have to backport that
+;; fix. To avoid interfering with Gnus we only run the hook when
+;; called from notmuch-message-mode.
 
 (declare-function mail-header-fold-field "mail-parse" nil)
 
@@ -40,8 +41,6 @@
 (unless (fboundp 'message--fold-long-headers)
   (add-hook 'message-header-hook 'notmuch-message--fold-long-headers))
 
-;; End of compatibility functions
-
 (provide 'notmuch-compat)
 
 ;;; notmuch-compat.el ends here
index 276c98594e3db94c115845600064d81d2d7e800c..db7cb75d43a954cd06ba4400d378ba2b74ae41da 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-crypto.el --- functions for handling display of cryptographic metadata
+;;; notmuch-crypto.el --- functions for handling display of cryptographic metadata  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Jameson Rollins
 ;;
 
 (declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare))
 
+;;; Options
+
 (defcustom notmuch-crypto-process-mime t
-  "Should cryptographic MIME parts be processed?
+  "Whether to process cryptographic MIME parts.
 
 If this variable is non-nil signatures in multipart/signed
 messages will be verified and multipart/encrypted parts will be
@@ -46,7 +48,7 @@ mode."
   :group 'notmuch-crypto)
 
 (defcustom notmuch-crypto-get-keys-asynchronously t
-  "Retrieve gpg keys asynchronously."
+  "Whether to retrieve openpgp keys asynchronously."
   :type 'boolean
   :group 'notmuch-crypto)
 
@@ -55,6 +57,8 @@ mode."
   :type 'string
   :group 'notmuch-crypto)
 
+;;; Faces
+
 (defface notmuch-crypto-part-header
   '((((class color)
       (background dark))
@@ -96,15 +100,16 @@ mode."
   :group 'notmuch-crypto
   :group 'notmuch-faces)
 
+;;; Functions
+
 (define-button-type 'notmuch-crypto-status-button-type
-  'action (lambda (button) (message (button-get button 'help-echo)))
+  'action (lambda (button) (message "%s" (button-get button 'help-echo)))
   'follow-link t
   'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts."
   :supertype 'notmuch-button-type)
 
 (defun notmuch-crypto-insert-sigstatus-button (sigstatus from)
-  "Insert a button describing the signature status SIGSTATUS sent
-by user FROM."
+  "Insert a button describing the signature status SIGSTATUS sent by user FROM."
   (let* ((status (plist-get sigstatus :status))
         (show-button t)
         (face 'notmuch-crypto-signature-unknown)
@@ -166,7 +171,7 @@ by user FROM."
 (declare-function notmuch-show-refresh-view "notmuch-show" (&optional reset-state))
 (declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare))
 
-(defun notmuch-crypto--async-key-sentinel (process event)
+(defun notmuch-crypto--async-key-sentinel (process _event)
   "When the user asks for a GPG key to be retrieved
 asynchronously, handle completion of that task.
 
@@ -260,7 +265,7 @@ corresponding key when the status button is pressed."
    'mouse-face 'notmuch-crypto-decryption)
   (insert "\n"))
 
-;;
+;;; _
 
 (provide 'notmuch-crypto)
 
index 283830ad0d0097c2aa529cc754ea41cd90002281..a68b7d8da002a7f3f76b2ccded426bb465724de7 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-draft.el --- functions for postponing and editing drafts
+;;; notmuch-draft.el --- functions for postponing and editing drafts  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Mark Walters
 ;; Copyright © David Bremner
 
 ;;; Code:
 
+(require 'cl-lib)
+(require 'pcase)
+(require 'subr-x)
+
 (require 'notmuch-maildir-fcc)
 (require 'notmuch-tag)
 
 (declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare))
 (declare-function notmuch-message-mode "notmuch-mua")
 
+;;; Options
+
 (defgroup notmuch-draft nil
   "Saving and editing drafts in Notmuch."
   :group 'notmuch)
@@ -75,9 +81,11 @@ postponing and resuming a message."
   :group 'notmuch-send)
 
 (defcustom notmuch-draft-save-plaintext 'ask
-  "Should notmuch save/postpone in plaintext messages that seem
-like they are intended to be sent encrypted
-(i.e with an mml encryption tag in it)."
+  "Whether to allow saving plaintext when it seems encryption is intended.
+When a message contains mml tags, then that suggest it is
+intended to be encrypted.  If the user requests that such a
+message is saved locally, then this option controls whether
+that is allowed.  Beside a boolean, this can also be `ask'."
   :type '(radio
          (const :tag "Never" nil)
          (const :tag "Ask every time" ask)
@@ -85,13 +93,14 @@ like they are intended to be sent encrypted
   :group 'notmuch-draft
   :group 'notmuch-crypto)
 
+;;; Internal
+
 (defvar notmuch-draft-encryption-tag-regex
   "<#\\(part encrypt\\|secure.*mode=.*encrypt>\\)"
   "Regular expression matching mml tags indicating encryption of part or message.")
 
-(defvar notmuch-draft-id nil
+(defvar-local notmuch-draft-id nil
   "Message-id of the most recent saved draft of this message.")
-(make-variable-buffer-local 'notmuch-draft-id)
 
 (defun notmuch-draft--mark-deleted ()
   "Tag the last saved draft deleted.
@@ -101,7 +110,7 @@ Used when a new version is saved, or the message is sent."
     (notmuch-tag notmuch-draft-id '("+deleted"))))
 
 (defun notmuch-draft-quote-some-mml ()
-  "Quote the mml tags in `notmuch-draft-quoted-tags`."
+  "Quote the mml tags in `notmuch-draft-quoted-tags'."
   (save-excursion
     ;; First we deal with any secure tag separately.
     (message-goto-body)
@@ -122,7 +131,7 @@ Used when a new version is saved, or the message is sent."
          (insert "!"))))))
 
 (defun notmuch-draft-unquote-some-mml ()
-  "Unquote the mml tags in `notmuch-draft-quoted-tags`."
+  "Unquote the mml tags in `notmuch-draft-quoted-tags'."
   (save-excursion
     (when notmuch-draft-quoted-tags
       (let ((re (concat "<#!+/?\\("
@@ -136,20 +145,20 @@ Used when a new version is saved, or the message is sent."
     (let (secure-tag)
       (save-restriction
        (message-narrow-to-headers)
-       (setq secure-tag (message-fetch-field "X-Notmuch-Emacs-Secure" 't))
+       (setq secure-tag (message-fetch-field "X-Notmuch-Emacs-Secure" t))
        (message-remove-header "X-Notmuch-Emacs-Secure"))
       (message-goto-body)
       (when secure-tag
        (insert secure-tag "\n")))))
 
 (defun notmuch-draft--has-encryption-tag ()
-  "Returns t if there is an mml secure tag."
+  "Return non-nil if there is an mml secure tag."
   (save-excursion
     (message-goto-body)
-    (re-search-forward notmuch-draft-encryption-tag-regex nil 't)))
+    (re-search-forward notmuch-draft-encryption-tag-regex nil t)))
 
 (defun notmuch-draft--query-encryption ()
-  "Checks if we should save a message that should be encrypted.
+  "Return non-nil if we should save a message that should be encrypted.
 
 `notmuch-draft-save-plaintext' controls the behaviour."
   (cl-case notmuch-draft-save-plaintext
@@ -170,11 +179,13 @@ Really save and index an unencrypted copy? ")
   ;; but notmuch doesn't want that form, so remove them.
   (concat "draft-" (substring (message-make-message-id) 1 -1)))
 
+;;; Commands
+
 (defun notmuch-draft-save ()
   "Save the current draft message in the notmuch database.
 
 This saves the current message in the database with tags
-`notmuch-draft-tags` (in addition to any default tags
+`notmuch-draft-tags' (in addition to any default tags
 applied to newly inserted messages)."
   (interactive)
   (when (notmuch-draft--has-encryption-tag)
@@ -185,7 +196,7 @@ applied to newly inserted messages)."
      ;; so that it is easier to search for the message, and the
      ;; latter so we have a way of accessing the saved message (for
      ;; example to delete it at a later time). We check that the
-     ;; user has these in `message-deletable-headers` (the default)
+     ;; user has these in `message-deletable-headers' (the default)
      ;; as otherwise they are doing something strange and we
      ;; shouldn't interfere. Note, since we are doing this in a new
      ;; buffer we don't change the version in the compose buffer.
@@ -208,7 +219,7 @@ applied to newly inserted messages)."
      (notmuch-draft-quote-some-mml)
      (notmuch-maildir-setup-message-for-saving)
      (notmuch-maildir-notmuch-insert-current-buffer
-      notmuch-draft-folder 't notmuch-draft-tags))
+      notmuch-draft-folder t notmuch-draft-tags))
     ;; We are now back in the original compose buffer. Note the
     ;; function notmuch-call-notmuch-process (called by
     ;; notmuch-maildir-notmuch-insert-current-buffer) signals an error
@@ -227,6 +238,7 @@ applied to newly inserted messages)."
 
 (defun notmuch-draft-resume (id)
   "Resume editing of message with id ID."
+  ;; Used by command `notmuch-show-resume-message'.
   (let* ((tags (process-lines notmuch-command "search" "--output=tags"
                              "--exclude=false" id))
         (draft (equal tags (notmuch-update-tags tags notmuch-draft-tags))))
@@ -266,10 +278,10 @@ applied to newly inserted messages)."
       ;; message is resaved or sent.
       (setq notmuch-draft-id (and draft id)))))
 
+;;; _
 
 (add-hook 'message-send-hook 'notmuch-draft--mark-deleted)
 
-
 (provide 'notmuch-draft)
 
 ;;; notmuch-draft.el ends here
index bb60a890f85e1a1e8680363f136d15761b4c728e..24d2d19e20d4c24e7d77e77312916eab818fcc10 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-hello.el --- welcome to notmuch, a frontend
+;;; notmuch-hello.el --- welcome to notmuch, a frontend  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © David Edmondson
 ;;
@@ -21,8 +21,6 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
-
 (require 'widget)
 (require 'wid-edit) ; For `widget-forward'.
 
@@ -38,6 +36,8 @@
                  (&optional query query-context target buffer-name open-target))
 
 
+;;; Options
+
 (defun notmuch-saved-search-get (saved-search field)
   "Get FIELD from SAVED-SEARCH.
 
@@ -138,8 +138,8 @@ a plist. Supported properties are
                    shown. If not present then the :query property
                    is used.
   :sort-order      Specify the sort order to be used for the search.
-                   Possible values are 'oldest-first 'newest-first or
-                   nil. Nil means use the default sort order.
+                   Possible values are `oldest-first', `newest-first'
+                   or nil. Nil means use the default sort order.
   :search-type     Specify whether to run the search in search-mode,
                    tree mode or unthreaded mode. Set to 'tree to specify tree
                    mode, 'unthreaded to specify unthreaded mode, and set to nil
@@ -193,6 +193,8 @@ fields of the search."
 (defvar notmuch-hello-indent 4
   "How much to indent non-headers.")
 
+(defimage notmuch-hello-logo ((:type png :file "notmuch-logo.png")))
+
 (defcustom notmuch-show-logo t
   "Should the notmuch logo be shown?"
   :type 'boolean
@@ -282,7 +284,7 @@ International Bureau of Weights and Measures."
   :group 'notmuch-hello
   :group 'notmuch-hooks)
 
-(defvar notmuch-hello-url "https://notmuchmail.org"
+(defconst notmuch-hello-url "https://notmuchmail.org"
   "The `notmuch' web site.")
 
 (defvar notmuch-hello-custom-section-options
@@ -368,50 +370,68 @@ supported for \"Customized queries section\" items."
   :group 'notmuch-hello
   :type 'boolean)
 
+;;; Internal variables
+
 (defvar notmuch-hello-hidden-sections nil
   "List of sections titles whose contents are hidden.")
 
 (defvar notmuch-hello-first-run t
-  "True if `notmuch-hello' is run for the first time, set to nil
-afterwards.")
-
-(defun notmuch-hello-nice-number (n)
-  (let (result)
-    (while (> n 0)
-      (push (% n 1000) result)
-      (setq n (/ n 1000)))
-    (setq result (or result '(0)))
-    (apply #'concat
-          (number-to-string (car result))
-          (mapcar (lambda (elem)
-                    (format "%s%03d" notmuch-hello-thousands-separator elem))
-                  (cdr result)))))
-
-(defun notmuch-hello-trim (search)
-  "Trim whitespace."
-  (if (string-match "^[[:space:]]*\\(.*[^[:space:]]\\)[[:space:]]*$" search)
-      (match-string 1 search)
-    search))
-
-(defun notmuch-hello-search (&optional search)
-  (unless (null search)
-    (setq search (notmuch-hello-trim search))
-    (let ((history-delete-duplicates t))
-      (add-to-history 'notmuch-search-history search)))
-  (notmuch-search search notmuch-search-oldest-first))
-
-(defun notmuch-hello-add-saved-search (widget)
-  (interactive)
-  (let ((search (widget-value
-                (symbol-value
-                 (widget-get widget :notmuch-saved-search-widget))))
+  "True if `notmuch-hello' is run for the first time, set to nil afterwards.")
+
+;;; Widgets for inserters
+
+(define-widget 'notmuch-search-item 'item
+  "A recent search."
+  :format "%v\n"
+  :value-create 'notmuch-search-item-value-create)
+
+(defun notmuch-search-item-value-create (widget)
+  (let ((value (widget-get widget :value)))
+    (widget-insert (make-string notmuch-hello-indent ?\s))
+    (widget-create 'editable-field
+                  :size (widget-get widget :size)
+                  :parent widget
+                  :action #'notmuch-hello-search
+                  value)
+    (widget-insert " ")
+    (widget-create 'push-button
+                  :parent widget
+                  :notify #'notmuch-hello-add-saved-search
+                  "save")
+    (widget-insert " ")
+    (widget-create 'push-button
+                  :parent widget
+                  :notify #'notmuch-hello-delete-search-from-history
+                  "del")))
+
+(defun notmuch-search-item-field-width ()
+  (max 8 ; Don't let the search boxes be less than 8 characters wide.
+       (- (window-width)
+         notmuch-hello-indent ; space at bol
+         notmuch-hello-indent ; space at eol
+         1    ; for the space before the [save] button
+         6    ; for the [save] button
+         1    ; for the space before the [del] button
+         5))) ; for the [del] button
+
+;;; Widget actions
+
+(defun notmuch-hello-search (widget &rest _event)
+  (let ((search (widget-value widget)))
+    (when search
+      (setq search (string-trim search))
+      (let ((history-delete-duplicates t))
+       (add-to-history 'notmuch-search-history search)))
+    (notmuch-search search notmuch-search-oldest-first)))
+
+(defun notmuch-hello-add-saved-search (widget &rest _event)
+  (let ((search (widget-value (widget-get widget :parent)))
        (name (completing-read "Name for saved search: "
                               notmuch-saved-searches)))
     ;; If an existing saved search with this name exists, remove it.
     (setq notmuch-saved-searches
          (cl-loop for elem in notmuch-saved-searches
-                  if (not (equal name
-                                 (notmuch-saved-search-get elem :name)))
+                  unless (equal name (notmuch-saved-search-get elem :name))
                   collect elem))
     ;; Add the new one.
     (customize-save-variable 'notmuch-saved-searches
@@ -420,15 +440,20 @@ afterwards.")
     (message "Saved '%s' as '%s'." search name)
     (notmuch-hello-update)))
 
-(defun notmuch-hello-delete-search-from-history (widget)
-  (interactive)
-  (let ((search (widget-value
-                (symbol-value
-                 (widget-get widget :notmuch-saved-search-widget)))))
-    (setq notmuch-search-history (delete search
-                                        notmuch-search-history))
+(defun notmuch-hello-delete-search-from-history (widget &rest _event)
+  (when (y-or-n-p "Are you sure you want to delete this search? ")
+    (let ((search (widget-value (widget-get widget :parent))))
+      (setq notmuch-search-history
+           (delete search notmuch-search-history)))
     (notmuch-hello-update)))
 
+;;; Button utilities
+
+;; `notmuch-hello-query-counts', `notmuch-hello-nice-number' and
+;; `notmuch-hello-insert-buttons' are used outside this section.
+;; All other functions that are defined in this section are only
+;; used by these two functions.
+
 (defun notmuch-hello-longest-label (searches-alist)
   (or (cl-loop for elem in searches-alist
               maximize (length (notmuch-saved-search-get elem :name)))
@@ -453,19 +478,15 @@ diagonal."
     (cl-loop for row from 0 to (- nrows 1)
             append (notmuch-hello-reflect-generate-row ncols nrows row list))))
 
-(defun notmuch-hello-widget-search (widget &rest ignore)
-  (cond
-   ((eq (widget-get widget :notmuch-search-type) 'tree)
-    (notmuch-tree (widget-get widget
-                             :notmuch-search-terms)))
-   ((eq (widget-get widget :notmuch-search-type) 'unthreaded)
-    (notmuch-unthreaded (widget-get widget
-                                   :notmuch-search-terms)))
+(defun notmuch-hello-widget-search (widget &rest _ignore)
+  (cl-case (widget-get widget :notmuch-search-type)
+   (tree
+    (notmuch-tree (widget-get widget :notmuch-search-terms)))
+   (unthreaded
+    (notmuch-unthreaded (widget-get widget :notmuch-search-terms)))
    (t
-    (notmuch-search (widget-get widget
-                               :notmuch-search-terms)
-                   (widget-get widget
-                               :notmuch-search-oldest-first)))))
+    (notmuch-search (widget-get widget :notmuch-search-terms)
+                   (widget-get widget :notmuch-search-oldest-first)))))
 
 (defun notmuch-saved-search-count (search)
   (car (process-lines notmuch-command "count" search)))
@@ -549,21 +570,31 @@ options will be handled as specified for
 --batch'. In general we recommend running matching versions of
 the CLI and emacs interface."))
     (goto-char (point-min))
-    (notmuch-remove-if-not
-     #'identity
-     (mapcar
-      (lambda (elem)
-       (let* ((elem-plist (notmuch-hello-saved-search-to-plist elem))
-              (search-query (plist-get elem-plist :query))
-              (filtered-query (notmuch-hello-filtered-query
-                               search-query (plist-get options :filter)))
-              (message-count (prog1 (read (current-buffer))
-                               (forward-line 1))))
-         (when (and filtered-query (or (plist-get options :show-empty-searches)
-                                       (> message-count 0)))
-           (setq elem-plist (plist-put elem-plist :query filtered-query))
-           (plist-put elem-plist :count message-count))))
-      query-list))))
+    (cl-mapcan
+     (lambda (elem)
+       (let* ((elem-plist (notmuch-hello-saved-search-to-plist elem))
+             (search-query (plist-get elem-plist :query))
+             (filtered-query (notmuch-hello-filtered-query
+                              search-query (plist-get options :filter)))
+             (message-count (prog1 (read (current-buffer))
+                              (forward-line 1))))
+        (when (and filtered-query (or (plist-get options :show-empty-searches)
+                                      (> message-count 0)))
+          (setq elem-plist (plist-put elem-plist :query filtered-query))
+          (list (plist-put elem-plist :count message-count)))))
+     query-list)))
+
+(defun notmuch-hello-nice-number (n)
+  (let (result)
+    (while (> n 0)
+      (push (% n 1000) result)
+      (setq n (/ n 1000)))
+    (setq result (or result '(0)))
+    (apply #'concat
+          (number-to-string (car result))
+          (mapcar (lambda (elem)
+                    (format "%s%03d" notmuch-hello-thousands-separator elem))
+                  (cdr result)))))
 
 (defun notmuch-hello-insert-buttons (searches)
   "Insert buttons for SEARCHES.
@@ -619,7 +650,7 @@ with `notmuch-hello-query-counts'."
     (unless (eq (% count tags-per-line) 0)
       (widget-insert "\n"))))
 
-(defimage notmuch-hello-logo ((:type png :file "notmuch-logo.png")))
+;;; Mode
 
 (defun notmuch-hello-update ()
   "Update the notmuch-hello buffer."
@@ -651,39 +682,19 @@ with `notmuch-hello-query-counts'."
       ;; Refresh hello as soon as we get back to redisplay.  On Emacs
       ;; 24, we can't do it right here because something in this
       ;; hook's call stack overrides hello's point placement.
+      ;; FIXME And on Emacs releases that we still support?
       (run-at-time nil nil #'notmuch-hello t))
     (unless hello-buf
       ;; Clean up hook
       (remove-hook 'window-configuration-change-hook
                   #'notmuch-hello-window-configuration-change))))
 
-;; the following variable is defined as being defconst in notmuch-version.el
-(defvar notmuch-emacs-version)
-
-(defun notmuch-hello-versions ()
-  "Display the notmuch version(s)."
-  (interactive)
-  (let ((notmuch-cli-version (notmuch-cli-version)))
-    (message "notmuch version %s"
-            (if (string= notmuch-emacs-version notmuch-cli-version)
-                notmuch-cli-version
-              (concat notmuch-cli-version
-                      " (emacs mua version " notmuch-emacs-version ")")))))
-
 (defvar notmuch-hello-mode-map
-  (let ((map (if (fboundp 'make-composed-keymap)
-                ;; Inherit both widget-keymap and
-                ;; notmuch-common-keymap. We have to use
-                ;; make-sparse-keymap to force this to be a new
-                ;; keymap (so that when we modify map it does not
-                ;; modify widget-keymap).
-                (make-composed-keymap (list (make-sparse-keymap) widget-keymap))
-              ;; Before Emacs 24, keymaps didn't support multiple
-              ;; inheritance,, so just copy the widget keymap since
-              ;; it's unlikely to change.
-              (copy-keymap widget-keymap))))
+  ;; Inherit both widget-keymap and notmuch-common-keymap.  We have
+  ;; to use make-sparse-keymap to force this to be a new keymap (so
+  ;; that when we modify map it does not modify widget-keymap).
+  (let ((map (make-composed-keymap (list (make-sparse-keymap) widget-keymap))))
     (set-keymap-parent map notmuch-common-keymap)
-    (define-key map "v" 'notmuch-hello-versions)
     (define-key map (kbd "<C-tab>") 'widget-backward)
     map)
   "Keymap for \"notmuch hello\" buffers.")
@@ -719,18 +730,18 @@ The screen may be customized via `\\[customize]'.
 Complete list of currently available key bindings:
 
 \\{notmuch-hello-mode-map}"
-  (setq notmuch-buffer-refresh-function #'notmuch-hello-update)
-  ;;(setq buffer-read-only t)
-  )
+  (setq notmuch-buffer-refresh-function #'notmuch-hello-update))
+
+;;; Inserters
 
 (defun notmuch-hello-generate-tag-alist (&optional hide-tags)
   "Return an alist from tags to queries to display in the all-tags section."
-  (mapcar (lambda (tag)
-           (cons tag (concat "tag:" (notmuch-escape-boolean-term tag))))
-         (notmuch-remove-if-not
-          (lambda (tag)
-            (not (member tag hide-tags)))
-          (process-lines notmuch-command "search" "--output=tags" "*"))))
+  (cl-mapcan (lambda (tag)
+              (and (not (member tag hide-tags))
+                   (list (cons tag
+                               (concat "tag:"
+                                       (notmuch-escape-boolean-term tag))))))
+            (process-lines notmuch-command "search" "--output=tags" "*")))
 
 (defun notmuch-hello-insert-header ()
   "Insert the default notmuch-hello header."
@@ -756,14 +767,14 @@ Complete list of currently available key bindings:
   (let ((widget-link-prefix "")
        (widget-link-suffix ""))
     (widget-create 'link
-                  :notify (lambda (&rest ignore)
+                  :notify (lambda (&rest _ignore)
                             (browse-url notmuch-hello-url))
                   :help-echo "Visit the notmuch website."
                   "notmuch")
     (widget-insert ". ")
     (widget-insert "You have ")
     (widget-create 'link
-                  :notify (lambda (&rest ignore)
+                  :notify (lambda (&rest _ignore)
                             (notmuch-hello-update))
                   :help-echo "Refresh"
                   (notmuch-hello-nice-number
@@ -782,7 +793,7 @@ Complete list of currently available key bindings:
     (when searches
       (widget-insert "Saved searches: ")
       (widget-create 'push-button
-                    :notify (lambda (&rest ignore)
+                    :notify (lambda (&rest _ignore)
                               (customize-variable 'notmuch-saved-searches))
                     "edit")
       (widget-insert "\n\n")
@@ -798,73 +809,31 @@ Complete list of currently available key bindings:
                 ;; search boxes.
                 :size (max 8 (- (window-width) notmuch-hello-indent
                                 (length "Search: ")))
-                :action (lambda (widget &rest ignore)
-                          (notmuch-hello-search (widget-value widget))))
+                :action #'notmuch-hello-search)
   ;; Add an invisible dot to make `widget-end-of-line' ignore
   ;; trailing spaces in the search widget field.  A dot is used
   ;; instead of a space to make `show-trailing-whitespace'
   ;; happy, i.e. avoid it marking the whole line as trailing
   ;; spaces.
-  (widget-insert ".")
-  (put-text-property (1- (point)) (point) 'invisible t)
+  (widget-insert (propertize "." 'invisible t))
   (widget-insert "\n"))
 
 (defun notmuch-hello-insert-recent-searches ()
   "Insert recent searches."
   (when notmuch-search-history
     (widget-insert "Recent searches: ")
-    (widget-create 'push-button
-                  :notify (lambda (&rest ignore)
-                            (when (y-or-n-p "Are you sure you want to clear the searches? ")
-                              (setq notmuch-search-history nil)
-                              (notmuch-hello-update)))
-                  "clear")
+    (widget-create
+     'push-button
+     :notify (lambda (&rest _ignore)
+              (when (y-or-n-p "Are you sure you want to clear the searches? ")
+                (setq notmuch-search-history nil)
+                (notmuch-hello-update)))
+     "clear")
     (widget-insert "\n\n")
-    (let ((start (point)))
-      (cl-loop for i from 1 to notmuch-hello-recent-searches-max
-              for search in notmuch-search-history do
-              (let ((widget-symbol (intern (format "notmuch-hello-search-%d" i))))
-                (set widget-symbol
-                     (widget-create 'editable-field
-                                    ;; Don't let the search boxes be
-                                    ;; less than 8 characters wide.
-                                    :size (max 8
-                                               (- (window-width)
-                                                  ;; Leave some space
-                                                  ;; at the start and
-                                                  ;; end of the
-                                                  ;; boxes.
-                                                  (* 2 notmuch-hello-indent)
-                                                  ;; 1 for the space
-                                                  ;; before the
-                                                  ;; `[save]' button. 6
-                                                  ;; for the `[save]'
-                                                  ;; button.
-                                                  1 6
-                                                  ;; 1 for the space
-                                                  ;; before the `[del]'
-                                                  ;; button. 5 for the
-                                                  ;; `[del]' button.
-                                                  1 5))
-                                    :action (lambda (widget &rest ignore)
-                                              (notmuch-hello-search (widget-value widget)))
-                                    search))
-                (widget-insert " ")
-                (widget-create 'push-button
-                               :notify (lambda (widget &rest ignore)
-                                         (notmuch-hello-add-saved-search widget))
-                               :notmuch-saved-search-widget widget-symbol
-                               "save")
-                (widget-insert " ")
-                (widget-create 'push-button
-                               :notify (lambda (widget &rest ignore)
-                                         (when (y-or-n-p "Are you sure you want to delete this search? ")
-                                           (notmuch-hello-delete-search-from-history widget)))
-                               :notmuch-saved-search-widget widget-symbol
-                               "del"))
-              (widget-insert "\n"))
-      (indent-rigidly start (point) notmuch-hello-indent))
-    nil))
+    (let ((width (notmuch-search-item-field-width)))
+      (dolist (search (seq-take notmuch-search-history
+                               notmuch-hello-recent-searches-max))
+       (widget-create 'notmuch-search-item :value search :size width)))))
 
 (defun notmuch-hello-insert-searches (title query-list &rest options)
   "Insert a section with TITLE showing a list of buttons made from QUERY-LIST.
@@ -895,13 +864,13 @@ Supports the following entries in OPTIONS as a plist:
        (start (point)))
     (if is-hidden
        (widget-create 'push-button
-                      :notify `(lambda (widget &rest ignore)
+                      :notify `(lambda (widget &rest _ignore)
                                  (setq notmuch-hello-hidden-sections
                                        (delete ,title notmuch-hello-hidden-sections))
                                  (notmuch-hello-update))
                       "show")
       (widget-create 'push-button
-                    :notify `(lambda (widget &rest ignore)
+                    :notify `(lambda (widget &rest _ignore)
                                (add-to-list 'notmuch-hello-hidden-sections
                                             ,title)
                                (notmuch-hello-update))
@@ -950,19 +919,21 @@ following:
     (widget-insert "Hit `?' for context-sensitive help in any Notmuch screen.\n")
     (widget-insert "Customize ")
     (widget-create 'link
-                  :notify (lambda (&rest ignore)
+                  :notify (lambda (&rest _ignore)
                             (customize-group 'notmuch))
                   :button-prefix "" :button-suffix ""
                   "Notmuch")
     (widget-insert " or ")
     (widget-create 'link
-                  :notify (lambda (&rest ignore)
+                  :notify (lambda (&rest _ignore)
                             (customize-variable 'notmuch-hello-sections))
                   :button-prefix "" :button-suffix ""
                   "this page.")
     (let ((fill-column (- (window-width) notmuch-hello-indent)))
       (center-region start (point)))))
 
+;;; Hello!
+
 ;;;###autoload
 (defun notmuch-hello (&optional no-display)
   "Run notmuch and display saved searches, known tags, etc."
@@ -1014,12 +985,7 @@ following:
   (run-hooks 'notmuch-hello-refresh-hook)
   (setq notmuch-hello-first-run nil))
 
-(defun notmuch-folder ()
-  "Deprecated function for invoking notmuch---calling `notmuch' is preferred now."
-  (interactive)
-  (notmuch-hello))
-
-;;
+;;; _
 
 (provide 'notmuch-hello)
 
index 1e2d0497949322c26cd2c453ae215336551156d6..6fab5a792ec6b4da7daaacd2ad789653403b49ad 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-jump.el --- User-friendly shortcut keys
+;;; notmuch-jump.el --- User-friendly shortcut keys  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Austin Clements
 ;;
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl-lib)
-  (require 'pcase))
-
 (require 'notmuch-lib)
 (require 'notmuch-hello)
 
-(eval-and-compile
-  (unless (fboundp 'window-body-width)
-    ;; Compatibility for Emacs pre-24
-    (defalias 'window-body-width 'window-width)))
-
 ;;;###autoload
 (defun notmuch-jump-search ()
   "Jump to a saved search by shortcut key.
@@ -68,8 +59,8 @@ fast way to jump to a saved search from anywhere in Notmuch."
     (setq action-map (nreverse action-map))
     (if action-map
        (notmuch-jump action-map "Search: ")
-      (error "To use notmuch-jump, \
-please customize shortcut keys in notmuch-saved-searches."))))
+      (error "To use notmuch-jump, %s"
+            "please customize shortcut keys in notmuch-saved-searches."))))
 
 (defvar notmuch-jump--action nil)
 
@@ -125,7 +116,7 @@ ACTION-MAP.  These strings can be inserted into a tabular
 buffer."
   ;; Compute the maximum key description width
   (let ((key-width 1))
-    (pcase-dolist (`(,key ,desc) action-map)
+    (pcase-dolist (`(,key ,_desc) action-map)
       (setq key-width
            (max key-width
                 (string-width (format-kbd-macro key)))))
@@ -169,7 +160,7 @@ buffer."
   "Translate ACTION-MAP into a minibuffer keymap."
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map notmuch-jump-minibuffer-map)
-    (pcase-dolist (`(,key ,name ,fn) action-map)
+    (pcase-dolist (`(,key ,_name ,fn) action-map)
       (when (= (length key) 1)
        (define-key map key
          `(lambda () (interactive)
@@ -178,7 +169,7 @@ buffer."
     ;; By doing this in two passes (and checking if we already have a
     ;; binding) we avoid problems if the user specifies a binding which
     ;; is a prefix of another binding.
-    (pcase-dolist (`(,key ,name ,fn) action-map)
+    (pcase-dolist (`(,key ,_name ,_fn) action-map)
       (when (> (length key) 1)
        (let* ((key (elt key 0))
               (keystr (string key))
@@ -203,8 +194,6 @@ buffer."
                 (exit-minibuffer)))))))
     map))
 
-;;
-
 (provide 'notmuch-jump)
 
 ;;; notmuch-jump.el ends here
index 118faf1e37bddb1a9e5b0fad8374ac8fb4361941..c7bb2091f8edcc457ed2f36569ce9bf744c90253 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-lib.el --- common variables, functions and function declarations
+;;; notmuch-lib.el --- common variables, functions and function declarations  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Carl Worth
 ;;
@@ -22,6 +22,8 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'pcase)
+(require 'subr-x)
 
 (require 'mm-util)
 (require 'mm-view)
@@ -33,6 +35,8 @@
   (defconst notmuch-emacs-version "unknown"
     "Placeholder variable when notmuch-version.el[c] is not available."))
 
+;;; Groups
+
 (defgroup notmuch nil
   "Notmuch mail reader for Emacs."
   :group 'mail)
@@ -78,6 +82,8 @@
   "Graphical attributes for displaying text"
   :group 'notmuch)
 
+;;; Options
+
 (defcustom notmuch-command "notmuch"
   "Name of the notmuch binary.
 
@@ -97,6 +103,7 @@ search results. Note that any filtered searches created by
 search."
   :type 'boolean
   :group 'notmuch-search)
+(make-variable-buffer-local 'notmuch-search-oldest-first)
 
 (defcustom notmuch-poll-script nil
   "[Deprecated] Command to run to incorporate new mail into the notmuch database.
@@ -125,11 +132,6 @@ the user's needs:
                 (string :tag "Custom script"))
   :group 'notmuch-external)
 
-;;
-
-(defvar notmuch-search-history nil
-  "Variable to store notmuch searches history.")
-
 (defcustom notmuch-archive-tags '("-inbox")
   "List of tag changes to apply to a message or a thread when it is archived.
 
@@ -144,9 +146,15 @@ For example, if you wanted to remove an \"inbox\" tag and add an
   :group 'notmuch-search
   :group 'notmuch-show)
 
+;;; Variables
+
+(defvar notmuch-search-history nil
+  "Variable to store notmuch searches history.")
+
 (defvar notmuch-common-keymap
   (let ((map (make-sparse-keymap)))
     (define-key map "?" 'notmuch-help)
+    (define-key map "v" 'notmuch-version)
     (define-key map "q" 'notmuch-bury-or-kill-this-buffer)
     (define-key map "s" 'notmuch-search)
     (define-key map "t" 'notmuch-search-by-tag)
@@ -176,6 +184,8 @@ For example, if you wanted to remove an \"inbox\" tag and add an
                  (select-window (posn-window (event-start last-input-event)))
                  (button-activate button)))
 
+;;; CLI Utilities
+
 (defun notmuch-command-to-string (&rest args)
   "Synchronously invoke \"notmuch\" with the given list of arguments.
 
@@ -185,8 +195,8 @@ will be signaled.
 
 Otherwise the output will be returned."
   (with-temp-buffer
-    (let* ((status (apply #'call-process notmuch-command nil t nil args))
-          (output (buffer-string)))
+    (let ((status (apply #'call-process notmuch-command nil t nil args))
+         (output (buffer-string)))
       (notmuch-check-exit-status status (cons notmuch-command args) output)
       output)))
 
@@ -218,13 +228,31 @@ on the command line, and then retry your notmuch command")))
        (match-string 2 long-string)
       "unknown")))
 
+(defvar notmuch-emacs-version)
+
+(defun notmuch-version ()
+  "Display the notmuch version.
+The versions of the Emacs package and the `notmuch' executable
+should match, but if and only if they don't, then this command
+displays both values separately."
+  (interactive)
+  (let ((cli-version (notmuch-cli-version)))
+    (message "notmuch version %s"
+            (if (string= notmuch-emacs-version cli-version)
+                cli-version
+              (concat cli-version
+                      " (emacs mua version " notmuch-emacs-version ")")))))
+
+;;; Notmuch Configuration
+
 (defun notmuch-config-get (item)
   "Return a value from the notmuch configuration."
   (let* ((val (notmuch-command-to-string "config" "get" item))
         (len (length val)))
     ;; Trim off the trailing newline (if the value is empty or not
-    ;; configured, there will be no newline)
-    (if (and (> len 0) (= (aref val (- len 1)) ?\n))
+    ;; configured, there will be no newline).
+    (if (and (> len 0)
+            (= (aref val (- len 1)) ?\n))
        (substring val 0 -1)
       val)))
 
@@ -247,6 +275,8 @@ on the command line, and then retry your notmuch command")))
 (defun notmuch-user-emails ()
   (cons (notmuch-user-primary-email) (notmuch-user-other-email)))
 
+;;; Commands
+
 (defun notmuch-poll ()
   "Run \"notmuch new\" or an external script to import mail.
 
@@ -255,7 +285,7 @@ depending on the value of `notmuch-poll-script'."
   (interactive)
   (message "Polling mail...")
   (if (stringp notmuch-poll-script)
-      (unless (string= notmuch-poll-script "")
+      (unless (string-empty-p notmuch-poll-script)
        (unless (equal (call-process notmuch-poll-script nil nil) 0)
          (error "Notmuch: poll script `%s' failed!" notmuch-poll-script)))
     (notmuch-call-notmuch-process "new"))
@@ -271,17 +301,7 @@ it, in which case it is killed."
       (bury-buffer)
     (kill-buffer)))
 
-(defun notmuch-documentation-first-line (symbol)
-  "Return the first line of the documentation string for SYMBOL."
-  (let ((doc (documentation symbol)))
-    (if doc
-       (with-temp-buffer
-         (insert (documentation symbol t))
-         (goto-char (point-min))
-         (let ((beg (point)))
-           (end-of-line)
-           (buffer-substring beg (point))))
-      "")))
+;;; Describe Key Bindings
 
 (defun notmuch-prefix-key-description (key)
   "Given a prefix key code, return a human-readable string representation.
@@ -293,7 +313,6 @@ This is basically just `format-kbd-macro' but we also convert ESC to M-."
        "M-"
       (concat desc " "))))
 
-
 (defun notmuch-describe-key (actual-key binding prefix ua-keys tail)
   "Prepend cons cells describing prefix-arg ACTUAL-KEY and ACTUAL-KEY to TAIL.
 
@@ -315,7 +334,10 @@ It does not prepend if ACTUAL-KEY is already listed in TAIL."
                  (or (and (symbolp binding)
                           (get binding 'notmuch-doc))
                      (and (functionp binding)
-                          (notmuch-documentation-first-line binding))))
+                          (let ((doc (documentation binding)))
+                            (and doc
+                                 (string-match "\\`.+" doc)
+                                 (match-string 0 doc))))))
            tail)))
   tail)
 
@@ -396,9 +418,9 @@ A command that supports a prefix argument can explicitly document
 its prefixed behavior by setting the 'notmuch-prefix-doc property
 of its command symbol."
   (interactive)
-  (let* ((mode major-mode)
-        (doc (substitute-command-keys
-              (notmuch-substitute-command-keys (documentation mode t)))))
+  (let ((doc (substitute-command-keys
+             (notmuch-substitute-command-keys
+              (documentation major-mode t)))))
     (with-current-buffer (generate-new-buffer "*notmuch-help*")
       (insert doc)
       (goto-char (point-min))
@@ -428,9 +450,10 @@ of its command symbol."
          (insert desc)))
       (pop-to-buffer (help-buffer)))))
 
-(defvar notmuch-buffer-refresh-function nil
+;;; Refreshing Buffers
+
+(defvar-local notmuch-buffer-refresh-function nil
   "Function to call to refresh the current buffer.")
-(make-variable-buffer-local 'notmuch-buffer-refresh-function)
 
 (defun notmuch-refresh-this-buffer ()
   "Refresh the current buffer."
@@ -460,9 +483,11 @@ be displayed."
        (with-current-buffer buffer
          (notmuch-refresh-this-buffer))))))
 
+;;; String Utilities
+
 (defun notmuch-prettify-subject (subject)
-  ;; This function is used by `notmuch-search-process-filter' which
-  ;; requires that we not disrupt its' matching state.
+  ;; This function is used by `notmuch-search-process-filter',
+  ;; which requires that we not disrupt its matching state.
   (save-match-data
     (if (and subject
             (string-match "^[ \t]*$" subject))
@@ -503,8 +528,6 @@ This replaces spaces, percents, and double quotes in STR with
   (replace-regexp-in-string
    "[ %\"]" (lambda (match) (format "%%%02x" (aref match 0))) str))
 
-;;
-
 (defun notmuch-common-do-stash (text)
   "Common function to stash text in kill ring, and display in minibuffer."
   (if text
@@ -516,39 +539,32 @@ This replaces spaces, percents, and double quotes in STR with
     (kill-new "")
     (message "Nothing to stash!")))
 
-;;
-
-(defun notmuch-remove-if-not (predicate list)
-  "Return a copy of LIST with all items not satisfying PREDICATE removed."
-  (let (out)
-    (while list
-      (when (funcall predicate (car list))
-       (push (car list) out))
-      (setq list (cdr list)))
-    (nreverse out)))
+;;; Generic Utilities
 
 (defun notmuch-plist-delete (plist property)
-  (let* ((xplist (cons nil plist))
-        (pred xplist))
-    (while (cdr pred)
-      (when (eq (cadr pred) property)
-       (setcdr pred (cdddr pred)))
-      (setq pred (cddr pred)))
-    (cdr xplist)))
-
-(defun notmuch-split-content-type (content-type)
-  "Split content/type into 'content' and 'type'."
-  (split-string content-type "/"))
+  (let (p)
+    (while plist
+      (unless (eq property (car plist))
+       (setq p (plist-put p (car plist) (cadr plist))))
+      (setq plist (cddr plist)))
+    p))
+
+;;; MML Utilities
 
 (defun notmuch-match-content-type (t1 t2)
-  "Return t if t1 and t2 are matching content types, taking wildcards into account."
-  (let ((st1 (notmuch-split-content-type t1))
-       (st2 (notmuch-split-content-type t2)))
-    (if (or (string= (cadr st1) "*")
-           (string= (cadr st2) "*"))
-       ;; Comparison of content types should be case insensitive.
-       (string= (downcase (car st1)) (downcase (car st2)))
-      (string= (downcase t1) (downcase t2)))))
+  "Return t if t1 and t2 are matching content types.
+Take wildcards into account."
+  (and (stringp t1)
+       (stringp t2)
+       (let ((st1 (split-string t1 "/"))
+            (st2 (split-string t2 "/")))
+        (if (or (string= (cadr st1) "*")
+                (string= (cadr st2) "*"))
+            ;; Comparison of content types should be case insensitive.
+            (string= (downcase (car st1))
+                     (downcase (car st2)))
+          (string= (downcase t1)
+                   (downcase t2))))))
 
 (defvar notmuch-multipart/alternative-discouraged
   '(;; Avoid HTML parts.
@@ -653,18 +669,6 @@ If CACHE is non-nil, the content of this part will be saved in
 MSG (if it isn't already)."
   (notmuch--get-bodypart-raw msg part process-crypto nil cache))
 
-;; Workaround: The call to `mm-display-part' below triggers a bug in
-;; Emacs 24 if it attempts to use the shr renderer to display an HTML
-;; part with images in it (demonstrated in 24.1 and 24.2 on Debian and
-;; Fedora 17, though unreproducible in other configurations).
-;; `mm-shr' references the variable `gnus-inhibit-images' without
-;; first loading gnus-art, which defines it, resulting in a
-;; void-variable error.  Hence, we advise `mm-shr' to ensure gnus-art
-;; is loaded.
-(define-advice mm-shr (:before (_handle) notmuch--load-gnus-args)
-  "Require `gnus-art' since we use its variables."
-  (require 'gnus-art nil t))
-
 (defun notmuch-mm-display-part-inline (msg part content-type process-crypto)
   "Use the mm-decode/mm-view functions to display a part in the
 current buffer, if possible."
@@ -692,6 +696,8 @@ current buffer, if possible."
            (mm-display-part handle)
            t))))))
 
+;;; Generic Utilities
+
 ;; Converts a plist of headers to an alist of headers. The input plist should
 ;; have symbols of the form :Header as keys, and the resulting alist will have
 ;; symbols of the form 'Header as keys.
@@ -758,6 +764,8 @@ returned by FUNC."
       (put-text-property start next prop (funcall func value) object)
       (setq start next))))
 
+;;; Running Notmuch
+
 (defun notmuch-logged-error (msg &optional extra)
   "Log MSG and EXTRA to *Notmuch errors* and signal MSG.
 
@@ -819,20 +827,27 @@ You may need to restart Emacs or upgrade your notmuch Emacs package."))
 Emacs requested a newer output format than supported by the notmuch CLI.
 You may need to restart Emacs or upgrade your notmuch package."))
    (t
-    (let* ((command-string
-           (mapconcat (lambda (arg)
-                        (shell-quote-argument
-                         (cond ((stringp arg) arg)
-                               ((symbolp arg) (symbol-name arg))
-                               (t "*UNKNOWN ARGUMENT*"))))
-                      command " "))
-          (extra
-           (concat "command: " command-string "\n"
-                   (if (integerp exit-status)
-                       (format "exit status: %s\n" exit-status)
-                     (format "exit signal: %s\n" exit-status))
-                   (and err    (concat "stderr:\n" err))
-                   (and output (concat "stdout:\n" output)))))
+    (pcase-let*
+       ((`(,command . ,args) command)
+        (command (if (equal (file-name-nondirectory command)
+                            notmuch-command)
+                     notmuch-command
+                   command))
+        (command-string
+         (mapconcat (lambda (arg)
+                      (shell-quote-argument
+                       (cond ((stringp arg) arg)
+                             ((symbolp arg) (symbol-name arg))
+                             (t "*UNKNOWN ARGUMENT*"))))
+                    (cons command args)
+                    " "))
+        (extra
+         (concat "command: " command-string "\n"
+                 (if (integerp exit-status)
+                     (format "exit status: %s\n" exit-status)
+                   (format "exit signal: %s\n" exit-status))
+                 (and err    (concat "stderr:\n" err))
+                 (and output (concat "stdout:\n" output)))))
       (if err
          ;; We have an error message straight from the CLI.
          (notmuch-logged-error
@@ -840,7 +855,7 @@ You may need to restart Emacs or upgrade your notmuch package."))
        ;; We only have combined output from the CLI; don't inundate
        ;; the user with it.  Mimic `process-lines'.
        (notmuch-logged-error (format "%s exited with status %s"
-                                     (car command) exit-status)
+                                     command exit-status)
                              extra))
       ;; `notmuch-logged-error' does not return.
       ))))
@@ -915,56 +930,29 @@ when the process exits, or nil for none.  The caller must *not*
 invoke `set-process-sentinel' directly on the returned process,
 as that will interfere with the handling of stderr and the exit
 status."
-  (let (err-file err-buffer proc err-proc
-                ;; Find notmuch using Emacs' `exec-path'
-                (command (or (executable-find notmuch-command)
-                             (error "Command not found: %s" notmuch-command))))
-    (if (fboundp 'make-process)
-       (progn
-         (setq err-buffer (generate-new-buffer " *notmuch-stderr*"))
-         ;; Emacs 25 and newer has `make-process', which allows
-         ;; redirecting stderr independently from stdout to a
-         ;; separate buffer. As this allows us to avoid using a
-         ;; temporary file and shell invocation, use it when
-         ;; available.
-         (setq proc (make-process
-                     :name name
-                     :buffer buffer
-                     :command (cons command args)
-                     :connection-type 'pipe
-                     :stderr err-buffer))
-         (setq err-proc (get-buffer-process err-buffer))
-         (process-put proc 'err-buffer err-buffer)
-
-         (process-put err-proc 'err-file err-file)
-         (process-put err-proc 'err-buffer err-buffer)
-         (set-process-sentinel err-proc #'notmuch-start-notmuch-error-sentinel))
-      ;; On Emacs versions before 25, there is no way to capture
-      ;; stdout and stderr separately for asynchronous processes, or
-      ;; even to redirect stderr to a file, so we use a trivial shell
-      ;; wrapper to send stderr to a temporary file and clean things
-      ;; up in the sentinel.
-      (setq err-file (make-temp-file "nmerr"))
-      (let ((process-connection-type nil)) ;; Use a pipe
-       (setq proc (apply #'start-process name buffer
-                         "/bin/sh" "-c"
-                         "exec 2>\"$1\"; shift; exec \"$0\" \"$@\""
-                         command err-file args)))
-      (process-put proc 'err-file err-file))
+  (let* ((command (or (executable-find notmuch-command)
+                     (error "Command not found: %s" notmuch-command)))
+        (err-buffer (generate-new-buffer " *notmuch-stderr*"))
+        (proc (make-process
+               :name name
+               :buffer buffer
+               :command (cons command args)
+               :connection-type 'pipe
+               :stderr err-buffer))
+        (err-proc (get-buffer-process err-buffer)))
+    (process-put proc 'err-buffer err-buffer)
     (process-put proc 'sub-sentinel sentinel)
-    (process-put proc 'real-command (cons notmuch-command args))
     (set-process-sentinel proc #'notmuch-start-notmuch-sentinel)
+    (set-process-sentinel err-proc #'notmuch-start-notmuch-error-sentinel)
     proc))
 
 (defun notmuch-start-notmuch-sentinel (proc event)
   "Process sentinel function used by `notmuch-start-notmuch'."
-  (let* ((err-file (process-get proc 'err-file))
-        (err-buffer (or (process-get proc 'err-buffer)
-                        (find-file-noselect err-file)))
-        (err (and (not (zerop (buffer-size err-buffer)))
+  (let* ((err-buffer (process-get proc 'err-buffer))
+        (err (and (buffer-live-p err-buffer)
+                  (not (zerop (buffer-size err-buffer)))
                   (with-current-buffer err-buffer (buffer-string))))
-        (sub-sentinel (process-get proc 'sub-sentinel))
-        (real-command (process-get proc 'real-command)))
+        (sub-sentinel (process-get proc 'sub-sentinel)))
     (condition-case err
        (progn
          ;; Invoke the sub-sentinel, if any
@@ -976,7 +964,7 @@ status."
          ;; and there's no point in telling the user that (but we
          ;; still check for and report stderr output below).
          (when (buffer-live-p (process-buffer proc))
-           (notmuch-check-async-exit-status proc event real-command err))
+           (notmuch-check-async-exit-status proc event nil err))
          ;; If that didn't signal an error, then any error output was
          ;; really warning output.  Show warnings, if any.
          (let ((warnings
@@ -996,21 +984,17 @@ status."
       (error
        ;; Emacs behaves strangely if an error escapes from a sentinel,
        ;; so turn errors into messages.
-       (message "%s" (error-message-string err))))
-    (when err-file (ignore-errors (delete-file err-file)))))
-
-(defun notmuch-start-notmuch-error-sentinel (proc event)
-  (let* ((err-file (process-get proc 'err-file))
-        ;; When `make-process' is available, use the error buffer
-        ;; associated with the process, otherwise the error file.
-        (err-buffer (or (process-get proc 'err-buffer)
-                        (find-file-noselect err-file))))
-    (when err-buffer (kill-buffer err-buffer))))
-
-;; This variable is used only buffer local, but it needs to be
-;; declared globally first to avoid compiler warnings.
-(defvar notmuch-show-process-crypto nil)
-(make-variable-buffer-local 'notmuch-show-process-crypto)
+       (message "%s" (error-message-string err))))))
+
+(defun notmuch-start-notmuch-error-sentinel (proc _event)
+  (unless (process-live-p proc)
+    (let ((buffer (process-buffer proc)))
+      (when (buffer-live-p buffer)
+       (kill-buffer buffer)))))
+
+(defvar-local notmuch-show-process-crypto nil)
+
+;;; Generic Utilities
 
 (defun notmuch-interactive-region ()
   "Return the bounds of the current interactive region.
@@ -1026,6 +1010,8 @@ region if the region is active, or both `point' otherwise."
   'notmuch-interactive-region
   "notmuch 0.29")
 
+;;; _
+
 (provide 'notmuch-lib)
 
 ;;; notmuch-lib.el ends here
index a9103a2069932b8fb050898ddf6b74578d5c428d..ae8f5140f34d2b2283bc9507b0744c6f30640700 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-maildir-fcc.el --- inserting using a fcc handler
+;;; notmuch-maildir-fcc.el --- inserting using a fcc handler  -*- lexical-binding: t -*-
 
 ;; Copyright © Jesse Rosenthal
 ;;
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
-
 (require 'message)
 
 (require 'notmuch-lib)
 
 (defvar notmuch-maildir-fcc-count 0)
 
+;;; Options
+
 (defcustom notmuch-fcc-dirs "sent"
   "Determines the Fcc Header which says where to save outgoing mail.
 
@@ -76,23 +76,20 @@ directory if it does not exist yet when sending a mail."
   :require 'notmuch-fcc-initialization
   :group 'notmuch-send)
 
-(defcustom notmuch-maildir-use-notmuch-insert 't
+(defcustom notmuch-maildir-use-notmuch-insert t
   "Should fcc use notmuch insert instead of simple fcc."
   :type '(choice :tag "Fcc Method"
                 (const :tag "Use notmuch insert" t)
                 (const :tag "Use simple fcc" nil))
   :group 'notmuch-send)
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Functions which set up the fcc header in the message buffer.
+;;; Functions which set up the fcc header in the message buffer.
 
 (defun notmuch-fcc-header-setup ()
   "Add an Fcc header to the current message buffer.
 
-Sets the Fcc header based on the values of `notmuch-fcc-dirs'.
-
-Originally intended to be use a hook function, but now called directly
-by notmuch-mua-mail."
+If the Fcc header is already set, then keep it as-is.
+Otherwise set it according to `notmuch-fcc-dirs'."
   (let ((subdir
         (cond
          ((or (not notmuch-fcc-dirs)
@@ -106,16 +103,13 @@ by notmuch-mua-mail."
           ;; Old style - no longer works.
           (error "Invalid `notmuch-fcc-dirs' setting (old style)"))
          ((listp notmuch-fcc-dirs)
-          (let* ((from (message-field-value "From"))
-                 (match
-                  (catch 'first-match
-                    (dolist (re-folder notmuch-fcc-dirs)
-                      (when (string-match-p (car re-folder) from)
-                        (throw 'first-match re-folder))))))
-            (if match
-                (cdr match)
-              (message "No Fcc header added.")
-              nil)))
+          (or (seq-some (let ((from (message-field-value "From")))
+                          (pcase-lambda (`(,regexp . ,folder))
+                            (and (string-match-p regexp from)
+                                 folder)))
+                        notmuch-fcc-dirs)
+              (progn (message "No Fcc header added.")
+                     nil)))
          (t
           (error "Invalid `notmuch-fcc-dirs' setting (neither string nor list)")))))
     (when subdir
@@ -127,9 +121,9 @@ by notmuch-mua-mail."
   ;; Notmuch insert does not accept absolute paths, so check the user
   ;; really want this header inserted.
   (when (or (not (= (elt subdir 0) ?/))
-           (y-or-n-p
-            (format "Fcc header %s is an absolute path and notmuch insert is requested.
-Insert header anyway? " subdir)))
+           (y-or-n-p (format "Fcc header %s is an absolute path %s %s" subdir
+                             "and notmuch insert is requested."
+                             "Insert header anyway? ")))
     (message-add-header (concat "Fcc: " subdir))))
 
 (defun notmuch-maildir-add-file-style-fcc-header (subdir)
@@ -142,9 +136,7 @@ Insert header anyway? " subdir)))
                subdir
              (concat (notmuch-database-path) "/" subdir))))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Functions for saving a message either using notmuch insert or file
-;; fcc. First functions common to the two cases.
+;;; Functions for saving a message using either method.
 
 (defmacro with-temporary-notmuch-message-buffer (&rest body)
   "Set-up a temporary copy of the current message-mode buffer."
@@ -157,8 +149,9 @@ Insert header anyway? " subdir)))
        ,@body)))
 
 (defun notmuch-maildir-setup-message-for-saving ()
-  "Setup message for saving. Should be called on a temporary copy.
+  "Setup message for saving.
 
+This should be called on a temporary copy.
 This is taken from the function message-do-fcc."
   (message-encode-message-body)
   (save-restriction
@@ -174,7 +167,7 @@ This is taken from the function message-do-fcc."
   "Process Fcc headers in the current buffer.
 
 This is a rearranged version of message mode's message-do-fcc."
-  (let (list file)
+  (let (files file)
     (save-excursion
       (save-restriction
        (message-narrow-to-headers)
@@ -184,28 +177,26 @@ This is a rearranged version of message mode's message-do-fcc."
         (save-restriction
           (message-narrow-to-headers)
           (while (setq file (message-fetch-field "fcc" t))
-            (push file list)
+            (push file files)
             (message-remove-header "fcc" nil t)))
         (notmuch-maildir-setup-message-for-saving)
         ;; Process FCC operations.
-        (while list
-          (setq file (pop list))
-          (notmuch-fcc-handler file))
+        (mapc #'notmuch-fcc-handler files)
         (kill-buffer (current-buffer)))))))
 
 (defun notmuch-fcc-handler (fcc-header)
   "Store message with notmuch insert or normal (file) fcc.
 
-If `notmuch-maildir-use-notmuch-insert` is set then store the
+If `notmuch-maildir-use-notmuch-insert' is set then store the
 message using notmuch insert. Otherwise store the message using
 normal fcc."
   (message "Doing Fcc...")
   (if notmuch-maildir-use-notmuch-insert
       (notmuch-maildir-fcc-with-notmuch-insert fcc-header)
-    (notmuch-maildir-fcc-file-fcc fcc-header)))
+    (notmuch-maildir-fcc-file-fcc fcc-header))
+  (message "Doing Fcc...done"))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Functions for saving a message using notmuch insert.
+;;; Functions for saving a message using notmuch insert.
 
 (defun notmuch-maildir-notmuch-insert-current-buffer (folder &optional create tags)
   "Use notmuch insert to put the current buffer in the database.
@@ -214,11 +205,11 @@ This inserts the current buffer as a message into the notmuch
 database in folder FOLDER. If CREATE is non-nil it will supply
 the --create-folder flag to create the folder if necessary. TAGS
 should be a list of tag changes to apply to the inserted message."
-  (let* ((args (append (and create (list "--create-folder"))
-                      (list (concat "--folder=" folder))
-                      tags)))
-    (apply 'notmuch-call-notmuch-process
-          :stdin-string (buffer-string) "insert" args)))
+  (apply 'notmuch-call-notmuch-process
+        :stdin-string (buffer-string) "insert"
+        (append (and create (list "--create-folder"))
+                (list (concat "--folder=" folder))
+                tags)))
 
 (defun notmuch-maildir-fcc-with-notmuch-insert (fcc-header &optional create)
   "Store message with notmuch insert.
@@ -232,9 +223,8 @@ quoting each space with an immediately preceding backslash
 or surrounding the entire folder name in double quotes.
 
 If CREATE is non-nil then create the folder if necessary."
-  (let* ((args (split-string-and-unquote fcc-header))
-        (folder (car args))
-        (tags (cdr args)))
+  (pcase-let ((`(,folder . ,tags)
+              (split-string-and-unquote fcc-header)))
     (condition-case nil
        (notmuch-maildir-notmuch-insert-current-buffer folder create tags)
       ;; Since there are many reasons notmuch insert could fail, e.g.,
@@ -246,14 +236,12 @@ If CREATE is non-nil then create the folder if necessary."
 \(r)etry, (c)reate folder, (i)gnore, or (e)dit the header? " '(?r ?c ?i ?e))))
         (cl-case response
           (?r (notmuch-maildir-fcc-with-notmuch-insert fcc-header))
-          (?c (notmuch-maildir-fcc-with-notmuch-insert fcc-header 't))
-          (?i 't)
+          (?c (notmuch-maildir-fcc-with-notmuch-insert fcc-header t))
+          (?i t)
           (?e (notmuch-maildir-fcc-with-notmuch-insert
                (read-from-minibuffer "Fcc header: " fcc-header)))))))))
 
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Functions for saving a message using file fcc.
+;;; Functions for saving a message using file fcc.
 
 (defun notmuch-maildir-fcc-host-fixer (hostname)
   (replace-regexp-in-string "/\\|:"
@@ -269,7 +257,7 @@ If CREATE is non-nil then create the folder if necessary."
   (let* ((ftime (float-time))
         (microseconds (mod (* 1000000 ftime) 1000000))
         (hostname (notmuch-maildir-fcc-host-fixer (system-name))))
-    (setq notmuch-maildir-fcc-count (+ notmuch-maildir-fcc-count 1))
+    (cl-incf notmuch-maildir-fcc-count)
     (format "%d.%d_%d_%d.%s"
            ftime
            (emacs-pid)
@@ -302,9 +290,7 @@ if successful, nil if not."
           (write-file (concat destdir "/tmp/" msg-id))
           msg-id)
          (t
-          (error (format "Can't write to %s. Not a maildir."
-                         destdir))
-          nil))))
+          (error "Can't write to %s. Not a maildir." destdir)))))
 
 (defun notmuch-maildir-fcc-move-tmp-to-new (destdir msg-id)
   (add-name-to-file
@@ -319,10 +305,10 @@ if successful, nil if not."
 (defun notmuch-maildir-fcc-file-fcc (fcc-header)
   "Write the message to the file specified by FCC-HEADER.
 
-It offers the user a chance to correct the header, or filesystem,
-if needed."
+If that fails, then offer the user a chance to correct the header
+or filesystem."
   (if (notmuch-maildir-fcc-dir-is-maildir-p fcc-header)
-      (notmuch-maildir-fcc-write-buffer-to-maildir fcc-header 't)
+      (notmuch-maildir-fcc-write-buffer-to-maildir fcc-header t)
     ;; The fcc-header is not a valid maildir see if the user wants to
     ;; fix it in some way.
     (let* ((prompt (format "Fcc %s is not a maildir: \
@@ -335,33 +321,33 @@ if needed."
              (message "No permission to create %s." fcc-header)
              (sit-for 2))
            (notmuch-maildir-fcc-file-fcc fcc-header))
-       (?i 't)
+       (?i t)
        (?e (notmuch-maildir-fcc-file-fcc
             (read-from-minibuffer "Fcc header: " fcc-header)))))))
 
 (defun notmuch-maildir-fcc-write-buffer-to-maildir (destdir &optional mark-seen)
-  "Writes the current buffer to maildir destdir. If mark-seen is
-non-nil, it will write it to cur/, and mark it as read. It should
-return t if successful, and nil otherwise."
+  "Write the current buffer to maildir destdir.
+
+If mark-seen is non-nil, then write it to \"cur/\", and mark it
+as read, otherwise write it to \"new/\". Return t if successful,
+and nil otherwise."
   (let ((orig-buffer (buffer-name)))
     (with-temp-buffer
       (insert-buffer-substring orig-buffer)
       (catch 'link-error
        (let ((msg-id (notmuch-maildir-fcc-save-buffer-to-tmp destdir)))
          (when msg-id
-           (cond (mark-seen
-                  (condition-case err
-                      (notmuch-maildir-fcc-move-tmp-to-cur destdir msg-id t)
-                    (file-already-exists
-                     (throw 'link-error nil))))
-                 (t
-                  (condition-case err
-                      (notmuch-maildir-fcc-move-tmp-to-new destdir msg-id)
-                    (file-already-exists
-                     (throw 'link-error nil))))))
+           (condition-case nil
+               (if mark-seen
+                   (notmuch-maildir-fcc-move-tmp-to-cur destdir msg-id t)
+                 (notmuch-maildir-fcc-move-tmp-to-new destdir msg-id))
+             (file-already-exists
+              (throw 'link-error nil))))
          (delete-file (concat destdir "/tmp/" msg-id))))
       t)))
 
+;;; _
+
 (provide 'notmuch-maildir-fcc)
 
 ;;; notmuch-maildir-fcc.el ends here
index c224207098556b1c34a40572f6b90aa008b06dc4..0856a2e943e6e4cb38d38759d976a512651edb4b 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-message.el --- message-mode functions specific to notmuch
+;;; notmuch-message.el --- message-mode functions specific to notmuch  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Jesse Rosenthal
 ;;
 
 ;;; Code:
 
+(require 'cl-lib)
+(require 'pcase)
+(require 'subr-x)
+
 (require 'message)
 (require 'notmuch-tag)
 
@@ -50,21 +54,20 @@ the \"inbox\" tag, you would set:
   :type '(repeat string)
   :group 'notmuch-send)
 
-(defconst notmuch-message-queued-tag-changes nil
-  "List of messages and corresponding tag-changes to be applied when sending a message.
+(defvar-local notmuch-message-queued-tag-changes nil
+  "List of tag changes to be applied when sending a message.
 
-This variable is overridden by buffer-local versions in message
-buffers where tag changes should be triggered when sending off
-the message.  Each item in this list is a list of strings, where
-the first is a notmuch query and the rest are the tag changes to
-be applied to the matching messages.")
+A list of queries and tag changes that are to be applied to them
+when the message that was composed in the current buffer is being
+send.  Each item in this list is a list of strings, where the
+first is a notmuch query and the rest are the tag changes to be
+applied to the matching messages.")
 
 (defun notmuch-message-apply-queued-tag-changes ()
   ;; Apply the tag changes queued in the buffer-local variable
   ;; notmuch-message-queued-tag-changes.
-  (dolist (query-and-tags notmuch-message-queued-tag-changes)
-    (notmuch-tag (car query-and-tags)
-                (cdr query-and-tags))))
+  (pcase-dolist (`(,query . ,tags) notmuch-message-queued-tag-changes)
+    (notmuch-tag query tags)))
 
 (add-hook 'message-send-hook 'notmuch-message-apply-queued-tag-changes)
 
index 03c7cc97364f83c4e9f24d7193e444c10b423653..bbf059a22cb5487f669497631363a7c924b1d3d8 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-mua.el --- emacs style mail-user-agent
+;;; notmuch-mua.el --- emacs style mail-user-agent  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © David Edmondson
 ;;
@@ -21,8 +21,6 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
-
 (require 'message)
 (require 'mm-view)
 (require 'format-spec)
 (declare-function notmuch-draft-postpone "notmuch-draft" ())
 (declare-function notmuch-draft-save "notmuch-draft" ())
 
-;;
+(defvar notmuch-show-indent-multipart)
+(defvar notmuch-show-insert-header-p-function)
+(defvar notmuch-show-max-text-part-size)
+(defvar notmuch-show-insert-text/plain-hook)
+
+;;; Options
 
 (defcustom notmuch-mua-send-hook nil
   "Hook run before sending messages."
@@ -47,8 +50,7 @@
   :group 'notmuch-hooks)
 
 (defcustom notmuch-mua-compose-in 'current-window
-  (concat
-   "Where to create the mail buffer used to compose a new message.
+  "Where to create the mail buffer used to compose a new message.
 Possible values are `current-window' (default), `new-window' and
 `new-frame'. If set to `current-window', the mail buffer will be
 displayed in the current window, so the old buffer will be
@@ -57,18 +59,14 @@ or `new-frame', the mail buffer will be displayed in a new
 window/frame that will be destroyed when the buffer is killed.
 You may want to customize `message-kill-buffer-on-exit'
 accordingly."
-   (when (< emacs-major-version 24)
-     " Due to a known bug in Emacs 23, you should not set
-this to `new-window' if `message-kill-buffer-on-exit' is
-disabled: this would result in an incorrect behavior."))
   :group 'notmuch-send
   :type '(choice (const :tag "Compose in the current window" current-window)
                 (const :tag "Compose mail in a new window"  new-window)
                 (const :tag "Compose mail in a new frame"   new-frame)))
 
 (defcustom notmuch-mua-user-agent-function nil
-  "Function used to generate a `User-Agent:' string. If this is
-`nil' then no `User-Agent:' will be generated."
+  "Function used to generate a `User-Agent:' string.
+If this is `nil' then no `User-Agent:' will be generated."
   :type '(choice (const :tag "No user agent string" nil)
                 (const :tag "Full" notmuch-mua-user-agent-full)
                 (const :tag "Notmuch" notmuch-mua-user-agent-notmuch)
@@ -78,20 +76,36 @@ disabled: this would result in an incorrect behavior."))
   :group 'notmuch-send)
 
 (defcustom notmuch-mua-hidden-headers nil
-  "Headers that are added to the `message-mode' hidden headers
-list."
+  "Headers that are added to the `message-mode' hidden headers list."
+  :type '(repeat string)
+  :group 'notmuch-send)
+
+(defcustom notmuch-identities nil
+  "Identities that can be used as the From: address when composing a new message.
+
+If this variable is left unset, then a list will be constructed from the
+name and addresses configured in the notmuch configuration file."
   :type '(repeat string)
   :group 'notmuch-send)
 
+(defcustom notmuch-always-prompt-for-sender nil
+  "Always prompt for the From: address when composing or forwarding a message.
+
+This is not taken into account when replying to a message, because in that case
+the From: header is already filled in by notmuch."
+  :type 'boolean
+  :group 'notmuch-send)
+
 (defgroup notmuch-reply nil
-  "Replying to messages in notmuch"
+  "Replying to messages in notmuch."
   :group 'notmuch)
 
 (defcustom notmuch-mua-cite-function 'message-cite-original
-  "*Function for citing an original message.
+  "Function for citing an original message.
+
 Predefined functions include `message-cite-original' and
-`message-cite-original-without-signature'.
-Note that these functions use `mail-citation-hook' if that is non-nil."
+`message-cite-original-without-signature'.  Note that these
+functions use `mail-citation-hook' if that is non-nil."
   :type '(radio (function-item message-cite-original)
                (function-item message-cite-original-without-signature)
                (function-item sc-cite-original)
@@ -125,12 +139,13 @@ to `notmuch-mua-send-hook'."
   :type 'regexp
   :group 'notmuch-send)
 
-;;
+;;; Various functions
 
 (defun notmuch-mua-attachment-check ()
-  "Signal an error if the message text indicates that an
-attachment is expected but no MML referencing an attachment is
-found.
+  "Signal an error an attachement is expected but missing.
+
+Signal an error if the message text indicates that an attachment
+is expected but no MML referencing an attachment is found.
 
 Typically this is added to `notmuch-mua-send-hook'."
   (when (and
@@ -163,17 +178,14 @@ Typically this is added to `notmuch-mua-send-hook'."
 
 (defun notmuch-mua-get-switch-function ()
   "Get a switch function according to `notmuch-mua-compose-in'."
-  (cond ((eq notmuch-mua-compose-in 'current-window)
-        'switch-to-buffer)
-       ((eq notmuch-mua-compose-in 'new-window)
-        'switch-to-buffer-other-window)
-       ((eq notmuch-mua-compose-in 'new-frame)
-        'switch-to-buffer-other-frame)
-       (t (error "Invalid value for `notmuch-mua-compose-in'"))))
+  (pcase notmuch-mua-compose-in
+    ('current-window 'switch-to-buffer)
+    ('new-window     'switch-to-buffer-other-window)
+    ('new-frame      'switch-to-buffer-other-frame)
+    (_ (error "Invalid value for `notmuch-mua-compose-in'"))))
 
 (defun notmuch-mua-maybe-set-window-dedicated ()
-  "Set the selected window as dedicated according to
-`notmuch-mua-compose-in'."
+  "Set the selected window as dedicated according to `notmuch-mua-compose-in'."
   (when (or (eq notmuch-mua-compose-in 'new-frame)
            (eq notmuch-mua-compose-in 'new-window))
     (set-window-dedicated-p (selected-window) t)))
@@ -205,14 +217,13 @@ Typically this is added to `notmuch-mua-send-hook'."
 (defun notmuch-mua-reply-crypto (parts)
   "Add mml sign-encrypt flag if any part of original message is encrypted."
   (cl-loop for part in parts
-          if (notmuch-match-content-type (plist-get part :content-type)
-                                         "multipart/encrypted")
+          for type = (plist-get part :content-type)
+          if (notmuch-match-content-type type "multipart/encrypted")
           do (mml-secure-message-sign-encrypt)
-          else if (notmuch-match-content-type (plist-get part :content-type)
-                                              "multipart/*")
+          else if (notmuch-match-content-type type "multipart/*")
           do (notmuch-mua-reply-crypto (plist-get part :content))))
 
-;; There is a bug in emacs 23's message.el that results in a newline
+;; There is a bug in Emacs' message.el that results in a newline
 ;; not being inserted after the References header, so the next header
 ;; is concatenated to the end of it. This function fixes the problem,
 ;; while guarding against the possibility that some current or future
@@ -221,6 +232,8 @@ Typically this is added to `notmuch-mua-send-hook'."
   (funcall original-func header references)
   (unless (bolp) (insert "\n")))
 
+;;; Mua reply
+
 (defun notmuch-mua-reply (query-string &optional sender reply-all)
   (let ((args '("reply" "--format=sexp" "--format-version=4"))
        (process-crypto notmuch-show-process-crypto)
@@ -265,8 +278,8 @@ Typically this is added to `notmuch-mua-send-hook'."
       ;; Create a buffer-local queue for tag changes triggered when
       ;; sending the reply.
       (when notmuch-message-replied-tags
-       (setq-local notmuch-message-queued-tag-changes
-                   (list (cons query-string notmuch-message-replied-tags))))
+       (setq notmuch-message-queued-tag-changes
+             (list (cons query-string notmuch-message-replied-tags))))
       ;; Insert the message body - but put it in front of the signature
       ;; if one is present, and after any other content
       ;; message*setup-hooks may have added to the message body already.
@@ -324,21 +337,29 @@ Typically this is added to `notmuch-mua-send-hook'."
   (message-goto-body)
   (set-buffer-modified-p nil))
 
+;;; Mode and keymap
+
+(defvar notmuch-message-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "C-c C-c") #'notmuch-mua-send-and-exit)
+    (define-key map (kbd "C-c C-s") #'notmuch-mua-send)
+    (define-key map (kbd "C-c C-p") #'notmuch-draft-postpone)
+    (define-key map (kbd "C-x C-s") #'notmuch-draft-save)
+    map)
+  "Keymap for `notmuch-message-mode'.")
+
 (define-derived-mode notmuch-message-mode message-mode "Message[Notmuch]"
   "Notmuch message composition mode. Mostly like `message-mode'."
   (notmuch-address-setup))
 
 (put 'notmuch-message-mode 'flyspell-mode-predicate 'mail-mode-flyspell-verify)
 
-(define-key notmuch-message-mode-map (kbd "C-c C-c") #'notmuch-mua-send-and-exit)
-(define-key notmuch-message-mode-map (kbd "C-c C-s") #'notmuch-mua-send)
-(define-key notmuch-message-mode-map (kbd "C-c C-p") #'notmuch-draft-postpone)
-(define-key notmuch-message-mode-map (kbd "C-x C-s") #'notmuch-draft-save)
+;;; New messages
 
 (defun notmuch-mua-pop-to-buffer (name switch-function)
-  "Pop to buffer NAME, and warn if it already exists and is
-modified. This function is notmuch adaptation of
-`message-pop-to-buffer'."
+  "Pop to buffer NAME, and warn if it already exists and is modified.
+Like `message-pop-to-buffer' but enable `notmuch-message-mode'
+instead of `message-mode' and SWITCH-FUNCTION is mandatory."
   (let ((buffer (get-buffer name)))
     (if (and buffer
             (buffer-name buffer))
@@ -350,25 +371,23 @@ modified. This function is notmuch adaptation of
                (select-window window))
            (funcall switch-function buffer)
            (set-buffer buffer))
-         (when (and (buffer-modified-p)
-                    (not (prog1
-                             (y-or-n-p
-                              "Message already being composed; erase? ")
-                           (message nil))))
-           (error "Message being composed")))
+         (when (buffer-modified-p)
+           (if (y-or-n-p "Message already being composed; erase? ")
+               (message nil)
+             (error "Message being composed"))))
       (funcall switch-function name)
       (set-buffer name))
     (erase-buffer)
     (notmuch-message-mode)))
 
-(defun notmuch-mua-mail (&optional to subject other-headers continue
+(defun notmuch-mua-mail (&optional to subject other-headers _continue
                                   switch-function yank-action send-actions
                                   return-action &rest ignored)
   "Invoke the notmuch mail composition window."
   (interactive)
   (when notmuch-mua-user-agent-function
     (let ((user-agent (funcall notmuch-mua-user-agent-function)))
-      (unless (string= "" user-agent)
+      (unless (string-empty-p user-agent)
        (push (cons 'User-Agent user-agent) other-headers))))
   (unless (assq 'From other-headers)
     (push (cons 'From (message-make-from
@@ -390,16 +409,10 @@ modified. This function is notmuch adaptation of
          (dolist (h other-headers other-headers)
            (when (stringp (car h))
              (setcar h (intern (capitalize (car h))))))))
-       (args (list yank-action send-actions))
        ;; Cause `message-setup-1' to do things relevant for mail,
        ;; such as observe `message-default-mail-headers'.
        (message-this-is-mail t))
-    ;; message-setup-1 in Emacs 23 does not accept return-action
-    ;; argument. Pass it only if it is supplied by the caller. This
-    ;; will never be the case when we're called by `compose-mail' in
-    ;; Emacs 23.
-    (when return-action (nconc args '(return-action)))
-    (apply 'message-setup-1 headers args))
+    (message-setup-1 headers yank-action send-actions return-action))
   (notmuch-fcc-header-setup)
   (message-sort-headers)
   (message-hide-headers)
@@ -407,37 +420,21 @@ modified. This function is notmuch adaptation of
   (notmuch-mua-maybe-set-window-dedicated)
   (message-goto-to))
 
-(defcustom notmuch-identities nil
-  "Identities that can be used as the From: address when composing a new message.
-
-If this variable is left unset, then a list will be constructed from the
-name and addresses configured in the notmuch configuration file."
-  :type '(repeat string)
-  :group 'notmuch-send)
-
-(defcustom notmuch-always-prompt-for-sender nil
-  "Always prompt for the From: address when composing or forwarding a message.
-
-This is not taken into account when replying to a message, because in that case
-the From: header is already filled in by notmuch."
-  :type 'boolean
-  :group 'notmuch-send)
-
 (defvar notmuch-mua-sender-history nil)
 
 (defun notmuch-mua-prompt-for-sender ()
   "Prompt for a sender from the user's configured identities."
   (if notmuch-identities
-      (ido-completing-read "Send mail from: " notmuch-identities
-                          nil nil nil 'notmuch-mua-sender-history
-                          (car notmuch-identities))
+      (completing-read "Send mail from: " notmuch-identities
+                      nil nil nil 'notmuch-mua-sender-history
+                      (car notmuch-identities))
     (let* ((name (notmuch-user-name))
           (addrs (cons (notmuch-user-primary-email)
                        (notmuch-user-other-email)))
           (address
-           (ido-completing-read (concat "Sender address for " name ": ") addrs
-                                nil nil nil 'notmuch-mua-sender-history
-                                (car addrs))))
+           (completing-read (concat "Sender address for " name ": ") addrs
+                            nil nil nil 'notmuch-mua-sender-history
+                            (car addrs))))
       (message-make-from name address))))
 
 (put 'notmuch-mua-new-mail 'notmuch-prefix-doc "... and prompt for sender")
@@ -504,10 +501,10 @@ the From: address."
       ;; Create a buffer-local queue for tag changes triggered when
       ;; sending the message.
       (when notmuch-message-forwarded-tags
-       (setq-local notmuch-message-queued-tag-changes
-                   (cl-loop for id in forward-queries
-                            collect
-                            (cons id notmuch-message-forwarded-tags))))
+       (setq notmuch-message-queued-tag-changes
+             (cl-loop for id in forward-queries
+                      collect
+                      (cons id notmuch-message-forwarded-tags))))
       ;; `message-forward-make-body' shows the User-agent header.  Hide
       ;; it again.
       (message-hide-headers)
@@ -519,10 +516,10 @@ the From: address."
 If PROMPT-FOR-SENDER is non-nil, the user will be prompted for
 the From: address first.  If REPLY-ALL is non-nil, the message
 will be addressed to all recipients of the source message."
-  ;; In current emacs (24.3) select-active-regions is set to t by
-  ;; default. The reply insertion code sets the region to the quoted
-  ;; message to make it easy to delete (kill-region or C-w). These two
-  ;; things combine to put the quoted message in the primary selection.
+  ;; `select-active-regions' is t by default. The reply insertion code
+  ;; sets the region to the quoted message to make it easy to delete
+  ;; (kill-region or C-w). These two things combine to put the quoted
+  ;; message in the primary selection.
   ;;
   ;; This is not what the user wanted and is a privacy risk (accidental
   ;; pasting of the quoted message). We can avoid some of the problems
@@ -536,6 +533,8 @@ will be addressed to all recipients of the source message."
     (notmuch-mua-reply query-string sender reply-all)
     (deactivate-mark)))
 
+;;; Checks
+
 (defun notmuch-mua-check-no-misplaced-secure-tag ()
   "Query user if there is a misplaced secure mml tag.
 
@@ -547,11 +546,11 @@ tag, or the user confirms they mean it."
       (goto-char (point-max))
       (or
        ;; We are always fine if there is no secure tag.
-       (not (search-backward "<#secure" nil 't))
+       (not (search-backward "<#secure" nil t))
        ;; There is a secure tag, so it must be at the start of the
        ;; body, with no secure tag earlier (i.e., in the headers).
        (and (= (point) body-start)
-           (not (search-backward "<#secure" nil 't)))
+           (not (search-backward "<#secure" nil t)))
        ;; The user confirms they means it.
        (yes-or-no-p "\
 There is a <#secure> tag not at the start of the body. It is
@@ -578,6 +577,8 @@ The <#secure> tag at the start of the body is not followed by a
 newline. It is likely that the message will be sent unsigned and
 unencrypted.  Really send? "))))
 
+;;; Finishing commands
+
 (defun notmuch-mua-send-common (arg &optional exit)
   (interactive "P")
   (run-hooks 'notmuch-mua-send-hook)
@@ -591,7 +592,7 @@ unencrypted.  Really send? "))))
 
 (defun notmuch-mua-send-and-exit (&optional arg)
   (interactive "P")
-  (notmuch-mua-send-common arg 't))
+  (notmuch-mua-send-common arg t))
 
 (defun notmuch-mua-send (&optional arg)
   (interactive "P")
@@ -601,18 +602,18 @@ unencrypted.  Really send? "))))
   (interactive)
   (message-kill-buffer))
 
-;;
+;;; _
 
 (define-mail-user-agent 'notmuch-user-agent
-  'notmuch-mua-mail 'notmuch-mua-send-and-exit
-  'notmuch-mua-kill-buffer 'notmuch-mua-send-hook)
+  'notmuch-mua-mail
+  'notmuch-mua-send-and-exit
+  'notmuch-mua-kill-buffer
+  'notmuch-mua-send-hook)
 
 ;; Add some more headers to the list that `message-mode' hides when
 ;; composing a message.
 (notmuch-mua-add-more-hidden-headers)
 
-;;
-
 (provide 'notmuch-mua)
 
 ;;; notmuch-mua.el ends here
index 3aa5bd8ff1cdc45f6265d9f2133e9e8b9e070c57..f04b07c2e51b28e34f03469b88205d279c45a587 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-parser.el --- streaming S-expression parser
+;;; notmuch-parser.el --- streaming S-expression parser  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Austin Clements
 ;;
@@ -21,7 +21,9 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
+(require 'pcase)
+(require 'subr-x)
 
 (defun notmuch-sexp-create-parser ()
   "Return a new streaming S-expression parser.
@@ -140,15 +142,6 @@ beginning of a list, throw invalid-read-syntax."
         (forward-char)
         (signal 'invalid-read-syntax (list (string (char-before)))))))
 
-(defun notmuch-sexp-eof (sp)
-  "Signal an error if there is more data in SP's buffer.
-
-Moves point to the beginning of any trailing data or to the end
-of the buffer if there is only trailing whitespace."
-  (skip-chars-forward " \n\r\t")
-  (unless (eobp)
-    (error "Trailing garbage following expression")))
-
 (defvar notmuch-sexp--parser nil
   "The buffer-local notmuch-sexp-parser instance.
 
@@ -168,9 +161,8 @@ additional data.  The caller just needs to ensure it does not
 move point in the input buffer."
   ;; Set up the initial state
   (unless (local-variable-p 'notmuch-sexp--parser)
-    (set (make-local-variable 'notmuch-sexp--parser)
-        (notmuch-sexp-create-parser))
-    (set (make-local-variable 'notmuch-sexp--state) 'begin))
+    (setq-local notmuch-sexp--parser (notmuch-sexp-create-parser))
+    (setq-local notmuch-sexp--state 'begin))
   (let (done)
     (while (not done)
       (cl-case notmuch-sexp--state
@@ -188,8 +180,11 @@ move point in the input buffer."
             (t     (with-current-buffer result-buffer
                      (funcall result-function result))))))
        (end
-        ;; Any trailing data is unexpected
-        (notmuch-sexp-eof notmuch-sexp--parser)
+        ;; Skip over trailing whitespace.
+        (skip-chars-forward " \n\r\t")
+        ;; Any trailing data is unexpected.
+        (unless (eobp)
+          (error "Trailing garbage following expression"))
         (setq done t)))))
   ;; Clear out what we've parsed
   (delete-region (point-min) (point)))
index 6dd9f775a9ddba858c9358dc569f70b462f073b1..d00614999147c100c4b94d472669d459cdbc6b2b 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-print.el --- printing messages from notmuch
+;;; notmuch-print.el --- printing messages from notmuch  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © David Edmondson
 ;;
@@ -25,6 +25,8 @@
 
 (declare-function notmuch-show-get-prop "notmuch-show" (prop &optional props))
 
+;;; Options
+
 (defcustom notmuch-print-mechanism 'notmuch-print-lpr
   "How should printing be done?"
   :group 'notmuch-show
@@ -36,7 +38,7 @@
          (function :tag "Use muttprint then evince" notmuch-print-muttprint/evince)
          (function :tag "Using a custom function")))
 
-;; Utility functions:
+;;; Utility functions
 
 (defun notmuch-print-run-evince (file)
   "View FILE using 'evince'."
@@ -54,9 +56,9 @@ Optional OUTPUT allows passing a list of flags to muttprint."
         "--printed-headers" "Date_To_From_CC_Newsgroups_*Subject*_/Tags/"
         output))
 
-;; User-visible functions:
+;;; User-visible functions
 
-(defun notmuch-print-lpr (msg)
+(defun notmuch-print-lpr (_msg)
   "Print a message buffer using lpr."
   (lpr-buffer))
 
@@ -76,11 +78,11 @@ Optional OUTPUT allows passing a list of flags to muttprint."
     (ps-print-buffer ps-file)
     (notmuch-print-run-evince ps-file)))
 
-(defun notmuch-print-muttprint (msg)
+(defun notmuch-print-muttprint (_msg)
   "Print a message using muttprint."
   (notmuch-print-run-muttprint))
 
-(defun notmuch-print-muttprint/evince (msg)
+(defun notmuch-print-muttprint/evince (_msg)
   "Preview a message buffer using muttprint and evince."
   (let ((ps-file (make-temp-file "notmuch" nil ".ps")))
     (notmuch-print-run-muttprint (list "--printer" (concat "TO_FILE:" ps-file)))
@@ -91,6 +93,8 @@ Optional OUTPUT allows passing a list of flags to muttprint."
   (set-buffer-modified-p nil)
   (funcall notmuch-print-mechanism msg))
 
+;;; _
+
 (provide 'notmuch-print)
 
 ;;; notmuch-print.el ends here
index 3cfccbc3e891aebb9829886457018e302d42f0ed..d7349b771e4ff4efde18249d54a32a8dc2adde45 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-query.el --- provide an emacs api to query notmuch
+;;; notmuch-query.el --- provide an emacs api to query notmuch  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © David Bremner
 ;;
@@ -23,6 +23,8 @@
 
 (require 'notmuch-lib)
 
+;;; Basic query function
+
 (defun notmuch-query-get-threads (search-terms)
   "Return a list of threads of messages matching SEARCH-TERMS.
 
@@ -35,16 +37,13 @@ is a possibly empty forest of replies."
     (setq args (append args search-terms))
     (apply #'notmuch-call-notmuch-sexp args)))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Mapping functions across collections of messages.
+;;; Mapping functions across collections of messages
 
 (defun notmuch-query-map-aux  (mapper function seq)
   "Private function to do the actual mapping and flattening."
-  (apply 'append
-        (mapcar
-         (lambda (tree)
-           (funcall mapper function tree))
-         seq)))
+  (cl-mapcan (lambda (tree)
+              (funcall mapper function tree))
+            seq))
 
 (defun notmuch-query-map-threads (fn threads)
   "Apply function FN to every thread in THREADS.
@@ -62,10 +61,10 @@ Flatten results to a list.  See the function
   "Apply function FN to every message in TREE.
 Flatten results to a list.  See the function
 `notmuch-query-get-threads' for more information."
-  (cons (funcall fn (car tree)) (notmuch-query-map-forest fn (cadr tree))))
+  (cons (funcall fn (car tree))
+       (notmuch-query-map-forest fn (cadr tree))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Predefined queries
+;;; Predefined queries
 
 (defun notmuch-query-get-message-ids (&rest search-terms)
   "Return a list of message-ids of messages that match SEARCH-TERMS."
index b08ceb973e19b0836b8a210d7b5be73dc241cc4a..ba93febb34ff90f96e95b5cae8a0af3796130638 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-show.el --- displaying notmuch forests
+;;; notmuch-show.el --- displaying notmuch forests  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Carl Worth
 ;; Copyright © David Edmondson
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl-lib)
-  (require 'pcase))
-
 (require 'mm-view)
 (require 'message)
 (require 'mm-decode)
 (declare-function notmuch-read-query "notmuch" (prompt))
 (declare-function notmuch-draft-resume "notmuch-draft" (id))
 
+(defvar shr-blocked-images)
+(defvar gnus-blocked-images)
+(defvar shr-content-function)
+
+;;; Options
+
 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
   "Headers that should be shown in a message, in this order.
 
@@ -162,23 +164,19 @@ indentation."
   :type '(choice (const nil) regexp)
   :group 'notmuch-show)
 
-(defvar notmuch-show-thread-id nil)
-(make-variable-buffer-local 'notmuch-show-thread-id)
+;;; Variables
+
+(defvar-local notmuch-show-thread-id nil)
 
-(defvar notmuch-show-parent-buffer nil)
-(make-variable-buffer-local 'notmuch-show-parent-buffer)
+(defvar-local notmuch-show-parent-buffer nil)
 
-(defvar notmuch-show-query-context nil)
-(make-variable-buffer-local 'notmuch-show-query-context)
+(defvar-local notmuch-show-query-context nil)
 
-(defvar notmuch-show-process-crypto nil)
-(make-variable-buffer-local 'notmuch-show-process-crypto)
+(defvar-local notmuch-show-process-crypto nil)
 
-(defvar notmuch-show-elide-non-matching-messages nil)
-(make-variable-buffer-local 'notmuch-show-elide-non-matching-messages)
+(defvar-local notmuch-show-elide-non-matching-messages nil)
 
-(defvar notmuch-show-indent-content t)
-(make-variable-buffer-local 'notmuch-show-indent-content)
+(defvar-local notmuch-show-indent-content t)
 
 (defvar notmuch-show-attachment-debug nil
   "If t log stdout and stderr from attachment handlers.
@@ -186,8 +184,9 @@ indentation."
 When set to nil (the default) stdout and stderr from attachment
 handlers is discarded. When set to t the stdout and stderr from
 each attachment handler is logged in buffers with names beginning
-\" *notmuch-part*\". This option requires emacs version at least
-24.3 to work.")
+\" *notmuch-part*\".")
+
+;;; Options
 
 (defcustom notmuch-show-stash-mlarchive-link-alist
   '(("Gmane" . "https://mid.gmane.org/")
@@ -267,6 +266,8 @@ position of the message in the thread."
   :type 'boolean
   :group 'notmuch-show)
 
+;;; Utilities
+
 (defmacro with-current-notmuch-show-message (&rest body)
   "Evaluate body with current buffer set to the text of current message."
   `(save-excursion
@@ -282,6 +283,8 @@ position of the message in the thread."
   "Enable Visual Line mode."
   (visual-line-mode t))
 
+;;; Commands
+
 ;; DEPRECATED in Notmuch 0.16 since we now have convenient part
 ;; commands.  We'll keep the command around for a version or two in
 ;; case people want to bind it themselves.
@@ -330,7 +333,7 @@ operation on the contents of the current buffer."
         (header (concat
                  "Subject: " subject "\n"
                  "To: " to "\n"
-                 (if (not (string= cc ""))
+                 (if (not (string-empty-p cc))
                      (concat "Cc: " cc "\n")
                    "")
                  "From: " from "\n"
@@ -362,6 +365,8 @@ operation on the contents of the current buffer."
   (interactive)
   (notmuch-show-with-message-as-text 'notmuch-print-message))
 
+;;; Headers
+
 (defun notmuch-show-fontify-header ()
   (let ((face (cond
               ((looking-at "[Tt]o:")
@@ -500,13 +505,15 @@ message at DEPTH in the current thread."
        (narrow-to-region start (point-max))
        (run-hooks 'notmuch-show-markup-headers-hook)))))
 
+;;; Parts
+
 (define-button-type 'notmuch-show-part-button-type
   'action 'notmuch-show-part-button-default
   'follow-link t
   'face 'message-mml
   :supertype 'notmuch-button-type)
 
-(defun notmuch-show-insert-part-header (nth content-type declared-type
+(defun notmuch-show-insert-part-header (_nth content-type declared-type
                                            &optional name comment)
   (let ((base-label (concat (and name (concat name ": "))
                            declared-type
@@ -555,7 +562,7 @@ message at DEPTH in the current thread."
              (overlay-put overlay 'invisible (not show))
              t)))))))
 
-;; Part content ID handling
+;;; Part content ID handling
 
 (defvar notmuch-show--cids nil
   "Alist from raw content ID to (MSG PART).")
@@ -574,15 +581,17 @@ message at DEPTH in the current thread."
       ;; alternative (even if we can't render it).
       (push (list content-id msg part) notmuch-show--cids)))
   ;; Recurse on sub-parts
-  (let ((ctype (notmuch-split-content-type
-               (downcase (plist-get part :content-type)))))
-    (cond ((equal (car ctype) "multipart")
-          (mapc (apply-partially #'notmuch-show--register-cids msg)
-                (plist-get part :content)))
-         ((equal ctype '("message" "rfc822"))
-          (notmuch-show--register-cids
-           msg
-           (car (plist-get (car (plist-get part :content)) :body)))))))
+  (when-let ((type (plist-get part :content-type)))
+    (pcase-let ((`(,type ,subtype)
+                (split-string (downcase type) "/")))
+      (cond ((equal type "multipart")
+            (mapc (apply-partially #'notmuch-show--register-cids msg)
+                  (plist-get part :content)))
+           ((and (equal type "message")
+                 (equal subtype "rfc822"))
+            (notmuch-show--register-cids
+             msg
+             (car (plist-get (car (plist-get part :content)) :body))))))))
 
 (defun notmuch-show--get-cid-content (cid)
   "Return a list (CID-content content-type) or nil.
@@ -591,16 +600,13 @@ This will only find parts from messages that have been inserted
 into the current buffer.  CID must be a raw content ID, without
 enclosing angle brackets, a cid: prefix, or URL encoding.  This
 will return nil if the CID is unknown or cannot be retrieved."
-  (let ((descriptor (cdr (assoc cid notmuch-show--cids))))
-    (when descriptor
-      (let* ((msg (car descriptor))
-            (part (cadr descriptor))
-            ;; Request caching for this content, as some messages
-            ;; reference the same cid: part many times (hundreds!).
-            (content (notmuch-get-bodypart-binary
-                      msg part notmuch-show-process-crypto 'cache))
-            (content-type (plist-get part :content-type)))
-       (list content content-type)))))
+  (when-let ((descriptor (cdr (assoc cid notmuch-show--cids))))
+    (pcase-let ((`(,msg ,part) descriptor))
+      ;; Request caching for this content, as some messages
+      ;; reference the same cid: part many times (hundreds!).
+      (list (notmuch-get-bodypart-binary
+            msg part notmuch-show-process-crypto 'cache)
+           (plist-get part :content-type)))))
 
 (defun notmuch-show-setup-w3m ()
   "Instruct w3m how to retrieve content from a \"related\" part of a message."
@@ -612,7 +618,7 @@ will return nil if the CID is unknown or cannot be retrieved."
   (setq mm-html-inhibit-images nil))
 
 (defvar w3m-current-buffer) ;; From `w3m.el'.
-(defun notmuch-show--cid-w3m-retrieve (url &rest args)
+(defun notmuch-show--cid-w3m-retrieve (url &rest _args)
   ;; url includes the cid: prefix and is URL encoded (see RFC 2392).
   (let* ((cid (url-unhex-string (substring url 4)))
         (content-and-type
@@ -628,7 +634,7 @@ will return nil if the CID is unknown or cannot be retrieved."
   (mapcar (lambda (inner-part) (plist-get inner-part :content-type))
          (plist-get part :content)))
 
-(defun notmuch-show-insert-part-multipart/alternative (msg part content-type nth depth button)
+(defun notmuch-show-insert-part-multipart/alternative (msg part _content-type _nth depth _button)
   (let ((chosen-type (car (notmuch-multipart/alternative-choose
                           msg (notmuch-show-multipart/*-to-list part))))
        (inner-parts (plist-get part :content))
@@ -647,7 +653,7 @@ will return nil if the CID is unknown or cannot be retrieved."
       (indent-rigidly start (point) 1)))
   t)
 
-(defun notmuch-show-insert-part-multipart/related (msg part content-type nth depth button)
+(defun notmuch-show-insert-part-multipart/related (msg part _content-type _nth depth _button)
   (let ((inner-parts (plist-get part :content))
        (start (point)))
     ;; Render the primary part.  FIXME: Support RFC 2387 Start header.
@@ -660,7 +666,7 @@ will return nil if the CID is unknown or cannot be retrieved."
       (indent-rigidly start (point) 1)))
   t)
 
-(defun notmuch-show-insert-part-multipart/signed (msg part content-type nth depth button)
+(defun notmuch-show-insert-part-multipart/signed (msg part _content-type _nth depth button)
   (when button
     (button-put button 'face 'notmuch-crypto-part-header))
   ;; Insert a button detailing the signature status.
@@ -676,7 +682,7 @@ will return nil if the CID is unknown or cannot be retrieved."
       (indent-rigidly start (point) 1)))
   t)
 
-(defun notmuch-show-insert-part-multipart/encrypted (msg part content-type nth depth button)
+(defun notmuch-show-insert-part-multipart/encrypted (msg part _content-type _nth depth button)
   (when button
     (button-put button 'face 'notmuch-crypto-part-header))
   ;; Insert a button detailing the encryption status.
@@ -694,10 +700,10 @@ will return nil if the CID is unknown or cannot be retrieved."
       (indent-rigidly start (point) 1)))
   t)
 
-(defun notmuch-show-insert-part-application/pgp-encrypted (msg part content-type nth depth button)
+(defun notmuch-show-insert-part-application/pgp-encrypted (_msg _part _content-type _nth _depth _button)
   t)
 
-(defun notmuch-show-insert-part-multipart/* (msg part content-type nth depth button)
+(defun notmuch-show-insert-part-multipart/* (msg part _content-type _nth depth _button)
   (let ((inner-parts (plist-get part :content))
        (start (point)))
     ;; Show all of the parts.
@@ -708,7 +714,7 @@ will return nil if the CID is unknown or cannot be retrieved."
       (indent-rigidly start (point) 1)))
   t)
 
-(defun notmuch-show-insert-part-message/rfc822 (msg part content-type nth depth button)
+(defun notmuch-show-insert-part-message/rfc822 (msg part _content-type _nth depth _button)
   (let* ((message (car (plist-get part :content)))
         (body (car (plist-get message :body)))
         (start (point)))
@@ -725,7 +731,7 @@ will return nil if the CID is unknown or cannot be retrieved."
       (indent-rigidly start (point) 1)))
   t)
 
-(defun notmuch-show-insert-part-text/plain (msg part content-type nth depth button)
+(defun notmuch-show-insert-part-text/plain (msg part _content-type _nth depth button)
   ;; For backward compatibility we want to apply the text/plain hook
   ;; to the whole of the part including the part button if there is
   ;; one.
@@ -739,7 +745,7 @@ will return nil if the CID is unknown or cannot be retrieved."
        (run-hook-with-args 'notmuch-show-insert-text/plain-hook msg depth))))
   t)
 
-(defun notmuch-show-insert-part-text/calendar (msg part content-type nth depth button)
+(defun notmuch-show-insert-part-text/calendar (msg part _content-type _nth _depth _button)
   (insert (with-temp-buffer
            (insert (notmuch-get-bodypart-text msg part notmuch-show-process-crypto))
            ;; notmuch-get-bodypart-text does no newline conversion.
@@ -763,8 +769,8 @@ will return nil if the CID is unknown or cannot be retrieved."
   t)
 
 ;; For backwards compatibility.
-(defun notmuch-show-insert-part-text/x-vcalendar (msg part content-type nth depth button)
-  (notmuch-show-insert-part-text/calendar msg part content-type nth depth button))
+(defun notmuch-show-insert-part-text/x-vcalendar (msg part _content-type _nth depth _button)
+  (notmuch-show-insert-part-text/calendar msg part nil nil depth nil))
 
 (when (version< emacs-version "25.3")
   ;; https://bugs.gnu.org/28350
@@ -780,7 +786,7 @@ will return nil if the CID is unknown or cannot be retrieved."
     ;; the first time).
     (require 'enriched)
     (cl-letf (((symbol-function 'enriched-decode-display-prop)
-              (lambda (start end &optional param) (list start end))))
+              (lambda (start end &optional _param) (list start end))))
       (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
 
 (defun notmuch-show-get-mime-type-of-application/octet-stream (part)
@@ -817,7 +823,8 @@ will return nil if the CID is unknown or cannot be retrieved."
          (gnus-blocked-images notmuch-show-text/html-blocked-images))
       (notmuch-show-insert-part-*/* msg part content-type nth depth button))))
 
-;; These functions are used by notmuch-show--insert-part-text/html-shr
+;;; Functions used by notmuch-show--insert-part-text/html-shr
+
 (declare-function libxml-parse-html-region "xml.c")
 (declare-function shr-insert-document "shr")
 
@@ -837,12 +844,12 @@ will return nil if the CID is unknown or cannot be retrieved."
     (shr-insert-document dom)
     t))
 
-(defun notmuch-show-insert-part-*/* (msg part content-type nth depth button)
+(defun notmuch-show-insert-part-*/* (msg part content-type _nth _depth _button)
   ;; This handler _must_ succeed - it is the handler of last resort.
   (notmuch-mm-display-part-inline msg part content-type notmuch-show-process-crypto)
   t)
 
-;; Functions for determining how to handle MIME parts.
+;;; Functions for determining how to handle MIME parts.
 
 (defun notmuch-show-handlers-for (content-type)
   "Return a list of content handlers for a part of type CONTENT-TYPE."
@@ -852,14 +859,13 @@ will return nil if the CID is unknown or cannot be retrieved."
              (push func result)))
          ;; Reverse order of prefrence.
          (list (intern (concat "notmuch-show-insert-part-*/*"))
-               (intern (concat
-                        "notmuch-show-insert-part-"
-                        (car (notmuch-split-content-type content-type))
-                        "/*"))
+               (intern (concat "notmuch-show-insert-part-"
+                               (car (split-string content-type "/"))
+                               "/*"))
                (intern (concat "notmuch-show-insert-part-" content-type))))
     result))
 
-;; \f
+;;; Parts
 
 (defun notmuch-show-insert-bodypart-internal (msg part content-type nth depth button)
   ;; Run the handlers until one of them succeeds.
@@ -943,7 +949,8 @@ will return nil if the CID is unknown or cannot be retrieved."
 
 (defun notmuch-show-mime-type (part)
   "Return the correct mime-type to use for PART."
-  (let ((content-type (downcase (plist-get part :content-type))))
+  (when-let ((content-type (plist-get part :content-type)))
+    (setq content-type (downcase content-type))
     (or (and (string= content-type "application/octet-stream")
             (notmuch-show-get-mime-type-of-application/octet-stream part))
        (and (string= content-type "inline patch")
@@ -958,13 +965,13 @@ The function should take two parameters, PART and HIDE, and
 should return non-NIL if a header button should be inserted for
 this part.")
 
-(defun notmuch-show-insert-header-p (part hide)
+(defun notmuch-show-insert-header-p (part _hide)
   ;; Show all part buttons except for the first part if it is text/plain.
   (let ((mime-type (notmuch-show-mime-type part)))
     (not (and (string= mime-type "text/plain")
              (<= (plist-get part :id) 1)))))
 
-(defun notmuch-show-reply-insert-header-p-never (part hide)
+(defun notmuch-show-reply-insert-header-p-never (_part _hide)
   nil)
 
 (defun notmuch-show-reply-insert-header-p-trimmed (part hide)
@@ -983,7 +990,7 @@ this part.")
 HIDE determines whether to show or hide the part and the button
 as follows: If HIDE is nil, show the part and the button. If HIDE
 is t, hide the part initially and show the button."
-  (let* ((content-type (downcase (plist-get part :content-type)))
+  (let* ((content-type (plist-get part :content-type))
         (mime-type (notmuch-show-mime-type part))
         (nth (plist-get part :id))
         (long (and (notmuch-match-content-type mime-type "text/*")
@@ -995,7 +1002,8 @@ is t, hide the part initially and show the button."
         ;; the first (or only) part if this is text/plain.
         (button (and (funcall notmuch-show-insert-header-p-function part hide)
                      (notmuch-show-insert-part-header
-                      nth mime-type content-type
+                      nth mime-type
+                      (and content-type (downcase content-type))
                       (plist-get part :filename))))
         ;; Hide the part initially if HIDE is t, or if it is too long
         ;; and we have a button to allow toggling.
@@ -1105,6 +1113,8 @@ is t, hide the part initially and show the button."
     (notmuch-show-message-visible msg (and (plist-get msg :match)
                                           (not (plist-get msg :excluded))))))
 
+;;; Toggle commands
+
 (defun notmuch-show-toggle-process-crypto ()
   "Toggle the processing of cryptographic MIME parts."
   (interactive)
@@ -1133,6 +1143,8 @@ is t, hide the part initially and show the button."
             "Content is not indented."))
   (notmuch-show-refresh-view))
 
+;;; Main insert functions
+
 (defun notmuch-show-insert-tree (tree depth)
   "Insert the message tree TREE at depth DEPTH in the current thread."
   (let ((msg (car tree))
@@ -1150,6 +1162,8 @@ is t, hide the part initially and show the button."
   "Insert the forest of threads FOREST."
   (mapc (lambda (thread) (notmuch-show-insert-thread thread 0)) forest))
 
+;;; Link buttons
+
 (defvar notmuch-id-regexp
   (concat
    ;; Match the id: prefix only if it begins a word (to disallow, for
@@ -1210,6 +1224,8 @@ buttons for a corresponding notmuch search."
                          'help-echo "Mouse-1, RET: search for this message"
                          'face goto-address-mail-face)))))
 
+;;; Show command
+
 ;;;###autoload
 (defun notmuch-show (thread-id &optional elide-toggle parent-buffer query-context buffer-name)
   "Run \"notmuch show\" with the given thread ID and display results.
@@ -1332,6 +1348,8 @@ If no messages match the query return NIL."
     ;; Report back to the caller whether any messages matched.
     forest))
 
+;;; Refresh command
+
 (defun notmuch-show-capture-state ()
   "Capture the state of the current buffer.
 
@@ -1406,6 +1424,8 @@ reset based on the original query."
       (ding)
       (message "Refreshing the buffer resulted in no messages!"))))
 
+;;; Keymaps
+
 (defvar notmuch-show-stash-map
   (let ((map (make-sparse-keymap)))
     (define-key map "c" 'notmuch-show-stash-cc)
@@ -1485,7 +1505,8 @@ reset based on the original query."
     (define-key map "B" 'notmuch-show-browse-urls)
     map)
   "Keymap for \"notmuch show\" buffers.")
-(fset 'notmuch-show-mode-map notmuch-show-mode-map)
+
+;;; Mode
 
 (define-derived-mode notmuch-show-mode fundamental-mode "notmuch-show"
   "Major mode for viewing a thread with notmuch.
@@ -1523,6 +1544,8 @@ All currently available key bindings:
   (setq imenu-extract-index-name-function
        #'notmuch-show-imenu-extract-index-name-function))
 
+;;; Tree commands
+
 (defun notmuch-tree-from-show-current-query ()
   "Call notmuch tree with the current query."
   (interactive)
@@ -1537,17 +1560,14 @@ All currently available key bindings:
                      notmuch-show-query-context
                      (notmuch-show-get-message-id)))
 
+;;; Movement related functions.
+
 (defun notmuch-show-move-to-message-top ()
   (goto-char (notmuch-show-message-top)))
 
 (defun notmuch-show-move-to-message-bottom ()
   (goto-char (notmuch-show-message-bottom)))
 
-(defun notmuch-show-message-adjust ()
-  (recenter 0))
-
-;; Movement related functions.
-
 ;; There's some strangeness here where a text property applied to a
 ;; region a->b is not found when point is at b. We walk backwards
 ;; until finding the property.
@@ -1591,8 +1611,7 @@ effects."
     (cl-loop do (funcall function)
             while (notmuch-show-goto-message-next))))
 
-;; Functions relating to the visibility of messages and their
-;; components.
+;;; Functions relating to the visibility of messages and their components.
 
 (defun notmuch-show-message-visible (props visible-p)
   (overlay-put (plist-get props :message-overlay) 'invisible (not visible-p))
@@ -1602,8 +1621,7 @@ effects."
   (overlay-put (plist-get props :headers-overlay) 'invisible (not visible-p))
   (notmuch-show-set-prop :headers-visible visible-p props))
 
-;; Functions for setting and getting attributes of the current
-;; message.
+;;; Functions for setting and getting attributes of the current message.
 
 (defun notmuch-show-set-message-properties (props)
   (save-excursion
@@ -1644,13 +1662,13 @@ It gets property PROP from PROPS or, if PROPS is nil, the current
 message in either tree or show. This means that several utility
 functions in notmuch-show can be used directly by notmuch-tree as
 they just need the correct message properties."
-  (let ((props (or props
-                  (cond ((eq major-mode 'notmuch-show-mode)
-                         (notmuch-show-get-message-properties))
-                        ((eq major-mode 'notmuch-tree-mode)
-                         (notmuch-tree-get-message-properties))
-                        (t nil)))))
-    (plist-get props prop)))
+  (plist-get (or props
+                (cond ((eq major-mode 'notmuch-show-mode)
+                       (notmuch-show-get-message-properties))
+                      ((eq major-mode 'notmuch-tree-mode)
+                       (notmuch-tree-get-message-properties))
+                      (t nil)))
+            prop))
 
 (defun notmuch-show-get-message-id (&optional bare)
   "Return an id: query for the Message-Id of the current message.
@@ -1737,7 +1755,7 @@ marked as unread, i.e. the tag changes in
     (apply 'notmuch-show-tag-message
           (notmuch-tag-change-list notmuch-show-mark-read-tags unread))))
 
-(defun notmuch-show-seen-current-message (start end)
+(defun notmuch-show-seen-current-message (_start _end)
   "Mark the current message read if it is open.
 
 We only mark it read once: if it is changed back then that is a
@@ -1755,11 +1773,11 @@ user decision and we should not override it."
     ;; We need to redisplay to get window-start and window-end correct.
     (redisplay)
     (save-excursion
-      (condition-case err
+      (condition-case nil
          (funcall notmuch-show-mark-read-function (window-start) (window-end))
        ((debug error)
         (unless notmuch-show--seen-has-errored
-          (setq notmuch-show--seen-has-errored 't)
+          (setq notmuch-show--seen-has-errored t)
           (setq header-line-format
                 (concat header-line-format
                         (propertize
@@ -1772,12 +1790,11 @@ user decision and we should not override it."
 Reshows the current thread with matches defined by the new query-string."
   (interactive (list (notmuch-read-query "Filter thread: ")))
   (let ((msg-id (notmuch-show-get-message-id)))
-    (setq notmuch-show-query-context (if (string= query "") nil query))
+    (setq notmuch-show-query-context (if (string-empty-p query) nil query))
     (notmuch-show-refresh-view t)
     (notmuch-show-goto-message msg-id)))
 
-;; Functions for getting attributes of several messages in the current
-;; thread.
+;;; Functions for getting attributes of several messages in the current thread.
 
 (defun notmuch-show-get-message-ids-for-open-messages ()
   "Return a list of all id: queries for open messages in the current thread."
@@ -1791,7 +1808,7 @@ Reshows the current thread with matches defined by the new query-string."
        (setq done (not (notmuch-show-goto-message-next))))
       message-ids)))
 
-;; Commands typically bound to keys.
+;;; Commands typically bound to keys.
 
 (defun notmuch-show-advance ()
   "Advance through thread.
@@ -1919,6 +1936,9 @@ any effects from previous calls to
     (message-resend addresses)
     (notmuch-bury-or-kill-this-buffer)))
 
+(defun notmuch-show-message-adjust ()
+  (recenter 0))
+
 (defun notmuch-show-next-message (&optional pop-at-end)
   "Show the next message.
 
@@ -2349,7 +2369,9 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')."
   (browse-url (current-kill 0 t)))
 
 (defun notmuch-show-stash-git-helper (addresses prefix)
-  "Escape, trim, quote, and add PREFIX to each address in list of ADDRESSES, and return the result as a single string."
+  "Normalize all ADDRESSES while adding PREFIX.
+Escape, trim, quote and add PREFIX to each address in list
+of ADDRESSES, and return the result as a single string."
   (mapconcat (lambda (x)
               (concat prefix "\""
                       ;; escape double-quotes
@@ -2362,10 +2384,12 @@ the user (see `notmuch-show-stash-mlarchive-link-alist')."
             addresses " "))
 
 (put 'notmuch-show-stash-git-send-email 'notmuch-prefix-doc
-     "Copy From/To/Cc of current message to kill-ring in a form suitable for pasting to git send-email command line.")
+     "Copy From/To/Cc of current message to kill-ring.
+Use a form suitable for pasting to git send-email command line.")
 
 (defun notmuch-show-stash-git-send-email (&optional no-in-reply-to)
-  "Copy From/To/Cc/Message-Id of current message to kill-ring in a form suitable for pasting to git send-email command line.
+  "Copy From/To/Cc/Message-Id of current message to kill-ring.
+Use a form suitable for pasting to git send-email command line.
 
 If invoked with a prefix argument (or NO-IN-REPLY-TO is non-nil),
 omit --in-reply-to=<Message-Id>."
@@ -2385,7 +2409,7 @@ omit --in-reply-to=<Message-Id>."
                          (list (notmuch-show-get-message-id t)) "--in-reply-to="))))
              " ")))
 
-;; Interactive part functions and their helpers
+;;; Interactive part functions and their helpers
 
 (defun notmuch-show-generate-part-buffer (msg part)
   "Return a temporary buffer containing the specified part's content."
@@ -2418,10 +2442,9 @@ This ensures that the temporary buffer created for the mm-handle
 is destroyed when FN returns. If MIME-TYPE is given then force
 part to be treated as if it had that mime-type."
   (let ((handle (notmuch-show-current-part-handle mime-type)))
-    ;; emacs 24.3+ puts stdout/stderr into the calling buffer so we
-    ;; call it from a temp-buffer, unless
-    ;; notmuch-show-attachment-debug is non-nil in which case we put
-    ;; it in " *notmuch-part*".
+    ;; Emacs puts stdout/stderr into the calling buffer so we call
+    ;; it from a temp-buffer, unless notmuch-show-attachment-debug
+    ;; is non-nil, in which case we put it in " *notmuch-part*".
     (unwind-protect
        (if notmuch-show-attachment-debug
            (with-current-buffer (generate-new-buffer " *notmuch-part*")
@@ -2533,6 +2556,8 @@ browsing."
        (funcall fn (completing-read prompt urls nil nil nil nil (car urls)))
       (message "No URLs found."))))
 
+;;; _
+
 (provide 'notmuch-show)
 
 ;;; notmuch-show.el ends here
index 5d4a6865c4c4ffd7aa98be764e0ada386fef4f02..f348d4ae2dc82c1b0c57570269cf4015a54d939b 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-tag.el --- tag messages within emacs
+;;; notmuch-tag.el --- tag messages within emacs  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Damien Cassou
 ;; Copyright © Carl Worth
 
 ;;; Code:
 
-(require 'cl-lib)
-(eval-when-compile
-  (require 'pcase))
-
 (require 'crm)
 
 (require 'notmuch-lib)
@@ -37,6 +33,8 @@
 (declare-function notmuch-tree-tag "notmuch-tree" (tag-changes))
 (declare-function notmuch-jump "notmuch-jump" (action-map prompt))
 
+;;; Keys
+
 (define-widget 'notmuch-tag-key-type 'list
   "A single key tagging binding."
   :format "%v"
@@ -68,15 +66,15 @@ The key `notmuch-tag-jump-reverse-key' (k by default) should not
 be used (either as a key, or as the start of a key sequence) as
 it is already bound: it switches the menu to a menu of the
 reverse tagging operations. The reverse of a tagging operation is
-the same list of individual tag-ops but with `+tag` replaced by
-`-tag` and vice versa.
+the same list of individual tag-ops but with `+tag' replaced by
+`-tag' and vice versa.
 
 If setting this variable outside of customize then it should be a
 list of triples (lists of three elements). Each triple should be
 of the form (key-binding tagging-operations name). KEY-BINDING
 can be a single character or a key sequence; TAGGING-OPERATIONS
 should either be a list of individual tag operations each of the
-form `+tag` or `-tag`, or the variable name of a variable that is
+form `+tag' or `-tag', or the variable name of a variable that is
 a list of tagging operations; NAME should be a name for the
 tagging operation, if omitted or empty than then name is taken
 from TAGGING-OPERATIONS."
@@ -84,6 +82,8 @@ from TAGGING-OPERATIONS."
   :type '(repeat notmuch-tag-key-type)
   :group 'notmuch-tag)
 
+;;; Faces and Formats
+
 (define-widget 'notmuch-tag-format-type 'lazy
   "Customize widget for notmuch-tag-format and friends."
   :type '(alist :key-type (regexp :tag "Tag")
@@ -116,7 +116,7 @@ from TAGGING-OPERATIONS."
   '((t :foreground "red"))
   "Default face used for the unread tag.
 
-Used in the default value of `notmuch-tag-formats`."
+Used in the default value of `notmuch-tag-formats'."
   :group 'notmuch-faces)
 
 (defface notmuch-tag-flagged
@@ -128,7 +128,7 @@ Used in the default value of `notmuch-tag-formats`."
      (:foreground "blue")))
   "Face used for the flagged tag.
 
-Used in the default value of `notmuch-tag-formats`."
+Used in the default value of `notmuch-tag-formats'."
   :group 'notmuch-faces)
 
 (defcustom notmuch-tag-formats
@@ -137,20 +137,23 @@ Used in the default value of `notmuch-tag-formats`."
      (notmuch-tag-format-image-data tag (notmuch-tag-star-icon))))
   "Custom formats for individual tags.
 
-This is an association list that maps from tag name regexps to
-lists of formatting expressions.  The first entry whose car
-regexp-matches a tag will be used to format that tag.  The regexp
-is implicitly anchored, so to match a literal tag name, just use
-that tag name (if it contains special regexp characters like
-\".\" or \"*\", these have to be escaped).  The cdr of the
-matching entry gives a list of Elisp expressions that modify the
-tag.  If the list is empty, the tag will simply be hidden.
-Otherwise, each expression will be evaluated in order: for the
-first expression, the variable `tag' will be bound to the tag
-name; for each later expression, the variable `tag' will be bound
-to the result of the previous expression.  In this way, each
+This is an association list of the form ((MATCH EXPR...)...),
+mapping tag name regexps to lists of formatting expressions.
+
+The first entry whose MATCH regexp-matches a tag is used to
+format that tag.  The regexp is implicitly anchored, so to match
+a literal tag name, just use that tag name (if it contains
+special regexp characters like \".\" or \"*\", these have to be
+escaped).
+
+The cdr of the matching entry gives a list of Elisp expressions
+that modify the tag.  If the list is empty, the tag is simply
+hidden.  Otherwise, each expression EXPR is evaluated in order:
+for the first expression, the variable `tag' is bound to the tag
+name; for each later expression, the variable `tag' is bound to
+the result of the previous expression.  In this way, each
 expression can build on the formatting performed by the previous
-expression.  The result of the last expression will displayed in
+expression.  The result of the last expression is displayed in
 place of the tag.
 
 For example, to replace a tag with another string, simply use
@@ -170,7 +173,7 @@ with images."
     (t :inverse-video t))
   "Face used to display deleted tags.
 
-Used in the default value of `notmuch-tag-deleted-formats`."
+Used in the default value of `notmuch-tag-deleted-formats'."
   :group 'notmuch-faces)
 
 (defcustom notmuch-tag-deleted-formats
@@ -178,7 +181,7 @@ Used in the default value of `notmuch-tag-deleted-formats`."
     (".*" (notmuch-apply-face tag `notmuch-tag-deleted)))
   "Custom formats for tags when deleted.
 
-For deleted tags the formats in `notmuch-tag-formats` are applied
+For deleted tags the formats in `notmuch-tag-formats' are applied
 first and then these formats are applied on top; that is `tag'
 passed to the function is the tag with all these previous
 formattings applied. The formatted can access the original
@@ -199,14 +202,14 @@ See `notmuch-tag-formats' for full documentation."
   '((t :underline "green"))
   "Default face used for added tags.
 
-Used in the default value for `notmuch-tag-added-formats`."
+Used in the default value for `notmuch-tag-added-formats'."
   :group 'notmuch-faces)
 
 (defcustom notmuch-tag-added-formats
   '((".*" (notmuch-apply-face tag 'notmuch-tag-added)))
   "Custom formats for tags when added.
 
-For added tags the formats in `notmuch-tag-formats` are applied
+For added tags the formats in `notmuch-tag-formats' are applied
 first and then these formats are applied on top.
 
 To disable special formatting of added tags, set this variable to
@@ -217,6 +220,8 @@ See `notmuch-tag-formats' for full documentation."
   :group 'notmuch-faces
   :type 'notmuch-tag-format-type)
 
+;;; Icons
+
 (defun notmuch-tag-format-image-data (tag data)
   "Replace TAG with image DATA, if available.
 
@@ -270,6 +275,8 @@ This can be used with `notmuch-tag-format-image-data'."
   </g>
 </svg>")
 
+;;; Format Handling
+
 (defvar notmuch-tag--format-cache (make-hash-table :test 'equal)
   "Cache of tag format lookup.  Internal to `notmuch-tag-format-tag'.")
 
@@ -277,32 +284,34 @@ This can be used with `notmuch-tag-format-image-data'."
   "Clear the internal cache of tag formats."
   (clrhash notmuch-tag--format-cache))
 
-(defun notmuch-tag--get-formats (tag format-alist)
+(defun notmuch-tag--get-formats (tag alist)
   "Find the first item whose car regexp-matches TAG."
   (save-match-data
     ;; Don't use assoc-default since there's no way to distinguish a
     ;; missing key from a present key with a null cdr.
-    (cl-assoc tag format-alist
+    (cl-assoc tag alist
              :test (lambda (tag key)
                      (and (eq (string-match key tag) 0)
                           (= (match-end 0) (length tag)))))))
 
-(defun notmuch-tag--do-format (tag formatted-tag formats)
+(defun notmuch-tag--do-format (bare-tag tag formats)
   "Apply a tag-formats entry to TAG."
   (cond ((null formats)                ;; - Tag not in `formats',
-        formatted-tag)         ;;   the format is the tag itself.
+        tag)                   ;;   the format is the tag itself.
        ((null (cdr formats))   ;; - Tag was deliberately hidden,
         nil)                   ;;   no format must be returned
        (t
         ;; Tag was found and has formats, we must apply all the
         ;; formats.  TAG may be null so treat that as a special case.
-        (let ((bare-tag tag)
-              (tag (copy-sequence (or formatted-tag ""))))
+        (let ((return-tag (copy-sequence (or tag ""))))
           (dolist (format (cdr formats))
-            (setq tag (eval format)))
-          (if (and (null formatted-tag) (equal tag ""))
+            (setq return-tag
+                  (eval format
+                        `((bare-tag . ,bare-tag)
+                          (tag . ,return-tag)))))
+          (if (and (null tag) (equal return-tag ""))
               nil
-            tag)))))
+            return-tag)))))
 
 (defun notmuch-tag-format-tag (tags orig-tags tag)
   "Format TAG according to `notmuch-tag-formats'.
@@ -347,6 +356,8 @@ changed (the normal case) are shown using formats from
      face
      t)))
 
+;;; Hooks
+
 (defcustom notmuch-before-tag-hook nil
   "Hooks that are run before tags of a message are modified.
 
@@ -369,18 +380,18 @@ the messages that were tagged."
   :options '(notmuch-hl-line-mode)
   :group 'notmuch-hooks)
 
+;;; User Input
+
 (defvar notmuch-select-tag-history nil
-  "Variable to store minibuffer history for
-`notmuch-select-tag-with-completion' function.")
+  "Minibuffer history of `notmuch-select-tag-with-completion' function.")
 
 (defvar notmuch-read-tag-changes-history nil
-  "Variable to store minibuffer history for
-`notmuch-read-tag-changes' function.")
+  "Minibuffer history of `notmuch-read-tag-changes' function.")
 
 (defun notmuch-tag-completions (&rest search-terms)
   "Return a list of tags for messages matching SEARCH-TERMS.
 
-Returns all tags if no search terms are given."
+Return all tags if no search terms are given."
   (unless search-terms
     (setq search-terms (list "*")))
   (split-string
@@ -391,14 +402,15 @@ Returns all tags if no search terms are given."
    "\n+" t))
 
 (defun notmuch-select-tag-with-completion (prompt &rest search-terms)
-  (let ((tag-list (apply #'notmuch-tag-completions search-terms)))
-    (completing-read prompt tag-list nil nil nil 'notmuch-select-tag-history)))
+  (completing-read prompt
+                  (apply #'notmuch-tag-completions search-terms)
+                  nil nil nil 'notmuch-select-tag-history))
 
 (defun notmuch-read-tag-changes (current-tags &optional prompt initial-input)
   "Prompt for tag changes in the minibuffer.
 
-CURRENT-TAGS is a list of tags that are present on the message or
-messages to be changed.  These are offered as tag removal
+CURRENT-TAGS is a list of tags that are present on the message
+or messages to be changed.  These are offered as tag removal
 completions.  CURRENT-TAGS may contain duplicates.  PROMPT, if
 non-nil, is the query string to present in the minibuffer.  It
 defaults to \"Tags\".  INITIAL-INPUT, if non-nil, will be the
@@ -429,6 +441,8 @@ initial input in the minibuffer."
                nil nil initial-input
                'notmuch-read-tag-changes-history))))
 
+;;; Tagging
+
 (defun notmuch-update-tags (tags tag-changes)
   "Return a copy of TAGS with additions and removals from TAG-CHANGES.
 
@@ -438,9 +452,9 @@ present or a \"-\" to indicate that the tag should be removed
 from TAGS if present."
   (let ((result-tags (copy-sequence tags)))
     (dolist (tag-change tag-changes)
-      (let ((op (string-to-char tag-change))
-           (tag (unless (string= tag-change "") (substring tag-change 1))))
-       (cl-case op
+      (let ((tag (and (not (string-empty-p tag-change))
+                     (substring tag-change 1))))
+       (cl-case (aref tag-change 0)
          (?+ (unless (member tag result-tags)
                (push tag result-tags)))
          (?- (setq result-tags (delete tag result-tags)))
@@ -466,13 +480,12 @@ messages instead of running (notmuch-call-notmuch-process \"tag\" ..)
 directly, so that hooks specified in notmuch-before-tag-hook and
 notmuch-after-tag-hook will be run."
   ;; Perform some validation
-  (mapc (lambda (tag-change)
-         (unless (string-match-p "^[-+]\\S-+$" tag-change)
-           (error "Tag must be of the form `+this_tag' or `-that_tag'")))
-       tag-changes)
+  (dolist (tag-change tag-changes)
+    (unless (string-match-p "^[-+]\\S-+$" tag-change)
+      (error "Tag must be of the form `+this_tag' or `-that_tag'")))
   (unless query
     (error "Nothing to tag!"))
-  (unless (null tag-changes)
+  (when tag-changes
     (run-hooks 'notmuch-before-tag-hook)
     (if (<= (length query) notmuch-tag-argument-limit)
        (apply 'notmuch-call-notmuch-process "tag"
@@ -506,7 +519,7 @@ begin with a \"+\" or a \"-\". If REVERSE is non-nil, replace all
 Creates and displays a jump menu for the tagging operations
 specified in `notmuch-tagging-keys'. If REVERSE is set then it
 offers a menu of the reverses of the operations specified in
-`notmuch-tagging-keys'; i.e. each `+tag` is replaced by `-tag`
+`notmuch-tagging-keys'; i.e. each `+tag' is replaced by `-tag'
 and vice versa."
   ;; In principle this function is simple, but it has to deal with
   ;; lots of cases: different modes (search/show/tree), whether a name
@@ -524,7 +537,7 @@ and vice versa."
                      (symbol-value tag)
                    tag))
             (tag-change (if reverse
-                            (notmuch-tag-change-list tag 't)
+                            (notmuch-tag-change-list tag t)
                           tag))
             (name (or (and (not (string= name ""))
                            name)
@@ -547,7 +560,7 @@ and vice versa."
     (setq action-map (nreverse action-map))
     (notmuch-jump action-map "Tag: ")))
 
-;;
+;;; _
 
 (provide 'notmuch-tag)
 
index f342f85aadd89bc5c9300426629c35124fa67f2c..13007a134d0a9f4e8cd40a7a57bb2f9663884ee1 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-tree.el --- displaying notmuch forests
+;;; notmuch-tree.el --- displaying notmuch forests  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Carl Worth
 ;; Copyright © David Edmondson
@@ -24,8 +24,6 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
-
 (require 'mail-parse)
 
 (require 'notmuch-lib)
 (declare-function notmuch-search-find-thread-id "notmuch" (&optional bare))
 (declare-function notmuch-search-find-subject "notmuch" ())
 
+;; For `notmuch-tree-next-thread-from-search'.
+(declare-function notmuch-search-next-thread "notmuch" ())
+(declare-function notmuch-search-previous-thread "notmuch" ())
+(declare-function notmuch-tree-from-search-thread "notmuch" ())
+
 ;; the following variable is defined in notmuch.el
 (defvar notmuch-search-query-string)
 
 ;; this variable distinguishes the unthreaded display from the normal tree display
-(defvar notmuch-tree-unthreaded nil
+(defvar-local notmuch-tree-unthreaded nil
   "A buffer local copy of argument unthreaded to the function notmuch-tree.")
-(make-variable-buffer-local 'notmuch-tree-unthreaded)
+
+;;; Options
 
 (defgroup notmuch-tree nil
   "Showing message and thread structure."
@@ -114,7 +118,9 @@ For example:
       notmuch-unthreaded-result-format
     notmuch-tree-result-format))
 
-;; Faces for messages that match the query.
+;;; Faces
+;;;; Faces for messages that match the query
+
 (defface notmuch-tree-match-face
   '((t :inherit default))
   "Default face used in tree mode face for matching messages"
@@ -165,7 +171,8 @@ For example:
   :group 'notmuch-tree
   :group 'notmuch-faces)
 
-;; Faces for messages that do not match the query.
+;;;; Faces for messages that do not match the query
+
 (defface notmuch-tree-no-match-face
   '((t (:foreground "gray")))
   "Default face used in tree mode face for non-matching messages."
@@ -202,105 +209,121 @@ For example:
   :group 'notmuch-tree
   :group 'notmuch-faces)
 
-(defvar notmuch-tree-previous-subject
+;;; Variables
+
+(defvar-local notmuch-tree-previous-subject
   "The subject of the most recent result shown during the async display.")
-(make-variable-buffer-local 'notmuch-tree-previous-subject)
 
-(defvar notmuch-tree-basic-query nil
+(defvar-local notmuch-tree-basic-query nil
   "A buffer local copy of argument query to the function notmuch-tree.")
-(make-variable-buffer-local 'notmuch-tree-basic-query)
 
-(defvar notmuch-tree-query-context nil
+(defvar-local notmuch-tree-query-context nil
   "A buffer local copy of argument query-context to the function notmuch-tree.")
-(make-variable-buffer-local 'notmuch-tree-query-context)
 
-(defvar notmuch-tree-target-msg nil
+(defvar-local notmuch-tree-target-msg nil
   "A buffer local copy of argument target to the function notmuch-tree.")
-(make-variable-buffer-local 'notmuch-tree-target-msg)
 
-(defvar notmuch-tree-open-target nil
+(defvar-local notmuch-tree-open-target nil
   "A buffer local copy of argument open-target to the function notmuch-tree.")
-(make-variable-buffer-local 'notmuch-tree-open-target)
 
-(defvar notmuch-tree-parent-buffer nil)
-(make-variable-buffer-local 'notmuch-tree-parent-buffer)
+(defvar-local notmuch-tree-parent-buffer nil)
 
-(defvar notmuch-tree-message-window nil
+(defvar-local notmuch-tree-message-window nil
   "The window of the message pane.
 
 It is set in both the tree buffer and the child show buffer. It
 is used to try and close the message pane when quitting tree view
 or the child show buffer.")
-(make-variable-buffer-local 'notmuch-tree-message-window)
 (put 'notmuch-tree-message-window 'permanent-local t)
 
-(defvar notmuch-tree-message-buffer nil
+(defvar-local notmuch-tree-message-buffer nil
   "The buffer name of the show buffer in the message pane.
 
 This is used to try and make sure we don't close the message pane
 if the user has loaded a different buffer in that window.")
-(make-variable-buffer-local 'notmuch-tree-message-buffer)
 (put 'notmuch-tree-message-buffer 'permanent-local t)
 
-(defun notmuch-tree-to-message-pane (func)
-  "Execute FUNC in message pane.
+;;; Tree wrapper commands
 
-This function returns a function (so can be used as a keybinding)
-which executes function FUNC in the message pane if it is
-open (if the message pane is closed it does nothing)."
-  `(lambda ()
-     ,(concat "(In message pane) " (documentation func t))
+(defmacro notmuch-tree--define-do-in-message-window (name cmd)
+  "Define NAME as a command that calls CMD interactively in the message window.
+If the message pane is closed then this command does nothing.
+Avoid using this macro in new code; it will be removed."
+  `(defun ,name ()
+     ,(concat "(In message window) " (documentation cmd t))
      (interactive)
      (when (window-live-p notmuch-tree-message-window)
        (with-selected-window notmuch-tree-message-window
-        (call-interactively #',func)))))
-
-(defun notmuch-tree-inherit-from-message-pane (sym)
-  "Return value of SYM in message-pane if open, or tree-pane if not."
+        (call-interactively #',cmd)))))
+
+(notmuch-tree--define-do-in-message-window
+ notmuch-tree-previous-message-button
+ notmuch-show-previous-button)
+(notmuch-tree--define-do-in-message-window
+ notmuch-tree-next-message-button
+ notmuch-show-next-button)
+(notmuch-tree--define-do-in-message-window
+ notmuch-tree-toggle-message-process-crypto
+ notmuch-show-toggle-process-crypto)
+
+(defun notmuch-tree--message-process-crypto ()
+  "Return value of `notmuch-show-process-crypto' in the message window.
+If that window isn't alive, then return the current value.
+Avoid using this function in new code; it will be removed."
   (if (window-live-p notmuch-tree-message-window)
       (with-selected-window notmuch-tree-message-window
-       (symbol-value sym))
-    (symbol-value sym)))
-
-(defun notmuch-tree-button-activate (&optional button)
-  "Activate BUTTON or button at point.
-
-This function does not give an error if there is no button."
-  (interactive)
-  (let ((button (or button (button-at (point)))))
-    (when button (button-activate button))))
-
-(defun notmuch-tree-close-message-pane-and (func)
-  "Close message pane and execute FUNC.
-
-This function returns a function (so can be used as a keybinding)
-which closes the message pane if open and then executes function
-FUNC."
-  `(lambda ()
-     ,(concat "(Close message pane and) " (documentation func t))
+       notmuch-show-process-crypto)
+    notmuch-show-process-crypto))
+
+(defmacro notmuch-tree--define-close-message-window-and (name cmd)
+  "Define NAME as a variant of CMD.
+
+NAME determines the value of `notmuch-show-process-crypto' in the
+message window, closes the window, and then call CMD interactively
+with that value let-bound.  If the message window does not exist,
+then NAME behaves like CMD."
+  `(defun ,name ()
+     ,(concat "(Close message pane and) " (documentation cmd t))
      (interactive)
      (let ((notmuch-show-process-crypto
-           (notmuch-tree-inherit-from-message-pane 'notmuch-show-process-crypto)))
+           (notmuch-tree--message-process-crypto)))
        (notmuch-tree-close-message-window)
-       (call-interactively #',func))))
+       (call-interactively #',cmd))))
+
+(notmuch-tree--define-close-message-window-and
+ notmuch-tree-help
+ notmuch-help)
+(notmuch-tree--define-close-message-window-and
+ notmuch-tree-new-mail
+ notmuch-mua-new-mail)
+(notmuch-tree--define-close-message-window-and
+ notmuch-tree-jump-search
+ notmuch-jump-search)
+(notmuch-tree--define-close-message-window-and
+ notmuch-tree-forward-message
+ notmuch-show-forward-message)
+(notmuch-tree--define-close-message-window-and
+ notmuch-tree-reply-sender
+ notmuch-show-reply-sender)
+(notmuch-tree--define-close-message-window-and
+ notmuch-tree-reply
+ notmuch-show-reply)
+(notmuch-tree--define-close-message-window-and
+ notmuch-tree-view-raw-message
+ notmuch-show-view-raw-message)
+
+;;; Keymap
 
 (defvar notmuch-tree-mode-map
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map notmuch-common-keymap)
-    ;; The following override the global keymap.
-    ;; Override because we want to close message pane first.
-    (define-key map [remap notmuch-help]
-      (notmuch-tree-close-message-pane-and #'notmuch-help))
-    ;; Override because we first close message pane and then close tree buffer.
+    ;; These bindings shadow common bindings with variants
+    ;; that additionally close the message window.
     (define-key map [remap notmuch-bury-or-kill-this-buffer] 'notmuch-tree-quit)
-    ;; Override because we close message pane after the search query is entered.
-    (define-key map [remap notmuch-search] 'notmuch-tree-to-search)
-    ;; Override because we want to close message pane first.
-    (define-key map [remap notmuch-mua-new-mail]
-      (notmuch-tree-close-message-pane-and #'notmuch-mua-new-mail))
-    ;; Override because we want to close message pane first.
-    (define-key map [remap notmuch-jump-search]
-      (notmuch-tree-close-message-pane-and #'notmuch-jump-search))
+    (define-key map [remap notmuch-search]       'notmuch-tree-to-search)
+    (define-key map [remap notmuch-help]         'notmuch-tree-help)
+    (define-key map [remap notmuch-mua-new-mail] 'notmuch-tree-new-mail)
+    (define-key map [remap notmuch-jump-search]  'notmuch-tree-jump-search)
 
     (define-key map "S" 'notmuch-search-from-tree-current-query)
     (define-key map "U" 'notmuch-unthreaded-from-tree-current-query)
@@ -314,24 +337,16 @@ FUNC."
     (define-key map "b" 'notmuch-show-resend-message)
 
     ;; these apply to the message pane
-    (define-key map (kbd "M-TAB")
-      (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
-    (define-key map (kbd "<backtab>")
-      (notmuch-tree-to-message-pane #'notmuch-show-previous-button))
-    (define-key map (kbd "TAB")
-      (notmuch-tree-to-message-pane #'notmuch-show-next-button))
-    (define-key map "$"
-      (notmuch-tree-to-message-pane #'notmuch-show-toggle-process-crypto))
+    (define-key map (kbd "M-TAB")     'notmuch-tree-previous-message-button)
+    (define-key map (kbd "<backtab>") 'notmuch-tree-previous-message-button)
+    (define-key map (kbd "TAB")       'notmuch-tree-next-message-button)
+    (define-key map "$" 'notmuch-tree-toggle-message-process-crypto)
 
     ;; bindings from show (or elsewhere) but we close the message pane first.
-    (define-key map "f"
-      (notmuch-tree-close-message-pane-and #'notmuch-show-forward-message))
-    (define-key map "r"
-      (notmuch-tree-close-message-pane-and #'notmuch-show-reply-sender))
-    (define-key map "R"
-      (notmuch-tree-close-message-pane-and #'notmuch-show-reply))
-    (define-key map "V"
-      (notmuch-tree-close-message-pane-and #'notmuch-show-view-raw-message))
+    (define-key map "f" 'notmuch-tree-forward-message)
+    (define-key map "r" 'notmuch-tree-reply-sender)
+    (define-key map "R" 'notmuch-tree-reply)
+    (define-key map "V" 'notmuch-tree-view-raw-message)
 
     ;; The main tree view bindings
     (define-key map (kbd "RET") 'notmuch-tree-show-message)
@@ -354,8 +369,10 @@ FUNC."
     (define-key map " " 'notmuch-tree-scroll-or-next)
     (define-key map (kbd "DEL") 'notmuch-tree-scroll-message-window-back)
     (define-key map "e" 'notmuch-tree-resume-message)
-    map))
-(fset 'notmuch-tree-mode-map notmuch-tree-mode-map)
+    map)
+  "Keymap for \"notmuch tree\" buffers.")
+
+;;; Message properties
 
 (defun notmuch-tree-get-message-properties ()
   "Return the properties of the current message as a plist.
@@ -382,9 +399,8 @@ Some useful entries are:
     (notmuch-tree-set-message-properties props)))
 
 (defun notmuch-tree-get-prop (prop &optional props)
-  (let ((props (or props
-                  (notmuch-tree-get-message-properties))))
-    (plist-get props prop)))
+  (plist-get (or props (notmuch-tree-get-message-properties))
+            prop))
 
 (defun notmuch-tree-set-tags (tags)
   "Set the tags of the current message."
@@ -405,9 +421,10 @@ Some useful entries are:
 
 (defun notmuch-tree-get-match ()
   "Return whether the current message is a match."
-  (interactive)
   (notmuch-tree-get-prop :match))
 
+;;; Update display
+
 (defun notmuch-tree-refresh-result ()
   "Redisplay the current message line.
 
@@ -450,6 +467,8 @@ NOT change the database."
          (when (string= tree-msg-id (notmuch-show-get-message-id))
            (notmuch-show-update-tags new-tags)))))))
 
+;;; Commands (and some helper functions used by them)
+
 (defun notmuch-tree-tag (tag-changes)
   "Change tags for the current message."
   (interactive
@@ -526,9 +545,10 @@ NOT change the database."
   (let ((buffer (current-buffer)))
     (when (and (window-live-p notmuch-tree-message-window)
               (eq (window-buffer notmuch-tree-message-window) buffer))
-      ;; We do not want an error if this is the sole window in the
-      ;; frame and I do not know how to test for that in emacs pre
-      ;; 24. Hence we just ignore-errors.
+      ;; We could check whether this is the only window in its frame,
+      ;; but simply ignoring the error that is thrown otherwise is
+      ;; what we had to do for Emacs 24 and we stick to that because
+      ;; it is still the simplest approach.
       (ignore-errors
        (delete-window notmuch-tree-message-window)))))
 
@@ -574,8 +594,7 @@ NOT change the database."
   "Show the current message (in whole window)."
   (interactive)
   (let ((id (notmuch-tree-get-message-id))
-       (inhibit-read-only t)
-       buffer)
+       (inhibit-read-only t))
     (when id
       ;; We close the window to kill off un-needed buffers.
       (notmuch-tree-close-message-window)
@@ -768,8 +787,7 @@ search results instead."
       (notmuch-tree-from-search-thread))))
 
 (defun notmuch-tree-next-thread (&optional previous)
-  "Move to the next thread in the current tree or parent search
-results
+  "Move to the next thread in the current tree or parent search results.
 
 If PREVIOUS is non-nil, move to the previous thread in the tree or
 search results instead."
@@ -779,14 +797,13 @@ search results instead."
     (notmuch-tree-next-thread-from-search previous)))
 
 (defun notmuch-tree-prev-thread ()
-  "Move to the previous thread in the current tree or parent search
-results"
+  "Move to the previous thread in the current tree or parent search results."
   (interactive)
   (notmuch-tree-next-thread t))
 
 (defun notmuch-tree-thread-mapcar (function)
-  "Iterate through all messages in the current thread
- and call FUNCTION for side effects."
+  "Call FUNCTION for each message in the current thread.
+FUNCTION is called for side effects only."
   (save-excursion
     (notmuch-tree-thread-top)
     (cl-loop collect (funcall function)
@@ -828,7 +845,7 @@ buffer."
     (notmuch-tree-tag-thread
      (notmuch-tag-change-list notmuch-archive-tags unarchive))))
 
-;; Functions below here display the tree buffer itself.
+;;; Functions for displaying the tree buffer itself
 
 (defun notmuch-tree-clean-address (address)
   "Try to clean a single email ADDRESS for display. Return
@@ -1009,19 +1026,17 @@ Complete list of currently available key bindings:
   (setq buffer-read-only t)
   (setq truncate-lines t))
 
-(defun notmuch-tree-process-sentinel (proc msg)
+(defun notmuch-tree-process-sentinel (proc _msg)
   "Add a message to let user know when \"notmuch tree\" exits."
   (let ((buffer (process-buffer proc))
        (status (process-status proc))
-       (exit-status (process-exit-status proc))
-       (never-found-target-thread nil))
+       (exit-status (process-exit-status proc)))
     (when (memq status '(exit signal))
       (kill-buffer (process-get proc 'parse-buf))
       (when (buffer-live-p buffer)
        (with-current-buffer buffer
          (save-excursion
-           (let ((inhibit-read-only t)
-                 (atbob (bobp)))
+           (let ((inhibit-read-only t))
              (goto-char (point-max))
              (when (eq status 'signal)
                (insert "Incomplete search results (tree view process was killed).\n"))
@@ -1035,8 +1050,7 @@ Complete list of currently available key bindings:
   "Process and filter the output of \"notmuch show\" for tree view."
   (let ((results-buf (process-buffer proc))
        (parse-buf (process-get proc 'parse-buf))
-       (inhibit-read-only t)
-       done)
+       (inhibit-read-only t))
     (if (not (buffer-live-p results-buf))
        (delete-process proc)
       (with-current-buffer parse-buf
@@ -1126,7 +1140,7 @@ The arguments are:
        (inhibit-read-only t))
     (pop-to-buffer-same-window buffer))
   ;; Don't track undo information for this buffer
-  (set 'buffer-undo-list t)
+  (setbuffer-undo-list t)
   (notmuch-tree-worker query query-context target open-target unthreaded)
   (setq notmuch-tree-parent-buffer parent-buffer)
   (setq truncate-lines t))
@@ -1135,7 +1149,7 @@ The arguments are:
   (interactive)
   (notmuch-tree query query-context target buffer-name open-target t))
 
-;;
+;;; _
 
 (provide 'notmuch-tree)
 
index ce4b963727696986405ad59d387994ba1f7c1a94..653ecc2ae7d5d4e07ff8a87c9ed95315fb3c30bb 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch-wash.el --- cleaning up message bodies
+;;; notmuch-wash.el --- cleaning up message bodies  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Carl Worth
 ;; Copyright © David Edmondson
 ;;; Code:
 
 (require 'coolj)
+(require 'diff-mode)
 (require 'notmuch-lib)
 
 (declare-function notmuch-show-insert-bodypart "notmuch-show"
                  (msg part depth &optional hide))
 (defvar notmuch-show-indent-messages-width)
 
-;;
+;;; Options
 
 (defgroup notmuch-wash nil
   "Cleaning up messages for display."
@@ -130,6 +131,8 @@ or at the window width (whichever one is lower)."
                 (integer :tag "number of characters"))
   :group 'notmuch-wash)
 
+;;; Faces
+
 (defface notmuch-wash-toggle-button
   '((t (:inherit font-lock-comment-face)))
   "Face used for buttons toggling the visibility of washed away
@@ -143,6 +146,8 @@ message parts."
   :group 'notmuch-wash
   :group 'notmuch-faces)
 
+;;; Buttons
+
 (defun notmuch-wash-toggle-invisible-action (cite-button)
   ;; Toggle overlay visibility
   (let ((overlay (button-get cite-button 'overlay)))
@@ -196,7 +201,7 @@ message parts."
                                   (overlay-end overlay))))
     (format label-format lines-count)))
 
-(defun notmuch-wash-region-to-button (msg beg end type &optional prefix)
+(defun notmuch-wash-region-to-button (beg end type &optional prefix)
   "Auxiliary function to do the actual making of overlays and buttons.
 
 BEG and END are buffer locations. TYPE should a string, either
@@ -225,17 +230,17 @@ that PREFIX should not include a newline."
                                   :type button-type)))
          (overlay-put overlay 'notmuch-wash-button button))))))
 
-(defun notmuch-wash-excerpt-citations (msg depth)
+;;; Hook functions
+
+(defun notmuch-wash-excerpt-citations (_msg _depth)
   "Excerpt citations and up to one signature."
   (goto-char (point-min))
   (beginning-of-line)
   (when (and (< (point) (point-max))
             (re-search-forward notmuch-wash-original-regexp nil t))
-    (let* ((msg-start (match-beginning 0))
-          (msg-end (point-max))
-          (msg-lines (count-lines msg-start msg-end)))
-      (notmuch-wash-region-to-button
-       msg msg-start msg-end "original")))
+    (notmuch-wash-region-to-button (match-beginning 0)
+                                  (point-max)
+                                  "original"))
   (while (and (< (point) (point-max))
              (re-search-forward notmuch-wash-citation-regexp nil t))
     (let* ((cite-start (match-beginning 0))
@@ -252,14 +257,13 @@ that PREFIX should not include a newline."
          (goto-char cite-end)
          (forward-line (- notmuch-wash-citation-lines-suffix))
          (notmuch-wash-region-to-button
-          msg hidden-start (point-marker)
+          hidden-start (point-marker)
           "citation")))))
   (when (and (not (eobp))
             (re-search-forward notmuch-wash-signature-regexp nil t))
-    (let* ((sig-start (match-beginning 0))
-          (sig-end (match-end 0))
-          (sig-lines (count-lines sig-start (point-max))))
-      (when (<= sig-lines notmuch-wash-signature-lines-max)
+    (let ((sig-start (match-beginning 0)))
+      (when (<= (count-lines sig-start (point-max))
+               notmuch-wash-signature-lines-max)
        (let ((sig-start-marker (make-marker))
              (sig-end-marker (make-marker)))
          (set-marker sig-start-marker sig-start)
@@ -267,12 +271,10 @@ that PREFIX should not include a newline."
          (overlay-put (make-overlay sig-start-marker sig-end-marker)
                       'face 'message-cited-text)
          (notmuch-wash-region-to-button
-          msg sig-start-marker sig-end-marker
+          sig-start-marker sig-end-marker
           "signature"))))))
 
-;;
-
-(defun notmuch-wash-elide-blank-lines (msg depth)
+(defun notmuch-wash-elide-blank-lines (_msg _depth)
   "Elide leading, trailing and successive blank lines."
   ;; Algorithm derived from `article-strip-multiple-blank-lines' in
   ;; `gnus-art.el'.
@@ -293,9 +295,7 @@ that PREFIX should not include a newline."
   (when (looking-at "\n")
     (delete-region (match-beginning 0) (match-end 0))))
 
-;;
-
-(defun notmuch-wash-tidy-citations (msg depth)
+(defun notmuch-wash-tidy-citations (_msg _depth)
   "Improve the display of cited regions of a message.
 
 Perform several transformations on the message body:
@@ -319,9 +319,7 @@ Perform several transformations on the message body:
   (while (re-search-forward "\\(^>[> ]*\n\\)\\(^$\\|^[^>].*\\)" nil t)
     (replace-match "\\2")))
 
-;;
-
-(defun notmuch-wash-wrap-long-lines (msg depth)
+(defun notmuch-wash-wrap-long-lines (_msg depth)
   "Wrap long lines in the message.
 
 If `notmuch-wash-wrap-lines-length' is a number, this will wrap
@@ -342,11 +340,7 @@ the wrapped text are maintained."
                         2)))
     (coolj-wrap-region (point-min) (point-max))))
 
-;;
-
-(require 'diff-mode)
-
-(defvar diff-file-header-re) ; From `diff-mode.el'.
+;;;; Convert Inline Patches
 
 (defun notmuch-wash-subject-to-filename (subject &optional maxlen)
   "Convert a mail SUBJECT into a filename.
@@ -417,7 +411,7 @@ for error."
        (delete-region (point-min) (point-max))
        (notmuch-show-insert-bodypart nil part depth)))))
 
-;;
+;;; _
 
 (provide 'notmuch-wash)
 
index 83bcee57c675bce1959275315a782c4319c9622a..6d37c623e6597cb4f43c0d6029b2f9502f93c89f 100644 (file)
@@ -1,4 +1,4 @@
-;;; notmuch.el --- run notmuch within emacs
+;;; notmuch.el --- run notmuch within emacs  -*- lexical-binding: t -*-
 ;;
 ;; Copyright © Carl Worth
 ;;
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
-
 (require 'mm-view)
 (require 'message)
 
+(require 'hl-line)
+
 (require 'notmuch-lib)
 (require 'notmuch-tag)
 (require 'notmuch-show)
@@ -80,6 +80,8 @@
 (require 'notmuch-message)
 (require 'notmuch-parser)
 
+;;; Options
+
 (defcustom notmuch-search-result-format
   `(("date" . "%12s ")
     ("count" . "%-7s ")
@@ -112,8 +114,14 @@ there will be called at other points of notmuch execution."
   :type 'file
   :group 'notmuch)
 
-(defvar notmuch-query-history nil
-  "Variable to store minibuffer history for notmuch queries.")
+(defcustom notmuch-search-hook '(notmuch-hl-line-mode)
+  "List of functions to call when notmuch displays the search results."
+  :type 'hook
+  :options '(notmuch-hl-line-mode)
+  :group 'notmuch-search
+  :group 'notmuch-hooks)
+
+;;; Mime Utilities
 
 (defun notmuch-foreach-mime-part (function mm-handle)
   (cond ((stringp (car mm-handle))
@@ -151,25 +159,13 @@ there will be called at other points of notmuch execution."
            (mm-save-part p))))
    mm-handle))
 
-(require 'hl-line)
-
-(defun notmuch-hl-line-mode ()
-  (prog1 (hl-line-mode)
-    (when hl-line-overlay
-      (overlay-put hl-line-overlay 'priority 1))))
-
-(defcustom notmuch-search-hook '(notmuch-hl-line-mode)
-  "List of functions to call when notmuch displays the search results."
-  :type 'hook
-  :options '(notmuch-hl-line-mode)
-  :group 'notmuch-search
-  :group 'notmuch-hooks)
+;;; Keymap
 
 (defvar notmuch-search-mode-map
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map notmuch-common-keymap)
     (define-key map "x" 'notmuch-bury-or-kill-this-buffer)
-    (define-key map (kbd "<DEL>") 'notmuch-search-scroll-down)
+    (define-key map (kbd "DEL") 'notmuch-search-scroll-down)
     (define-key map "b" 'notmuch-search-scroll-down)
     (define-key map " " 'notmuch-search-scroll-up)
     (define-key map "<" 'notmuch-search-first-thread)
@@ -194,7 +190,17 @@ there will be called at other points of notmuch execution."
     (define-key map "U" 'notmuch-unthreaded-from-search-current-query)
     map)
   "Keymap for \"notmuch search\" buffers.")
-(fset 'notmuch-search-mode-map notmuch-search-mode-map)
+
+;;; Internal Variables
+
+(defvar notmuch-query-history nil
+  "Variable to store minibuffer history for notmuch queries.")
+
+(defvar-local notmuch-search-query-string nil)
+(defvar-local notmuch-search-target-thread nil)
+(defvar-local notmuch-search-target-line nil)
+
+;;; Stashing
 
 (defvar notmuch-search-stash-map
   (let ((map (make-sparse-keymap)))
@@ -213,13 +219,9 @@ there will be called at other points of notmuch execution."
 (defun notmuch-stash-query ()
   "Copy current query to kill-ring."
   (interactive)
-  (notmuch-common-do-stash (notmuch-search-get-query)))
-
-(defvar notmuch-search-query-string)
-(defvar notmuch-search-target-thread)
-(defvar notmuch-search-target-line)
+  (notmuch-common-do-stash notmuch-search-query-string))
 
-(defvar notmuch-search-disjunctive-regexp      "\\<[oO][rR]\\>")
+;;; Movement
 
 (defun notmuch-search-scroll-up ()
   "Move forward through search results by one window's worth."
@@ -272,6 +274,8 @@ there will be called at other points of notmuch execution."
   (interactive)
   (goto-char (point-min)))
 
+;;; Faces
+
 (defface notmuch-message-summary-face
   `((((class color) (background light))
      ,@(and (>= emacs-major-version 27) '(:extend t))
@@ -343,7 +347,7 @@ there will be called at other points of notmuch execution."
   "Face used in search mode face for flagged threads.
 
 This face is the default value for the \"flagged\" tag in
-`notmuch-search-line-faces`."
+`notmuch-search-line-faces'."
   :group 'notmuch-search
   :group 'notmuch-faces)
 
@@ -353,10 +357,12 @@ This face is the default value for the \"flagged\" tag in
   "Face used in search mode for unread threads.
 
 This face is the default value for the \"unread\" tag in
-`notmuch-search-line-faces`."
+`notmuch-search-line-faces'."
   :group 'notmuch-search
   :group 'notmuch-faces)
 
+;;; Mode
+
 (define-derived-mode notmuch-search-mode fundamental-mode "notmuch-search"
   "Major mode displaying results of a notmuch search.
 
@@ -387,12 +393,8 @@ new, global search.
 Complete list of currently available key bindings:
 
 \\{notmuch-search-mode-map}"
-  (make-local-variable 'notmuch-search-query-string)
-  (make-local-variable 'notmuch-search-oldest-first)
-  (make-local-variable 'notmuch-search-target-thread)
-  (make-local-variable 'notmuch-search-target-line)
   (setq notmuch-buffer-refresh-function #'notmuch-search-refresh-view)
-  (set (make-local-variable 'scroll-preserve-screen-position) t)
+  (setq-local scroll-preserve-screen-position t)
   (add-to-invisibility-spec (cons 'ellipsis t))
   (setq truncate-lines t)
   (setq buffer-read-only t)
@@ -401,6 +403,8 @@ Complete list of currently available key bindings:
   (setq imenu-extract-index-name-function
        #'notmuch-search-imenu-extract-index-name-function))
 
+;;; Search Results
+
 (defun notmuch-search-get-result (&optional pos)
   "Return the result object for the thread at POS (or point).
 
@@ -473,7 +477,7 @@ If BARE is set then do not prefix with \"thread:\"."
 (defun notmuch-search-find-stable-query ()
   "Return the stable queries for the current thread.
 
-This returns a list (MATCHED-QUERY UNMATCHED-QUERY) for the
+Return a list (MATCHED-QUERY UNMATCHED-QUERY) for the
 matched and unmatched messages in the current thread."
   (plist-get (notmuch-search-get-result) :query))
 
@@ -515,17 +519,16 @@ With a prefix argument, invert the default value of
 `notmuch-show-only-matching-messages' when displaying the
 thread."
   (interactive "P")
-  (let ((thread-id (notmuch-search-find-thread-id))
-       (subject (notmuch-search-find-subject)))
-    (if (> (length thread-id) 0)
+  (let ((thread-id (notmuch-search-find-thread-id)))
+    (if thread-id
        (notmuch-show thread-id
                      elide-toggle
                      (current-buffer)
                      notmuch-search-query-string
                      ;; Name the buffer based on the subject.
-                     (concat "*"
-                             (truncate-string-to-width subject 30 nil nil t)
-                             "*"))
+                     (format "*%s*" (truncate-string-to-width
+                                     (notmuch-search-find-subject)
+                                     30 nil nil t)))
       (message "End of search results."))))
 
 (defun notmuch-tree-from-search-current-query ()
@@ -550,18 +553,21 @@ thread."
 (defun notmuch-search-reply-to-thread (&optional prompt-for-sender)
   "Begin composing a reply-all to the entire current thread in a new buffer."
   (interactive "P")
-  (let ((message-id (notmuch-search-find-thread-id)))
-    (notmuch-mua-new-reply message-id prompt-for-sender t)))
+  (notmuch-mua-new-reply (notmuch-search-find-thread-id)
+                        prompt-for-sender t))
 
 (defun notmuch-search-reply-to-thread-sender (&optional prompt-for-sender)
   "Begin composing a reply to the entire current thread in a new buffer."
   (interactive "P")
-  (let ((message-id (notmuch-search-find-thread-id)))
-    (notmuch-mua-new-reply message-id prompt-for-sender nil)))
+  (notmuch-mua-new-reply (notmuch-search-find-thread-id)
+                        prompt-for-sender nil))
+
+;;; Tags
 
 (defun notmuch-search-set-tags (tags &optional pos)
-  (let ((new-result (plist-put (notmuch-search-get-result pos) :tags tags)))
-    (notmuch-search-update-result new-result pos)))
+  (notmuch-search-update-result
+   (plist-put (notmuch-search-get-result pos) :tags tags)
+   pos))
 
 (defun notmuch-search-get-tags (&optional pos)
   (plist-get (notmuch-search-get-result pos) :tags))
@@ -571,12 +577,12 @@ thread."
     (notmuch-search-foreach-result beg end
       (lambda (pos)
        (setq output (append output (notmuch-search-get-tags pos)))))
-    output))
+    (delete-dups output)))
 
 (defun notmuch-search-interactive-tag-changes (&optional initial-input)
   "Prompt for tag changes for the current thread or region.
 
-Returns (TAG-CHANGES REGION-BEGIN REGION-END)."
+Return (TAG-CHANGES REGION-BEGIN REGION-END)."
   (pcase-let ((`(,beg ,end) (notmuch-interactive-region)))
     (list (notmuch-read-tag-changes (notmuch-search-get-tags-region beg end)
                                    (if (= beg end) "Tag thread" "Tag region")
@@ -640,6 +646,8 @@ This function advances the next thread when finished."
   (when (eq beg end)
     (notmuch-search-next-thread)))
 
+;;; Search Results
+
 (defun notmuch-search-update-result (result &optional pos)
   "Replace the result object of the thread at POS (or point) by
 RESULT and redraw it.
@@ -668,7 +676,7 @@ of the result."
                          (min init-point (- new-end 1)))))
        (goto-char new-point)))))
 
-(defun notmuch-search-process-sentinel (proc msg)
+(defun notmuch-search-process-sentinel (proc _msg)
   "Add a message to let user know when \"notmuch search\" exits."
   (let ((buffer (process-buffer proc))
        (status (process-status proc))
@@ -694,7 +702,7 @@ of the result."
                    (throw 'return nil))
                  (when (and atbob
                             (not (string= notmuch-search-target-thread "found")))
-                   (set 'never-found-target-thread t)))))
+                   (setnever-found-target-thread t)))))
            (when (and never-found-target-thread
                       notmuch-search-target-line)
              (goto-char (point-min))
@@ -806,13 +814,13 @@ non-authors is found, assume that all of the authors match."
        (setq invisible-string (notmuch-search-author-propertize invisible-string)))
       ;; If there is any invisible text, add it as a tooltip to the
       ;; visible text.
-      (unless (string= invisible-string "")
+      (unless (string-empty-p invisible-string)
        (setq visible-string
              (propertize visible-string
                          'help-echo (concat "..." invisible-string))))
       ;; Insert the visible and, if present, invisible author strings.
       (insert visible-string)
-      (unless (string= invisible-string "")
+      (unless (string-empty-p invisible-string)
        (let ((start (point))
              overlay)
          (insert invisible-string)
@@ -871,8 +879,7 @@ sets the :orig-tag property."
   "Process and filter the output of \"notmuch search\"."
   (let ((results-buf (process-buffer proc))
        (parse-buf (process-get proc 'parse-buf))
-       (inhibit-read-only t)
-       done)
+       (inhibit-read-only t))
     (when (buffer-live-p results-buf)
       (with-current-buffer parse-buf
        ;; Insert new data
@@ -882,6 +889,8 @@ sets the :orig-tag property."
        (notmuch-sexp-parse-partial-list 'notmuch-search-append-result
                                         results-buf)))))
 
+;;; Commands (and some helper functions used by them)
+
 (defun notmuch-search-tag-all (tag-changes)
   "Add/remove tags from all messages in current search buffer.
 
@@ -924,40 +933,39 @@ See `notmuch-tag' for information on the format of TAG-CHANGES."
   "Read a notmuch-query from the minibuffer with completion.
 
 PROMPT is the string to prompt with."
-  (let*
-      ((all-tags
-       (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
-               (process-lines notmuch-command "search" "--output=tags" "*")))
-       (completions
-       (append (list "folder:" "path:" "thread:" "id:" "date:" "from:" "to:"
-                     "subject:" "attachment:")
-               (mapcar (lambda (tag) (concat "tag:" tag)) all-tags)
-               (mapcar (lambda (tag) (concat "is:" tag)) all-tags)
-               (mapcar (lambda (mimetype) (concat "mimetype:" mimetype))
-                       (mailcap-mime-types)))))
-    (let ((keymap (copy-keymap minibuffer-local-map))
-         (current-query (cl-case major-mode
-                          (notmuch-search-mode (notmuch-search-get-query))
-                          (notmuch-show-mode (notmuch-show-get-query))
-                          (notmuch-tree-mode (notmuch-tree-get-query))))
-         (minibuffer-completion-table
-          (completion-table-dynamic
-           (lambda (string)
-             ;; generate a list of possible completions for the current input
-             (cond
-              ;; this ugly regexp is used to get the last word of the input
-              ;; possibly preceded by a '('
-              ((string-match "\\(^\\|.* (?\\)\\([^ ]*\\)$" string)
-               (mapcar (lambda (compl)
-                         (concat (match-string-no-properties 1 string) compl))
-                       (all-completions (match-string-no-properties 2 string)
-                                        completions)))
-              (t (list string)))))))
-      ;; this was simpler than convincing completing-read to accept spaces:
-      (define-key keymap (kbd "TAB") 'minibuffer-complete)
-      (let ((history-delete-duplicates t))
-       (read-from-minibuffer prompt nil keymap nil
-                             'notmuch-search-history current-query nil)))))
+  (let* ((all-tags
+         (mapcar (lambda (tag) (notmuch-escape-boolean-term tag))
+                 (process-lines notmuch-command "search" "--output=tags" "*")))
+        (completions
+         (append (list "folder:" "path:" "thread:" "id:" "date:" "from:" "to:"
+                       "subject:" "attachment:")
+                 (mapcar (lambda (tag) (concat "tag:" tag)) all-tags)
+                 (mapcar (lambda (tag) (concat "is:" tag)) all-tags)
+                 (mapcar (lambda (mimetype) (concat "mimetype:" mimetype))
+                         (mailcap-mime-types))))
+        (keymap (copy-keymap minibuffer-local-map))
+        (current-query (cl-case major-mode
+                         (notmuch-search-mode (notmuch-search-get-query))
+                         (notmuch-show-mode (notmuch-show-get-query))
+                         (notmuch-tree-mode (notmuch-tree-get-query))))
+        (minibuffer-completion-table
+         (completion-table-dynamic
+          (lambda (string)
+            ;; Generate a list of possible completions for the current input.
+            (cond
+             ;; This ugly regexp is used to get the last word of the input
+             ;; possibly preceded by a '('.
+             ((string-match "\\(^\\|.* (?\\)\\([^ ]*\\)$" string)
+              (mapcar (lambda (compl)
+                        (concat (match-string-no-properties 1 string) compl))
+                      (all-completions (match-string-no-properties 2 string)
+                                       completions)))
+             (t (list string)))))))
+    ;; This was simpler than convincing completing-read to accept spaces:
+    (define-key keymap (kbd "TAB") 'minibuffer-complete)
+    (let ((history-delete-duplicates t))
+      (read-from-minibuffer prompt nil keymap nil
+                           'notmuch-search-history current-query nil))))
 
 (defun notmuch-search-get-query ()
   "Return the current query in this search buffer."
@@ -995,22 +1003,17 @@ the configured default sort order."
     (if no-display
        (set-buffer buffer)
       (pop-to-buffer-same-window buffer))
-    ;; avoid wiping out third party buffer-local variables in the case
-    ;; where we're just refreshing or changing the sort order of an
-    ;; existing search results buffer
-    (unless (eq major-mode 'notmuch-search-mode)
-      (notmuch-search-mode))
+    (notmuch-search-mode)
     ;; Don't track undo information for this buffer
-    (set 'buffer-undo-list t)
-    (set 'notmuch-search-query-string query)
-    (set 'notmuch-search-oldest-first oldest-first)
-    (set 'notmuch-search-target-thread target-thread)
-    (set 'notmuch-search-target-line target-line)
+    (setbuffer-undo-list t)
+    (setnotmuch-search-query-string query)
+    (setnotmuch-search-oldest-first oldest-first)
+    (setnotmuch-search-target-thread target-thread)
+    (setnotmuch-search-target-line target-line)
     (notmuch-tag-clear-cache)
-    (let ((proc (get-buffer-process (current-buffer)))
-         (inhibit-read-only t))
-      (when proc
-       (error "notmuch search process already running for query `%s'" query))
+    (when (get-buffer-process buffer)
+      (error "notmuch search process already running for query `%s'" query))
+    (let ((inhibit-read-only t))
       (erase-buffer)
       (goto-char (point-min))
       (save-excursion
@@ -1020,12 +1023,12 @@ the configured default sort order."
                     (if oldest-first
                         "--sort=oldest-first"
                       "--sort=newest-first")
-                    query))
-             ;; Use a scratch buffer to accumulate partial output.
-             ;; This buffer will be killed by the sentinel, which
-             ;; should be called no matter how the process dies.
-             (parse-buf (generate-new-buffer " *notmuch search parse*")))
-         (process-put proc 'parse-buf parse-buf)
+                    query)))
+         ;; Use a scratch buffer to accumulate partial output.
+         ;; This buffer will be killed by the sentinel, which
+         ;; should be called no matter how the process dies.
+         (process-put proc 'parse-buf
+                      (generate-new-buffer " *notmuch search parse*"))
          (set-process-filter proc 'notmuch-search-process-filter)
          (set-process-query-on-exit-flag proc nil))))
     (run-hooks 'notmuch-search-hook)))
@@ -1039,13 +1042,12 @@ the new search results, then point will be placed on the same
 thread. Otherwise, point will be moved to attempt to be in the
 same relative position within the new buffer."
   (interactive)
-  (let ((target-line (line-number-at-pos))
-       (oldest-first notmuch-search-oldest-first)
-       (target-thread (notmuch-search-find-thread-id 'bare))
-       (query notmuch-search-query-string))
-    ;; notmuch-search erases the current buffer.
-    (notmuch-search query oldest-first target-thread target-line t)
-    (goto-char (point-min))))
+  (notmuch-search notmuch-search-query-string
+                 notmuch-search-oldest-first
+                 (notmuch-search-find-thread-id 'bare)
+                 (line-number-at-pos)
+                 t)
+  (goto-char (point-min)))
 
 (defun notmuch-search-toggle-order ()
   "Toggle the current search order.
@@ -1053,15 +1055,13 @@ same relative position within the new buffer."
 This command toggles the sort order for the current search. The
 default sort order is defined by `notmuch-search-oldest-first'."
   (interactive)
-  (set 'notmuch-search-oldest-first (not notmuch-search-oldest-first))
+  (setnotmuch-search-oldest-first (not notmuch-search-oldest-first))
   (notmuch-search-refresh-view))
 
 (defun notmuch-group-disjunctive-query-string (query-string)
   "Group query if it contains a complex expression.
-
-Enclose QUERY-STRING in parentheses if it matches
-`notmuch-search-disjunctive-regexp'."
-  (if (string-match-p notmuch-search-disjunctive-regexp query-string)
+Enclose QUERY-STRING in parentheses if contains \"OR\" operators."
+  (if (string-match-p "\\<[oO][rR]\\>" query-string)
       (concat "( " query-string " )")
     query-string))
 
@@ -1080,10 +1080,10 @@ current search results AND the additional query string provided."
                    notmuch-search-oldest-first)))
 
 (defun notmuch-search-filter-by-tag (tag)
-  "Filter the current search results based on a single tag.
+  "Filter the current search results based on a single TAG.
 
-Runs a new search matching only messages that match both the
-current search results AND that are tagged with the given tag."
+Run a new search matching only messages that match the current
+search results and that are also tagged with the given TAG."
   (interactive
    (list (notmuch-select-tag-with-completion "Filter by tag: "
                                             notmuch-search-query-string)))
@@ -1103,7 +1103,7 @@ current search results AND that are tagged with the given tag."
   (notmuch-hello))
 
 (defun notmuch-interesting-buffer (b)
-  "Is the current buffer of interest to a notmuch user?"
+  "Whether the current buffer's major-mode is a notmuch mode."
   (with-current-buffer b
     (memq major-mode '(notmuch-show-mode
                       notmuch-search-mode
@@ -1115,8 +1115,8 @@ current search results AND that are tagged with the given tag."
 (defun notmuch-cycle-notmuch-buffers ()
   "Cycle through any existing notmuch buffers (search, show or hello).
 
-If the current buffer is the only notmuch buffer, bury it. If no
-notmuch buffers exist, run `notmuch'."
+If the current buffer is the only notmuch buffer, bury it.
+If no notmuch buffers exist, run `notmuch'."
   (interactive)
   (let (start first)
     ;; If the current buffer is a notmuch buffer, remember it and then
@@ -1137,22 +1137,30 @@ notmuch buffers exist, run `notmuch'."
          (pop-to-buffer-same-window first))
       (notmuch))))
 
+;;; Integrations
+;;;; Hl-line Support
+
+(defun notmuch-hl-line-mode ()
+  (prog1 (hl-line-mode)
+    (when hl-line-overlay
+      (overlay-put hl-line-overlay 'priority 1))))
+
 ;;;; Imenu Support
 
 (defun notmuch-search-imenu-prev-index-position-function ()
   "Move point to previous message in notmuch-search buffer.
-This function is used as a value for
-`imenu-prev-index-position-function'."
+Used as`imenu-prev-index-position-function' in notmuch buffers."
   (notmuch-search-previous-thread))
 
 (defun notmuch-search-imenu-extract-index-name-function ()
   "Return imenu name for line at point.
-This function is used as a value for
-`imenu-extract-index-name-function'.  Point should be at the
-beginning of the line."
-  (let ((subject (notmuch-search-find-subject))
-       (author (notmuch-search-find-authors)))
-    (format "%s (%s)" subject author)))
+Used as `imenu-extract-index-name-function' in notmuch buffers.
+Point should be at the beginning of the line."
+  (format "%s (%s)"
+         (notmuch-search-find-subject)
+         (notmuch-search-find-authors)))
+
+;;; _
 
 (setq mail-user-agent 'notmuch-user-agent)
 
index 4221f142ce74e1ea6598fc4118e02d9b6439d253..c7c130154a582841b084343f38787431e0bbe77a 100644 (file)
@@ -1,4 +1,4 @@
-;;; rstdoc.el --- help generate documentation from docstrings -*-lexical-binding: t-*-
+;;; rstdoc.el --- help generate documentation from docstrings  -*- lexical-binding: t -*-
 
 ;; Copyright (C) 2018 David Bremner
 
diff --git a/hooks.c b/hooks.c
index 59c5807065fc4ee58974a7eec196c7335bcbb8e3..ec89b22ec75497ee69a5d9cce888c6c2a1a95c81 100644 (file)
--- a/hooks.c
+++ b/hooks.c
 #include <sys/wait.h>
 
 int
-notmuch_run_hook (const char *db_path, const char *hook)
+notmuch_run_hook (notmuch_database_t *notmuch, const char *hook)
 {
     char *hook_path;
     int status = 0;
     pid_t pid;
 
-    hook_path = talloc_asprintf (NULL, "%s/%s/%s/%s", db_path, ".notmuch",
-                                "hooks", hook);
+    hook_path = talloc_asprintf (notmuch, "%s/%s",
+                                notmuch_config_get (notmuch, NOTMUCH_CONFIG_HOOK_DIR),
+                                hook);
     if (hook_path == NULL) {
        fprintf (stderr, "Out of memory\n");
        return 1;
index a640012676d818a42490ebb93359121710f13aa0..01cbb3f2821c8e0a1e0145192e2e3368b625d6c7 100644 (file)
@@ -59,7 +59,10 @@ libnotmuch_cxx_srcs =                \
        $(dir)/config.cc        \
        $(dir)/regexp-fields.cc \
        $(dir)/thread.cc \
-       $(dir)/thread-fp.cc
+       $(dir)/thread-fp.cc     \
+       $(dir)/features.cc      \
+       $(dir)/prefix.cc        \
+       $(dir)/open.cc
 
 libnotmuch_modules := $(libnotmuch_c_srcs:.c=.o) $(libnotmuch_cxx_srcs:.cc=.o)
 
index 0b760dbcc2063deeefde553fa66b5421fcf23d02..948751bc84b35fd7e2de04ccba14af13e6694ad1 100644 (file)
@@ -31,6 +31,15 @@ struct _notmuch_config_list {
     char *current_val;
 };
 
+struct _notmuch_config_values {
+    const char *iterator;
+    size_t tok_len;
+    const char *string;
+    void *children; /* talloc_context */
+};
+
+static const char * _notmuch_config_key_to_string (notmuch_config_key_t key);
+
 static int
 _notmuch_config_list_destroy (notmuch_config_list_t *list)
 {
@@ -50,6 +59,11 @@ notmuch_database_set_config (notmuch_database_t *notmuch,
     if (status)
        return status;
 
+    if (! notmuch->config) {
+       if ((status = _notmuch_config_load_from_database (notmuch)))
+           return status;
+    }
+
     try {
        notmuch->writable_xapian_db->set_metadata (CONFIG_PREFIX + key, value);
     } catch (const Xapian::Error &error) {
@@ -58,7 +72,13 @@ notmuch_database_set_config (notmuch_database_t *notmuch,
        _notmuch_database_log (notmuch, "Error: A Xapian exception occurred setting metadata: %s\n",
                               error.get_msg ().c_str ());
     }
-    return status;
+
+    if (status)
+       return status;
+
+    _notmuch_string_map_set (notmuch->config, key, value);
+
+    return NOTMUCH_STATUS_SUCCESS;
 }
 
 static notmuch_status_t
@@ -84,17 +104,25 @@ notmuch_database_get_config (notmuch_database_t *notmuch,
                             const char *key,
                             char **value)
 {
-    std::string strval;
+    const char* stored_val;
     notmuch_status_t status;
 
+    if (! notmuch->config) {
+       if ((status = _notmuch_config_load_from_database (notmuch)))
+           return status;
+    }
+
     if (! value)
        return NOTMUCH_STATUS_NULL_POINTER;
 
-    status = _metadata_value (notmuch, key, strval);
-    if (status)
-       return status;
-
-    *value = strdup (strval.c_str ());
+    stored_val = _notmuch_string_map_get (notmuch->config, key);
+    if (! stored_val) {
+       /* XXX in principle this API should be fixed so empty string
+        * is distinguished from not found */
+       *value = strdup("");
+    } else {
+       *value = strdup (stored_val);
+    }
 
     return NOTMUCH_STATUS_SUCCESS;
 }
@@ -201,3 +229,249 @@ notmuch_config_list_destroy (notmuch_config_list_t *list)
 {
     talloc_free (list);
 }
+
+notmuch_status_t
+_notmuch_config_load_from_database (notmuch_database_t *notmuch)
+{
+    notmuch_status_t status = NOTMUCH_STATUS_SUCCESS;
+    notmuch_config_list_t *list;
+
+    if (notmuch->config == NULL)
+       notmuch->config = _notmuch_string_map_create (notmuch);
+
+    if (unlikely(notmuch->config == NULL))
+       return NOTMUCH_STATUS_OUT_OF_MEMORY;
+
+    status = notmuch_database_get_config_list (notmuch, "", &list);
+    if (status)
+       return status;
+
+    for (; notmuch_config_list_valid (list); notmuch_config_list_move_to_next (list)) {
+       _notmuch_string_map_append (notmuch->config,
+                                   notmuch_config_list_key (list),
+                                   notmuch_config_list_value (list));
+    }
+
+    return status;
+}
+
+notmuch_config_values_t *
+notmuch_config_get_values (notmuch_database_t *notmuch, notmuch_config_key_t key)
+{
+    notmuch_config_values_t *values = NULL;
+    bool ok = false;
+
+    const char *key_str = _notmuch_config_key_to_string (key);
+
+    if (! key_str)
+       goto DONE;
+
+    values = talloc (notmuch, notmuch_config_values_t);
+    if (unlikely(! values))
+       goto DONE;
+
+    values->children = talloc_new (values);
+
+    values->string = _notmuch_string_map_get (notmuch->config, key_str);
+    if (! values->string)
+       goto DONE;
+
+    values->iterator = strsplit_len (values->string, ';', &(values->tok_len));
+    ok = true;
+
+ DONE:
+    if (!ok) {
+       if (values)
+           talloc_free(values);
+       return NULL;
+    }
+    return values;
+}
+
+notmuch_bool_t
+notmuch_config_values_valid (notmuch_config_values_t *values) {
+    if (! values)
+       return false;
+
+    return (values->iterator != NULL);
+}
+
+const char *
+notmuch_config_values_get (notmuch_config_values_t *values) {
+    return talloc_strndup (values, values->iterator, values->tok_len);
+}
+
+void
+notmuch_config_values_start (notmuch_config_values_t *values) {
+    if (values == NULL)
+       return;
+    if (values->children) {
+       talloc_free (values->children);
+    }
+
+    values->children = talloc_new (values);
+
+    values->iterator = strsplit_len (values->string, ';', &(values->tok_len));
+}
+
+void
+notmuch_config_values_move_to_next (notmuch_config_values_t *values) {
+    values->iterator += values->tok_len;
+    values->iterator = strsplit_len (values->iterator, ';', &(values->tok_len));
+}
+
+void
+notmuch_config_values_destroy (notmuch_config_values_t *values) {
+    talloc_free (values);
+}
+
+notmuch_status_t
+_notmuch_config_load_from_file (notmuch_database_t *notmuch,
+                               GKeyFile *file)
+{
+    notmuch_status_t status = NOTMUCH_STATUS_SUCCESS;
+    gchar **groups, **keys, *val;
+
+    if (notmuch->config == NULL)
+       notmuch->config = _notmuch_string_map_create (notmuch);
+
+    if (unlikely(notmuch->config == NULL)) {
+       status = NOTMUCH_STATUS_OUT_OF_MEMORY;
+       goto DONE;
+    }
+
+    for (groups = g_key_file_get_groups (file, NULL); *groups; groups++) {
+       for (keys = g_key_file_get_keys (file, *groups, NULL, NULL); *keys; keys++) {
+           char *absolute_key = talloc_asprintf(notmuch, "%s.%s", *groups,  *keys);
+           val = g_key_file_get_value (file, *groups, *keys, NULL);
+           if (! val) {
+               status = NOTMUCH_STATUS_FILE_ERROR;
+               goto DONE;
+           }
+           _notmuch_string_map_set (notmuch->config, absolute_key, val);
+           talloc_free (absolute_key);
+           if (status)
+               goto DONE;
+       }
+    }
+
+ DONE:
+    return status;
+}
+
+notmuch_status_t
+notmuch_config_get_bool (notmuch_database_t *notmuch, notmuch_config_key_t key, notmuch_bool_t *val)
+{
+    const char *key_string, *val_string;
+
+    key_string = _notmuch_config_key_to_string (key);
+    if (! key_string) {
+       return NOTMUCH_STATUS_ILLEGAL_ARGUMENT;
+    }
+
+    val_string = _notmuch_string_map_get (notmuch->config, key_string);
+    if (! val_string) {
+       *val = FALSE;
+       return NOTMUCH_STATUS_SUCCESS;
+    }
+
+    if (strcase_equal (val_string, "false") || strcase_equal (val_string, "no"))
+       *val = FALSE;
+    else if (strcase_equal (val_string, "true") || strcase_equal (val_string, "yes"))
+       *val = TRUE;
+    else
+       return NOTMUCH_STATUS_ILLEGAL_ARGUMENT;
+
+    return NOTMUCH_STATUS_SUCCESS;
+}
+
+static const char *
+_notmuch_config_key_to_string (notmuch_config_key_t key) {
+    switch (key) {
+    case NOTMUCH_CONFIG_DATABASE_PATH:
+       return "database.path";
+    case NOTMUCH_CONFIG_HOOK_DIR:
+       return "database.hook_dir";
+    case NOTMUCH_CONFIG_EXCLUDE_TAGS:
+       return "search.exclude_tags";
+    case NOTMUCH_CONFIG_NEW_TAGS:
+       return "new.tags";
+    case NOTMUCH_CONFIG_NEW_IGNORE:
+       return "new.ignore";
+    case NOTMUCH_CONFIG_SYNC_MAILDIR_FLAGS:
+       return "maildir.synchronize_flags";
+    case NOTMUCH_CONFIG_PRIMARY_EMAIL:
+       return "user.primary_email";
+    case NOTMUCH_CONFIG_OTHER_EMAIL:
+       return "user.other_email";
+    case NOTMUCH_CONFIG_USER_NAME:
+       return "user.name";
+    default:
+       return NULL;
+    }
+}
+
+static const char *
+_notmuch_config_default (void *ctx, notmuch_config_key_t key) {
+    char *path;
+
+    switch (key) {
+    case NOTMUCH_CONFIG_DATABASE_PATH:
+       path = getenv ("MAILDIR");
+       if (path)
+           path = talloc_strdup (ctx, path);
+       else
+           path = talloc_asprintf (ctx, "%s/mail",
+                                   getenv ("HOME"));
+       return path;
+    case NOTMUCH_CONFIG_EXCLUDE_TAGS:
+       return "";
+    case NOTMUCH_CONFIG_NEW_TAGS:
+       return "inbox;unread";
+    case NOTMUCH_CONFIG_SYNC_MAILDIR_FLAGS:
+       return "true";
+    case NOTMUCH_CONFIG_HOOK_DIR:
+    case NOTMUCH_CONFIG_NEW_IGNORE:
+    case NOTMUCH_CONFIG_USER_NAME:
+    case NOTMUCH_CONFIG_PRIMARY_EMAIL:
+    case NOTMUCH_CONFIG_OTHER_EMAIL:
+       return NULL;
+    default:
+    case NOTMUCH_CONFIG_LAST:
+       INTERNAL_ERROR ("illegal key enum %d", key);
+   }
+}
+
+notmuch_status_t
+_notmuch_config_load_defaults (notmuch_database_t *notmuch) {
+    notmuch_config_key_t key;
+    for (key = NOTMUCH_CONFIG_FIRST;
+        key < NOTMUCH_CONFIG_LAST;
+        key = notmuch_config_key_t(key + 1)) {
+       const char *val = notmuch_config_get (notmuch, key);
+       const char *key_string = _notmuch_config_key_to_string (key);
+
+       val = _notmuch_string_map_get (notmuch->config, key_string);
+       if (! val) {
+           _notmuch_string_map_set (notmuch->config, key_string, _notmuch_config_default (notmuch, key));
+       }
+    }
+    return NOTMUCH_STATUS_SUCCESS;
+}
+
+const char *
+notmuch_config_get (notmuch_database_t *notmuch, notmuch_config_key_t key) {
+
+    return _notmuch_string_map_get (notmuch->config, _notmuch_config_key_to_string (key));
+}
+
+notmuch_status_t
+notmuch_config_set (notmuch_database_t *notmuch, notmuch_config_key_t key, const char *val) {
+
+    return notmuch_database_set_config (notmuch, _notmuch_config_key_to_string (key), val);
+}
+
+void
+_notmuch_config_cache (notmuch_database_t *notmuch, notmuch_config_key_t key, const char *val) {
+    _notmuch_string_map_set (notmuch->config, _notmuch_config_key_to_string (key), val);
+}
index 041602cdc6a8911b33531cfa8e0dbd72307b8242..d83cf0d0ae0bc674cd341703d004082d6504dcce 100644 (file)
@@ -32,6 +32,8 @@
 
 #include "notmuch-private.h"
 
+#define ARRAY_SIZE(arr) (sizeof (arr) / sizeof (arr[0]))
+
 #ifdef SILENCE_XAPIAN_DEPRECATION_WARNINGS
 #define XAPIAN_DEPRECATED(D) D
 #endif
@@ -226,6 +228,9 @@ struct _notmuch_database {
      * here, but at least they are small */
     notmuch_string_map_t *user_prefix;
     notmuch_string_map_t *user_header;
+
+    /* Cached and possibly overridden configuration */
+    notmuch_string_map_t *config;
 };
 
 /* Prior to database version 3, features were implied by the database
@@ -263,4 +268,23 @@ _notmuch_database_find_doc_ids (notmuch_database_t *notmuch,
                                const char *value,
                                Xapian::PostingIterator *begin,
                                Xapian::PostingIterator *end);
+
+#define NOTMUCH_DATABASE_VERSION 3
+
+/* features.cc */
+
+_notmuch_features
+_notmuch_database_parse_features (const void *ctx, const char *features, unsigned int version,
+                                 char mode, char **incompat_out);
+
+char *
+_notmuch_database_print_features (const void *ctx, unsigned int features);
+
+/* prefix.cc */
+notmuch_status_t
+_notmuch_database_setup_standard_query_fields (notmuch_database_t *notmuch);
+
+notmuch_status_t
+_notmuch_database_setup_user_query_fields (notmuch_database_t *notmuch);
+
 #endif
index 7518968599f65fbeed8ac5285e15fb3cfb1cdc2e..f96ba7c004bd6338d0c0a92bb5ad94464a3d7f50 100644 (file)
  */
 
 #include "database-private.h"
-#include "parse-time-vrp.h"
-#include "query-fp.h"
-#include "thread-fp.h"
-#include "regexp-fields.h"
 #include "string-util.h"
 
 #include <iostream>
@@ -39,8 +35,6 @@
 
 using namespace std;
 
-#define ARRAY_SIZE(arr) (sizeof (arr) / sizeof (arr[0]))
-
 typedef struct {
     const char *name;
     const char *prefix;
@@ -52,12 +46,6 @@ typedef struct {
 #define STRINGIFY(s) _SUB_STRINGIFY (s)
 #define _SUB_STRINGIFY(s) #s
 
-#if HAVE_XAPIAN_DB_RETRY_LOCK
-#define DB_ACTION (Xapian::DB_CREATE_OR_OPEN | Xapian::DB_RETRY_LOCK)
-#else
-#define DB_ACTION Xapian::DB_CREATE_OR_OPEN
-#endif
-
 #define LOG_XAPIAN_EXCEPTION(message, error) _log_xapian_exception (__location__, message, error)
 
 static void
@@ -265,80 +253,6 @@ _notmuch_database_mode (notmuch_database_t *notmuch)
  *                     same thread.
  */
 
-/* With these prefix values we follow the conventions published here:
- *
- * https://xapian.org/docs/omega/termprefixes.html
- *
- * as much as makes sense. Note that I took some liberty in matching
- * the reserved prefix values to notmuch concepts, (for example, 'G'
- * is documented as "newsGroup (or similar entity - e.g. a web forum
- * name)", for which I think the thread is the closest analogue in
- * notmuch. This in spite of the fact that we will eventually be
- * storing mailing-list messages where 'G' for "mailing list name"
- * might be even a closer analogue. I'm treating the single-character
- * prefixes preferentially for core notmuch concepts (which will be
- * nearly universal to all mail messages).
- */
-
-static const
-prefix_t prefix_table[] = {
-    /* name                    term prefix     flags */
-    { "type",                   "T",            NOTMUCH_FIELD_NO_FLAGS },
-    { "reference",              "XREFERENCE",   NOTMUCH_FIELD_NO_FLAGS },
-    { "replyto",                "XREPLYTO",     NOTMUCH_FIELD_NO_FLAGS },
-    { "directory",              "XDIRECTORY",   NOTMUCH_FIELD_NO_FLAGS },
-    { "file-direntry",          "XFDIRENTRY",   NOTMUCH_FIELD_NO_FLAGS },
-    { "directory-direntry",     "XDDIRENTRY",   NOTMUCH_FIELD_NO_FLAGS },
-    { "body",                   "",             NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROBABILISTIC },
-    { "thread",                 "G",            NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROCESSOR },
-    { "tag",                    "K",            NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROCESSOR },
-    { "is",                     "K",            NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROCESSOR },
-    { "id",                     "Q",            NOTMUCH_FIELD_EXTERNAL },
-    { "mid",                    "Q",            NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROCESSOR },
-    { "path",                   "P",            NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROCESSOR },
-    { "property",               "XPROPERTY",    NOTMUCH_FIELD_EXTERNAL },
-    /*
-     * Unconditionally add ':' to reduce potential ambiguity with
-     * overlapping prefixes and/or terms that start with capital
-     * letters. See Xapian document termprefixes.html for related
-     * discussion.
-     */
-    { "folder",                 "XFOLDER:",     NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROCESSOR },
-    { "date",                   NULL,           NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROCESSOR },
-    { "query",                  NULL,           NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROCESSOR },
-    { "from",                   "XFROM",        NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROBABILISTIC |
-      NOTMUCH_FIELD_PROCESSOR },
-    { "to",                     "XTO",          NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROBABILISTIC },
-    { "attachment",             "XATTACHMENT",  NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROBABILISTIC },
-    { "mimetype",               "XMIMETYPE",    NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROBABILISTIC },
-    { "subject",                "XSUBJECT",     NOTMUCH_FIELD_EXTERNAL |
-      NOTMUCH_FIELD_PROBABILISTIC |
-      NOTMUCH_FIELD_PROCESSOR },
-};
-
-static void
-_setup_query_field_default (const prefix_t *prefix, notmuch_database_t *notmuch)
-{
-    if (prefix->prefix)
-       notmuch->query_parser->add_prefix ("", prefix->prefix);
-    if (prefix->flags & NOTMUCH_FIELD_PROBABILISTIC)
-       notmuch->query_parser->add_prefix (prefix->name, prefix->prefix);
-    else
-       notmuch->query_parser->add_boolean_prefix (prefix->name, prefix->prefix);
-}
 
 notmuch_string_map_iterator_t *
 _notmuch_database_user_headers (notmuch_database_t *notmuch)
@@ -346,153 +260,6 @@ _notmuch_database_user_headers (notmuch_database_t *notmuch)
     return _notmuch_string_map_iterator_create (notmuch->user_header, "", false);
 }
 
-const char *
-_user_prefix (void *ctx, const char *name)
-{
-    return talloc_asprintf (ctx, "XU%s:", name);
-}
-
-static notmuch_status_t
-_setup_user_query_fields (notmuch_database_t *notmuch)
-{
-    notmuch_config_list_t *list;
-    notmuch_status_t status;
-
-    notmuch->user_prefix = _notmuch_string_map_create (notmuch);
-    if (notmuch->user_prefix == NULL)
-       return NOTMUCH_STATUS_OUT_OF_MEMORY;
-
-    notmuch->user_header = _notmuch_string_map_create (notmuch);
-    if (notmuch->user_header == NULL)
-       return NOTMUCH_STATUS_OUT_OF_MEMORY;
-
-    status = notmuch_database_get_config_list (notmuch, CONFIG_HEADER_PREFIX, &list);
-    if (status)
-       return status;
-
-    for (; notmuch_config_list_valid (list); notmuch_config_list_move_to_next (list)) {
-
-       prefix_t query_field;
-
-       const char *key = notmuch_config_list_key (list)
-                         + sizeof (CONFIG_HEADER_PREFIX) - 1;
-
-       _notmuch_string_map_append (notmuch->user_prefix,
-                                   key,
-                                   _user_prefix (notmuch, key));
-
-       _notmuch_string_map_append (notmuch->user_header,
-                                   key,
-                                   notmuch_config_list_value (list));
-
-       query_field.name = talloc_strdup (notmuch, key);
-       query_field.prefix = _user_prefix (notmuch, key);
-       query_field.flags = NOTMUCH_FIELD_PROBABILISTIC
-                           | NOTMUCH_FIELD_EXTERNAL;
-
-       _setup_query_field_default (&query_field, notmuch);
-    }
-
-    notmuch_config_list_destroy (list);
-
-    return NOTMUCH_STATUS_SUCCESS;
-}
-
-static void
-_setup_query_field (const prefix_t *prefix, notmuch_database_t *notmuch)
-{
-    if (prefix->flags & NOTMUCH_FIELD_PROCESSOR) {
-       Xapian::FieldProcessor *fp;
-
-       if (STRNCMP_LITERAL (prefix->name, "date") == 0)
-           fp = (new DateFieldProcessor(NOTMUCH_VALUE_TIMESTAMP))->release ();
-       else if (STRNCMP_LITERAL(prefix->name, "query") == 0)
-           fp = (new QueryFieldProcessor (*notmuch->query_parser, notmuch))->release ();
-       else if (STRNCMP_LITERAL (prefix->name, "thread") == 0)
-           fp = (new ThreadFieldProcessor (*notmuch->query_parser, notmuch))->release ();
-       else
-           fp = (new RegexpFieldProcessor (prefix->name, prefix->flags,
-                                           *notmuch->query_parser, notmuch))->release ();
-
-       /* we treat all field-processor fields as boolean in order to get the raw input */
-       if (prefix->prefix)
-           notmuch->query_parser->add_prefix ("", prefix->prefix);
-       notmuch->query_parser->add_boolean_prefix (prefix->name, fp);
-    } else {
-       _setup_query_field_default (prefix, notmuch);
-    }
-}
-
-const char *
-_find_prefix (const char *name)
-{
-    unsigned int i;
-
-    for (i = 0; i < ARRAY_SIZE (prefix_table); i++) {
-       if (strcmp (name, prefix_table[i].name) == 0)
-           return prefix_table[i].prefix;
-    }
-
-    INTERNAL_ERROR ("No prefix exists for '%s'\n", name);
-
-    return "";
-}
-
-/* Like find prefix, but include the possibility of user defined
- * prefixes specific to this database */
-
-const char *
-_notmuch_database_prefix (notmuch_database_t *notmuch, const char *name)
-{
-    unsigned int i;
-
-    /*XXX TODO: reduce code duplication */
-    for (i = 0; i < ARRAY_SIZE (prefix_table); i++) {
-       if (strcmp (name, prefix_table[i].name) == 0)
-           return prefix_table[i].prefix;
-    }
-
-    if (notmuch->user_prefix)
-       return _notmuch_string_map_get (notmuch->user_prefix, name);
-
-    return NULL;
-}
-
-static const struct {
-    /* NOTMUCH_FEATURE_* value. */
-    _notmuch_features value;
-    /* Feature name as it appears in the database.  This name should
-     * be appropriate for displaying to the user if an older version
-     * of notmuch doesn't support this feature. */
-    const char *name;
-    /* Compatibility flags when this feature is declared. */
-    const char *flags;
-} feature_names[] = {
-    { NOTMUCH_FEATURE_FILE_TERMS,
-      "multiple paths per message", "rw" },
-    { NOTMUCH_FEATURE_DIRECTORY_DOCS,
-      "relative directory paths", "rw" },
-    /* Header values are not required for reading a database because a
-     * reader can just refer to the message file. */
-    { NOTMUCH_FEATURE_FROM_SUBJECT_ID_VALUES,
-      "from/subject/message-ID in database", "w" },
-    { NOTMUCH_FEATURE_BOOL_FOLDER,
-      "exact folder:/path: search", "rw" },
-    { NOTMUCH_FEATURE_GHOSTS,
-      "mail documents for missing messages", "w" },
-    /* Knowledge of the index mime-types are not required for reading
-     * a database because a reader will just be unable to query
-     * them. */
-    { NOTMUCH_FEATURE_INDEXED_MIMETYPES,
-      "indexed MIME types", "w" },
-    { NOTMUCH_FEATURE_LAST_MOD,
-      "modification tracking", "w" },
-    /* Existing databases will work fine for all queries not involving
-     * 'body:' */
-    { NOTMUCH_FEATURE_UNPREFIX_BODY_ONLY,
-      "index body and headers separately", "w" },
-};
-
 const char *
 notmuch_status_to_string (notmuch_status_t status)
 {
@@ -686,109 +453,6 @@ notmuch_database_find_message (notmuch_database_t *notmuch,
     }
 }
 
-notmuch_status_t
-notmuch_database_create (const char *path, notmuch_database_t **database)
-{
-    char *status_string = NULL;
-    notmuch_status_t status;
-
-    status = notmuch_database_create_verbose (path, database,
-                                             &status_string);
-
-    if (status_string) {
-       fputs (status_string, stderr);
-       free (status_string);
-    }
-
-    return status;
-}
-
-notmuch_status_t
-notmuch_database_create_verbose (const char *path,
-                                notmuch_database_t **database,
-                                char **status_string)
-{
-    notmuch_status_t status = NOTMUCH_STATUS_SUCCESS;
-    notmuch_database_t *notmuch = NULL;
-    char *notmuch_path = NULL;
-    char *message = NULL;
-    struct stat st;
-    int err;
-
-    if (path == NULL) {
-       message = strdup ("Error: Cannot create a database for a NULL path.\n");
-       status = NOTMUCH_STATUS_NULL_POINTER;
-       goto DONE;
-    }
-
-    if (path[0] != '/') {
-       message = strdup ("Error: Database path must be absolute.\n");
-       status = NOTMUCH_STATUS_PATH_ERROR;
-       goto DONE;
-    }
-
-    err = stat (path, &st);
-    if (err) {
-       IGNORE_RESULT (asprintf (&message, "Error: Cannot create database at %s: %s.\n",
-                                path, strerror (errno)));
-       status = NOTMUCH_STATUS_FILE_ERROR;
-       goto DONE;
-    }
-
-    if (! S_ISDIR (st.st_mode)) {
-       IGNORE_RESULT (asprintf (&message, "Error: Cannot create database at %s: "
-                                "Not a directory.\n",
-                                path));
-       status = NOTMUCH_STATUS_FILE_ERROR;
-       goto DONE;
-    }
-
-    notmuch_path = talloc_asprintf (NULL, "%s/%s", path, ".notmuch");
-
-    err = mkdir (notmuch_path, 0755);
-
-    if (err) {
-       IGNORE_RESULT (asprintf (&message, "Error: Cannot create directory %s: %s.\n",
-                                notmuch_path, strerror (errno)));
-       status = NOTMUCH_STATUS_FILE_ERROR;
-       goto DONE;
-    }
-
-    status = notmuch_database_open_verbose (path,
-                                           NOTMUCH_DATABASE_MODE_READ_WRITE,
-                                           &notmuch, &message);
-    if (status)
-       goto DONE;
-
-    /* Upgrade doesn't add these feature to existing databases, but
-     * new databases have them. */
-    notmuch->features |= NOTMUCH_FEATURE_FROM_SUBJECT_ID_VALUES;
-    notmuch->features |= NOTMUCH_FEATURE_INDEXED_MIMETYPES;
-    notmuch->features |= NOTMUCH_FEATURE_UNPREFIX_BODY_ONLY;
-
-    status = notmuch_database_upgrade (notmuch, NULL, NULL);
-    if (status) {
-       notmuch_database_close (notmuch);
-       notmuch = NULL;
-    }
-
-  DONE:
-    if (notmuch_path)
-       talloc_free (notmuch_path);
-
-    if (message) {
-       if (status_string)
-           *status_string = message;
-       else
-           free (message);
-    }
-    if (database)
-       *database = notmuch;
-    else
-       talloc_free (notmuch);
-    return status;
-}
-
 notmuch_status_t
 _notmuch_database_ensure_writable (notmuch_database_t *notmuch)
 {
@@ -817,291 +481,6 @@ _notmuch_database_new_revision (notmuch_database_t *notmuch)
     return new_revision;
 }
 
-/* Parse a database features string from the given database version.
- * Returns the feature bit set.
- *
- * For version < 3, this ignores the features string and returns a
- * hard-coded set of features.
- *
- * If there are unrecognized features that are required to open the
- * database in mode (which should be 'r' or 'w'), return a
- * comma-separated list of unrecognized but required features in
- * *incompat_out suitable for presenting to the user.  *incompat_out
- * will be allocated from ctx.
- */
-static _notmuch_features
-_parse_features (const void *ctx, const char *features, unsigned int version,
-                char mode, char **incompat_out)
-{
-    _notmuch_features res = static_cast<_notmuch_features>(0);
-    unsigned int namelen, i;
-    size_t llen = 0;
-    const char *flags;
-
-    /* Prior to database version 3, features were implied by the
-     * version number. */
-    if (version == 0)
-       return NOTMUCH_FEATURES_V0;
-    else if (version == 1)
-       return NOTMUCH_FEATURES_V1;
-    else if (version == 2)
-       return NOTMUCH_FEATURES_V2;
-
-    /* Parse the features string */
-    while ((features = strtok_len_c (features + llen, "\n", &llen)) != NULL) {
-       flags = strchr (features, '\t');
-       if (! flags || flags > features + llen)
-           continue;
-       namelen = flags - features;
-
-       for (i = 0; i < ARRAY_SIZE (feature_names); ++i) {
-           if (strlen (feature_names[i].name) == namelen &&
-               strncmp (feature_names[i].name, features, namelen) == 0) {
-               res |= feature_names[i].value;
-               break;
-           }
-       }
-
-       if (i == ARRAY_SIZE (feature_names) && incompat_out) {
-           /* Unrecognized feature */
-           const char *have = strchr (flags, mode);
-           if (have && have < features + llen) {
-               /* This feature is required to access this database in
-                * 'mode', but we don't understand it. */
-               if (! *incompat_out)
-                   *incompat_out = talloc_strdup (ctx, "");
-               *incompat_out = talloc_asprintf_append_buffer (
-                   *incompat_out, "%s%.*s", **incompat_out ? ", " : "",
-                   namelen, features);
-           }
-       }
-    }
-
-    return res;
-}
-
-static char *
-_print_features (const void *ctx, unsigned int features)
-{
-    unsigned int i;
-    char *res = talloc_strdup (ctx, "");
-
-    for (i = 0; i < ARRAY_SIZE (feature_names); ++i)
-       if (features & feature_names[i].value)
-           res = talloc_asprintf_append_buffer (
-               res, "%s\t%s\n", feature_names[i].name, feature_names[i].flags);
-
-    return res;
-}
-
-notmuch_status_t
-notmuch_database_open (const char *path,
-                      notmuch_database_mode_t mode,
-                      notmuch_database_t **database)
-{
-    char *status_string = NULL;
-    notmuch_status_t status;
-
-    status = notmuch_database_open_verbose (path, mode, database,
-                                           &status_string);
-
-    if (status_string) {
-       fputs (status_string, stderr);
-       free (status_string);
-    }
-
-    return status;
-}
-
-notmuch_status_t
-notmuch_database_open_verbose (const char *path,
-                              notmuch_database_mode_t mode,
-                              notmuch_database_t **database,
-                              char **status_string)
-{
-    notmuch_status_t status = NOTMUCH_STATUS_SUCCESS;
-    void *local = talloc_new (NULL);
-    notmuch_database_t *notmuch = NULL;
-    char *notmuch_path, *xapian_path, *incompat_features;
-    char *message = NULL;
-    struct stat st;
-    int err;
-    unsigned int i, version;
-    static int initialized = 0;
-
-    if (path == NULL) {
-       message = strdup ("Error: Cannot open a database for a NULL path.\n");
-       status = NOTMUCH_STATUS_NULL_POINTER;
-       goto DONE;
-    }
-
-    if (path[0] != '/') {
-       message = strdup ("Error: Database path must be absolute.\n");
-       status = NOTMUCH_STATUS_PATH_ERROR;
-       goto DONE;
-    }
-
-    if (! (notmuch_path = talloc_asprintf (local, "%s/%s", path, ".notmuch"))) {
-       message = strdup ("Out of memory\n");
-       status = NOTMUCH_STATUS_OUT_OF_MEMORY;
-       goto DONE;
-    }
-
-    err = stat (notmuch_path, &st);
-    if (err) {
-       IGNORE_RESULT (asprintf (&message, "Error opening database at %s: %s\n",
-                                notmuch_path, strerror (errno)));
-       status = NOTMUCH_STATUS_FILE_ERROR;
-       goto DONE;
-    }
-
-    if (! (xapian_path = talloc_asprintf (local, "%s/%s", notmuch_path, "xapian"))) {
-       message = strdup ("Out of memory\n");
-       status = NOTMUCH_STATUS_OUT_OF_MEMORY;
-       goto DONE;
-    }
-
-    /* Initialize the GLib type system and threads */
-#if ! GLIB_CHECK_VERSION (2, 35, 1)
-    g_type_init ();
-#endif
-
-    /* Initialize gmime */
-    if (! initialized) {
-       g_mime_init ();
-       initialized = 1;
-    }
-
-    notmuch = talloc_zero (NULL, notmuch_database_t);
-    notmuch->exception_reported = false;
-    notmuch->status_string = NULL;
-    notmuch->path = talloc_strdup (notmuch, path);
-
-    strip_trailing (notmuch->path, '/');
-
-    notmuch->writable_xapian_db = NULL;
-    notmuch->atomic_nesting = 0;
-    notmuch->view = 1;
-    try {
-       string last_thread_id;
-       string last_mod;
-
-       if (mode == NOTMUCH_DATABASE_MODE_READ_WRITE) {
-           notmuch->writable_xapian_db = new Xapian::WritableDatabase (xapian_path,
-                                                                       DB_ACTION);
-           notmuch->xapian_db = notmuch->writable_xapian_db;
-       } else {
-           notmuch->xapian_db = new Xapian::Database (xapian_path);
-       }
-
-       /* Check version.  As of database version 3, we represent
-        * changes in terms of features, so assume a version bump
-        * means a dramatically incompatible change. */
-       version = notmuch_database_get_version (notmuch);
-       if (version > NOTMUCH_DATABASE_VERSION) {
-           IGNORE_RESULT (asprintf (&message,
-                                    "Error: Notmuch database at %s\n"
-                                    "       has a newer database format version (%u) than supported by this\n"
-                                    "       version of notmuch (%u).\n",
-                                    notmuch_path, version, NOTMUCH_DATABASE_VERSION));
-           notmuch_database_destroy (notmuch);
-           notmuch = NULL;
-           status = NOTMUCH_STATUS_FILE_ERROR;
-           goto DONE;
-       }
-
-       /* Check features. */
-       incompat_features = NULL;
-       notmuch->features = _parse_features (
-           local, notmuch->xapian_db->get_metadata ("features").c_str (),
-           version, mode == NOTMUCH_DATABASE_MODE_READ_WRITE ? 'w' : 'r',
-           &incompat_features);
-       if (incompat_features) {
-           IGNORE_RESULT (asprintf (&message,
-                                    "Error: Notmuch database at %s\n"
-                                    "       requires features (%s)\n"
-                                    "       not supported by this version of notmuch.\n",
-                                    notmuch_path, incompat_features));
-           notmuch_database_destroy (notmuch);
-           notmuch = NULL;
-           status = NOTMUCH_STATUS_FILE_ERROR;
-           goto DONE;
-       }
-
-       notmuch->last_doc_id = notmuch->xapian_db->get_lastdocid ();
-       last_thread_id = notmuch->xapian_db->get_metadata ("last_thread_id");
-       if (last_thread_id.empty ()) {
-           notmuch->last_thread_id = 0;
-       } else {
-           const char *str;
-           char *end;
-
-           str = last_thread_id.c_str ();
-           notmuch->last_thread_id = strtoull (str, &end, 16);
-           if (*end != '\0')
-               INTERNAL_ERROR ("Malformed database last_thread_id: %s", str);
-       }
-
-       /* Get current highest revision number. */
-       last_mod = notmuch->xapian_db->get_value_upper_bound (
-           NOTMUCH_VALUE_LAST_MOD);
-       if (last_mod.empty ())
-           notmuch->revision = 0;
-       else
-           notmuch->revision = Xapian::sortable_unserialise (last_mod);
-       notmuch->uuid = talloc_strdup (
-           notmuch, notmuch->xapian_db->get_uuid ().c_str ());
-
-       notmuch->query_parser = new Xapian::QueryParser;
-       notmuch->term_gen = new Xapian::TermGenerator;
-       notmuch->term_gen->set_stemmer (Xapian::Stem ("english"));
-       notmuch->value_range_processor = new Xapian::NumberRangeProcessor (NOTMUCH_VALUE_TIMESTAMP);
-       notmuch->date_range_processor = new ParseTimeRangeProcessor (NOTMUCH_VALUE_TIMESTAMP, "date:");
-       notmuch->last_mod_range_processor = new Xapian::NumberRangeProcessor (NOTMUCH_VALUE_LAST_MOD, "lastmod:");
-       notmuch->query_parser->set_default_op (Xapian::Query::OP_AND);
-       notmuch->query_parser->set_database (*notmuch->xapian_db);
-       notmuch->query_parser->set_stemmer (Xapian::Stem ("english"));
-       notmuch->query_parser->set_stemming_strategy (Xapian::QueryParser::STEM_SOME);
-       notmuch->query_parser->add_rangeprocessor (notmuch->value_range_processor);
-       notmuch->query_parser->add_rangeprocessor (notmuch->date_range_processor);
-       notmuch->query_parser->add_rangeprocessor (notmuch->last_mod_range_processor);
-
-       for (i = 0; i < ARRAY_SIZE (prefix_table); i++) {
-           const prefix_t *prefix = &prefix_table[i];
-           if (prefix->flags & NOTMUCH_FIELD_EXTERNAL) {
-               _setup_query_field (prefix, notmuch);
-           }
-       }
-       status = _setup_user_query_fields (notmuch);
-    } catch (const Xapian::Error &error) {
-       IGNORE_RESULT (asprintf (&message, "A Xapian exception occurred opening database: %s\n",
-                                error.get_msg ().c_str ()));
-       notmuch_database_destroy (notmuch);
-       notmuch = NULL;
-       status = NOTMUCH_STATUS_XAPIAN_EXCEPTION;
-    }
-
-  DONE:
-    talloc_free (local);
-
-    if (message) {
-       if (status_string)
-           *status_string = message;
-       else
-           free (message);
-    }
-
-    if (database)
-       *database = notmuch;
-    else
-       talloc_free (notmuch);
-
-    if (notmuch)
-       notmuch->open = true;
-
-    return status;
-}
-
 notmuch_status_t
 notmuch_database_close (notmuch_database_t *notmuch)
 {
@@ -1223,27 +602,51 @@ notmuch_database_compact (const char *path,
                          notmuch_compact_status_cb_t status_cb,
                          void *closure)
 {
-    void *local;
-    char *notmuch_path, *xapian_path, *compact_xapian_path;
     notmuch_status_t ret = NOTMUCH_STATUS_SUCCESS;
     notmuch_database_t *notmuch = NULL;
-    struct stat statbuf;
-    bool keep_backup;
     char *message = NULL;
 
-    local = talloc_new (NULL);
-    if (! local)
-       return NOTMUCH_STATUS_OUT_OF_MEMORY;
-
     ret = notmuch_database_open_verbose (path,
                                         NOTMUCH_DATABASE_MODE_READ_WRITE,
                                         &notmuch,
                                         &message);
     if (ret) {
        if (status_cb) status_cb (message, closure);
-       goto DONE;
+       return ret;
     }
 
+    _notmuch_config_cache (notmuch, NOTMUCH_CONFIG_DATABASE_PATH, path);
+
+    return notmuch_database_compact_db (notmuch,
+                                       backup_path,
+                                       status_cb,
+                                       closure);
+}
+
+notmuch_status_t
+notmuch_database_compact_db (notmuch_database_t *notmuch,
+                            const char *backup_path,
+                            notmuch_compact_status_cb_t status_cb,
+                            void *closure) {
+    void *local;
+    char *notmuch_path, *xapian_path, *compact_xapian_path;
+    const char* path;
+    notmuch_status_t ret = NOTMUCH_STATUS_SUCCESS;
+    struct stat statbuf;
+    bool keep_backup;
+
+    ret = _notmuch_database_ensure_writable (notmuch);
+    if (ret)
+       return ret;
+
+    path = notmuch_config_get (notmuch, NOTMUCH_CONFIG_DATABASE_PATH);
+    if (! path)
+       return NOTMUCH_STATUS_PATH_ERROR;
+
+    local = talloc_new (NULL);
+    if (! local)
+       return NOTMUCH_STATUS_OUT_OF_MEMORY;
+
     if (! (notmuch_path = talloc_asprintf (local, "%s/%s", path, ".notmuch"))) {
        ret = NOTMUCH_STATUS_OUT_OF_MEMORY;
        goto DONE;
@@ -1674,7 +1077,7 @@ notmuch_database_upgrade (notmuch_database_t *notmuch,
     }
 
     status = NOTMUCH_STATUS_SUCCESS;
-    db->set_metadata ("features", _print_features (local, notmuch->features));
+    db->set_metadata ("features", _notmuch_database_print_features (local, notmuch->features));
     db->set_metadata ("version", STRINGIFY (NOTMUCH_DATABASE_VERSION));
 
   DONE:
diff --git a/lib/features.cc b/lib/features.cc
new file mode 100644 (file)
index 0000000..8def246
--- /dev/null
@@ -0,0 +1,114 @@
+#include "database-private.h"
+
+static const struct {
+    /* NOTMUCH_FEATURE_* value. */
+    _notmuch_features value;
+    /* Feature name as it appears in the database.  This name should
+     * be appropriate for displaying to the user if an older version
+     * of notmuch doesn't support this feature. */
+    const char *name;
+    /* Compatibility flags when this feature is declared. */
+    const char *flags;
+} feature_names[] = {
+    { NOTMUCH_FEATURE_FILE_TERMS,
+      "multiple paths per message", "rw" },
+    { NOTMUCH_FEATURE_DIRECTORY_DOCS,
+      "relative directory paths", "rw" },
+    /* Header values are not required for reading a database because a
+     * reader can just refer to the message file. */
+    { NOTMUCH_FEATURE_FROM_SUBJECT_ID_VALUES,
+      "from/subject/message-ID in database", "w" },
+    { NOTMUCH_FEATURE_BOOL_FOLDER,
+      "exact folder:/path: search", "rw" },
+    { NOTMUCH_FEATURE_GHOSTS,
+      "mail documents for missing messages", "w" },
+    /* Knowledge of the index mime-types are not required for reading
+     * a database because a reader will just be unable to query
+     * them. */
+    { NOTMUCH_FEATURE_INDEXED_MIMETYPES,
+      "indexed MIME types", "w" },
+    { NOTMUCH_FEATURE_LAST_MOD,
+      "modification tracking", "w" },
+    /* Existing databases will work fine for all queries not involving
+     * 'body:' */
+    { NOTMUCH_FEATURE_UNPREFIX_BODY_ONLY,
+      "index body and headers separately", "w" },
+};
+
+char *
+_notmuch_database_print_features (const void *ctx, unsigned int features)
+{
+    unsigned int i;
+    char *res = talloc_strdup (ctx, "");
+
+    for (i = 0; i < ARRAY_SIZE (feature_names); ++i)
+       if (features & feature_names[i].value)
+           res = talloc_asprintf_append_buffer (
+               res, "%s\t%s\n", feature_names[i].name, feature_names[i].flags);
+
+    return res;
+}
+
+
+/* Parse a database features string from the given database version.
+ * Returns the feature bit set.
+ *
+ * For version < 3, this ignores the features string and returns a
+ * hard-coded set of features.
+ *
+ * If there are unrecognized features that are required to open the
+ * database in mode (which should be 'r' or 'w'), return a
+ * comma-separated list of unrecognized but required features in
+ * *incompat_out suitable for presenting to the user.  *incompat_out
+ * will be allocated from ctx.
+ */
+_notmuch_features
+_notmuch_database_parse_features (const void *ctx, const char *features, unsigned int version,
+                char mode, char **incompat_out)
+{
+    _notmuch_features res = static_cast<_notmuch_features>(0);
+    unsigned int namelen, i;
+    size_t llen = 0;
+    const char *flags;
+
+    /* Prior to database version 3, features were implied by the
+     * version number. */
+    if (version == 0)
+       return NOTMUCH_FEATURES_V0;
+    else if (version == 1)
+       return NOTMUCH_FEATURES_V1;
+    else if (version == 2)
+       return NOTMUCH_FEATURES_V2;
+
+    /* Parse the features string */
+    while ((features = strtok_len_c (features + llen, "\n", &llen)) != NULL) {
+       flags = strchr (features, '\t');
+       if (! flags || flags > features + llen)
+           continue;
+       namelen = flags - features;
+
+       for (i = 0; i < ARRAY_SIZE (feature_names); ++i) {
+           if (strlen (feature_names[i].name) == namelen &&
+               strncmp (feature_names[i].name, features, namelen) == 0) {
+               res |= feature_names[i].value;
+               break;
+           }
+       }
+
+       if (i == ARRAY_SIZE (feature_names) && incompat_out) {
+           /* Unrecognized feature */
+           const char *have = strchr (flags, mode);
+           if (have && have < features + llen) {
+               /* This feature is required to access this database in
+                * 'mode', but we don't understand it. */
+               if (! *incompat_out)
+                   *incompat_out = talloc_strdup (ctx, "");
+               *incompat_out = talloc_asprintf_append_buffer (
+                   *incompat_out, "%s%.*s", **incompat_out ? ", " : "",
+                   namelen, features);
+           }
+       }
+    }
+
+    return res;
+}
index 41aff34273da26ebc25b767929a405deb292accd..750a242c61bc9ec098fb98df0bbbe61ed59047d2 100644 (file)
@@ -74,7 +74,7 @@ NOTMUCH_BEGIN_DECLS
 #define NOTMUCH_CLEAR_BIT(valp,  bit) \
     (_NOTMUCH_VALID_BIT (bit) ? (*(valp) &= ~(1ull << (bit))) : *(valp))
 
-#define unused(x) x __attribute__ ((unused))
+#define unused(x) x ## _unused __attribute__ ((unused))
 
 /* Thanks to Andrew Tridgell's (SAMBA's) talloc for this definition of
  * unlikely. The talloc source code comes to us via the GNU LGPL v. 3.
@@ -127,10 +127,22 @@ typedef enum _notmuch_private_status {
     NOTMUCH_PRIVATE_STATUS_OUT_OF_MEMORY               = NOTMUCH_STATUS_OUT_OF_MEMORY,
     NOTMUCH_PRIVATE_STATUS_READ_ONLY_DATABASE          = NOTMUCH_STATUS_READ_ONLY_DATABASE,
     NOTMUCH_PRIVATE_STATUS_XAPIAN_EXCEPTION            = NOTMUCH_STATUS_XAPIAN_EXCEPTION,
+    NOTMUCH_PRIVATE_STATUS_FILE_ERROR                  = NOTMUCH_STATUS_FILE_ERROR,
     NOTMUCH_PRIVATE_STATUS_FILE_NOT_EMAIL              = NOTMUCH_STATUS_FILE_NOT_EMAIL,
     NOTMUCH_PRIVATE_STATUS_NULL_POINTER                        = NOTMUCH_STATUS_NULL_POINTER,
     NOTMUCH_PRIVATE_STATUS_TAG_TOO_LONG                        = NOTMUCH_STATUS_TAG_TOO_LONG,
     NOTMUCH_PRIVATE_STATUS_UNBALANCED_FREEZE_THAW      = NOTMUCH_STATUS_UNBALANCED_FREEZE_THAW,
+    NOTMUCH_PRIVATE_STATUS_UNBALANCED_ATOMIC           = NOTMUCH_STATUS_UNBALANCED_ATOMIC,
+    NOTMUCH_PRIVATE_STATUS_UNSUPPORTED_OPERATION       = NOTMUCH_STATUS_UNSUPPORTED_OPERATION,
+    NOTMUCH_PRIVATE_STATUS_UPGRADE_REQUIRED            = NOTMUCH_STATUS_UPGRADE_REQUIRED,
+    NOTMUCH_PRIVATE_STATUS_PATH_ERROR                  = NOTMUCH_STATUS_PATH_ERROR,
+    NOTMUCH_PRIVATE_STATUS_IGNORED                     = NOTMUCH_STATUS_IGNORED,
+    NOTMUCH_PRIVATE_STATUS_ILLEGAL_ARGUMENT            = NOTMUCH_STATUS_ILLEGAL_ARGUMENT,
+    NOTMUCH_PRIVATE_STATUS_MALFORMED_CRYPTO_PROTOCOL           = NOTMUCH_STATUS_MALFORMED_CRYPTO_PROTOCOL,
+    NOTMUCH_PRIVATE_STATUS_FAILED_CRYPTO_CONTEXT_CREATION      = NOTMUCH_STATUS_FAILED_CRYPTO_CONTEXT_CREATION,
+    NOTMUCH_PRIVATE_STATUS_UNKNOWN_CRYPTO_PROTOCOL             = NOTMUCH_STATUS_UNKNOWN_CRYPTO_PROTOCOL,
+    NOTMUCH_PRIVATE_STATUS_NO_CONFIG                           = NOTMUCH_STATUS_NO_CONFIG,
+    NOTMUCH_PRIVATE_STATUS_DATABASE_EXISTS                     = NOTMUCH_STATUS_DATABASE_EXISTS,
 
     /* Then add our own private values. */
     NOTMUCH_PRIVATE_STATUS_TERM_TOO_LONG               = NOTMUCH_STATUS_LAST_STATUS,
@@ -636,6 +648,11 @@ _notmuch_string_map_append (notmuch_string_map_t *map,
                            const char *key,
                            const char *value);
 
+void
+_notmuch_string_map_set (notmuch_string_map_t *map,
+                        const char *key,
+                        const char *value);
+
 const char *
 _notmuch_string_map_get (notmuch_string_map_t *map, const char *key);
 
@@ -697,6 +714,19 @@ struct _notmuch_indexopts {
 
 #define EMPTY_STRING(s) ((s)[0] == '\0')
 
+/* config.cc */
+notmuch_status_t
+_notmuch_config_load_from_database (notmuch_database_t * db);
+
+notmuch_status_t
+_notmuch_config_load_from_file (notmuch_database_t * db, GKeyFile *file);
+
+notmuch_status_t
+_notmuch_config_load_defaults (notmuch_database_t * db);
+
+void
+_notmuch_config_cache (notmuch_database_t *db, notmuch_config_key_t key, const char* val);
+
 NOTMUCH_END_DECLS
 
 #ifdef __cplusplus
index c66e78b1941226617285537338efe4ef7d90f293..5a5d99c0f750e2e7db2d824eea1c07263dc576e8 100644 (file)
@@ -208,6 +208,14 @@ typedef enum _notmuch_status {
      * something that notmuch doesn't know how to handle.
      */
     NOTMUCH_STATUS_UNKNOWN_CRYPTO_PROTOCOL,
+    /**
+     * Unable to load a config file
+     */
+    NOTMUCH_STATUS_NO_CONFIG,
+    /**
+     * Database exists, so not (re)-created
+     */
+    NOTMUCH_STATUS_DATABASE_EXISTS,
     /**
      * Not an actual status value. Just a way to find out how many
      * valid status values there are.
@@ -236,6 +244,7 @@ typedef struct _notmuch_tags notmuch_tags_t;
 typedef struct _notmuch_directory notmuch_directory_t;
 typedef struct _notmuch_filenames notmuch_filenames_t;
 typedef struct _notmuch_config_list notmuch_config_list_t;
+typedef struct _notmuch_config_values notmuch_config_values_t;
 typedef struct _notmuch_indexopts notmuch_indexopts_t;
 #endif /* __DOXYGEN__ */
 
@@ -301,52 +310,165 @@ typedef enum {
 } notmuch_database_mode_t;
 
 /**
- * Open an existing notmuch database located at 'path'.
+ * Deprecated alias for notmuch_database_open_with_config with
+ * config_path=error_message=NULL
+ * @deprecated Deprecated as of libnotmuch 5.4 (notmuch 0.32)
+ */
+/* NOTMUCH_DEPRECATED(5, 4) */
+notmuch_status_t
+notmuch_database_open (const char *path,
+                      notmuch_database_mode_t mode,
+                      notmuch_database_t **database);
+/**
+ * Deprecated alias for notmuch_database_open_with_config with
+ * config_path=NULL
+ *
+ * @deprecated Deprecated as of libnotmuch 5.4 (notmuch 0.32)
+ *
+ */
+/* NOTMUCH_DEPRECATED(5, 4) */
+notmuch_status_t
+notmuch_database_open_verbose (const char *path,
+                              notmuch_database_mode_t mode,
+                              notmuch_database_t **database,
+                              char **error_message);
+
+/**
+ * Open an existing notmuch database located at 'database_path', using
+ * configuration in 'config_path'.
+ *
+ * @param[in]  database_path
+ * @parblock
+ * Path to existing database.
+ *
+ * A notmuch database is a Xapian database containing appropriate
+ * metadata.
  *
  * The database should have been created at some time in the past,
  * (not necessarily by this process), by calling
- * notmuch_database_create with 'path'. By default the database should be
- * opened for reading only. In order to write to the database you need to
- * pass the NOTMUCH_DATABASE_MODE_READ_WRITE mode.
+ * notmuch_database_create.
+ *
+ * If 'database_path' is NULL, use the location specified
+ *
+ * - in the environment variable NOTMUCH_DATABASE, if non-empty
+ *
+ * - in a configuration file, located as described under 'config_path'
+ *
+ * - by $XDG_DATA_HOME/notmuch/$PROFILE where XDG_DATA_HOME defaults
+ *   to "$HOME/.local/share" and PROFILE as as discussed in
+ *   'profile'
+ *
+ * If 'database_path' is non-NULL, but does not appear to be a Xapian
+ * database, check for a directory '.notmuch/xapian' below
+ * 'database_path' (this is the behavior of
+ * notmuch_database_open_verbose pre-0.32).
+ *
+ * @endparblock
+ * @param[in]  mode
+ * @parblock
+ * Mode to open database. Use one of #NOTMUCH_DATABASE_MODE_READ_WRITE
+ * or #NOTMUCH_DATABASE_MODE_READ_ONLY
+ *
+ * @endparblock
+ * @param[in]  config_path
+ * @parblock
+ * Path to config file.
+ *
+ * Config file is key-value, with mandatory sections. See
+ * <em>notmuch-config(5)</em> for more information. The key-value pair
+ * overrides the corresponding configuration data stored in the
+ * database (see <em>notmuch_database_get_config</em>)
+ *
+ * If <em>config_path</em> is NULL use the path specified
+ *
+ * - in environment variable <em>NOTMUCH_CONFIG</em>, if non-empty
+ *
+ * - by  <em>XDG_CONFIG_HOME</em>/notmuch/ where
+ *   XDG_CONFIG_HOME defaults to "$HOME/.config".
+ *
+ * - by $HOME/.notmuch-config
+ *
+ * If <em>config_path</em> is "" (empty string) then do not
+ * open any configuration file.
+ * @endparblock
+ * @param[in] profile:
+ * @parblock
+ * Name of profile (configuration/database variant).
+ *
+ * If non-NULL, append to the directory / file path determined for
+ * <em>config_path</em> and <em>database_path</em>.
  *
- * An existing notmuch database can be identified by the presence of a
- * directory named ".notmuch" below 'path'.
+ * If NULL then use
+ * - environment variable NOTMUCH_PROFILE if defined,
+ * - otherwise "default" for directories and "" (empty string) for paths.
+ *
+ * @endparblock
+ * @param[out] database
+ * @parblock
+ * Pointer to database object. May not be NULL.
  *
  * The caller should call notmuch_database_destroy when finished with
  * this database.
  *
  * In case of any failure, this function returns an error status and
- * sets *database to NULL (after printing an error message on stderr).
+ * sets *database to NULL.
  *
- * Return value:
+ * @endparblock
+ * @param[out] error_message
+ * If non-NULL, store error message from opening the database.
+ * Any such message is allocated by \a malloc(3) and should be freed
+ * by the caller.
  *
- * NOTMUCH_STATUS_SUCCESS: Successfully opened the database.
+ * @retval NOTMUCH_STATUS_SUCCESS: Successfully opened the database.
  *
- * NOTMUCH_STATUS_NULL_POINTER: The given 'path' argument is NULL.
+ * @retval NOTMUCH_STATUS_NULL_POINTER: The given \a database
+ * argument is NULL.
  *
- * NOTMUCH_STATUS_OUT_OF_MEMORY: Out of memory.
+ * @retval NOTMUCH_STATUS_OUT_OF_MEMORY: Out of memory.
  *
- * NOTMUCH_STATUS_FILE_ERROR: An error occurred trying to open the
- *     database file (such as permission denied, or file not found,
+ * @retval NOTMUCH_STATUS_FILE_ERROR: An error occurred trying to open the
+ *     database or config file (such as permission denied, or file not found,
  *     etc.), or the database version is unknown.
  *
- * NOTMUCH_STATUS_XAPIAN_EXCEPTION: A Xapian exception occurred.
+ * @retval NOTMUCH_STATUS_XAPIAN_EXCEPTION: A Xapian exception occurred.
+ *
+ * @since libnotmuch 5.4 (notmuch 0.32)
  */
+
 notmuch_status_t
-notmuch_database_open (const char *path,
-                      notmuch_database_mode_t mode,
-                      notmuch_database_t **database);
+notmuch_database_open_with_config (const char *database_path,
+                                  notmuch_database_mode_t mode,
+                                  const char *config_path,
+                                  const char *profile,
+                                  notmuch_database_t **database,
+                                  char **error_message);
 /**
- * Like notmuch_database_open, except optionally return an error
- * message. This message is allocated by malloc and should be freed by
- * the caller.
+ * Create a new notmuch database located at 'database_path', using
+ * configuration in 'config_path'.
+ *
+ * For description of arguments, @see notmuch_database_open_with_config
+ *
+ * @retval NOTMUCH_STATUS_SUCCESS: Successfully created the database.
+ *
+ * @retval NOTMUCH_STATUS_DATABASE_EXISTS: Database already exists, not created
+ *
+ * @retval NOTMUCH_STATUS_OUT_OF_MEMORY: Out of memory.
+ *
+ * @retval NOTMUCH_STATUS_FILE_ERROR: An error occurred trying to open the
+ *     database or config file (such as permission denied, or file not found,
+ *     etc.)
+ *
+ * @retval NOTMUCH_STATUS_XAPIAN_EXCEPTION: A Xapian exception occurred.
+ *
+ * @since libnotmuch 5.4 (notmuch 0.32)
  */
 
 notmuch_status_t
-notmuch_database_open_verbose (const char *path,
-                              notmuch_database_mode_t mode,
-                              notmuch_database_t **database,
-                              char **error_message);
+notmuch_database_create_with_config (const char *database_path,
+                                    const char *config_path,
+                                    const char *profile,
+                                    notmuch_database_t **database,
+                                    char **error_message);
 
 /**
  * Retrieve last status string for given database.
@@ -410,6 +532,18 @@ notmuch_database_compact (const char *path,
                          notmuch_compact_status_cb_t status_cb,
                          void *closure);
 
+/**
+ * Like notmuch_database_compact, but take an open database as a
+ * parameter.
+ *
+ * @since libnnotmuch 5.4 (notmuch 0.32)
+ */
+notmuch_status_t
+notmuch_database_compact_db (notmuch_database_t *database,
+                            const char *backup_path,
+                            notmuch_compact_status_cb_t status_cb,
+                            void *closure);
+
 /**
  * Destroy the notmuch database, closing it if necessary and freeing
  * all associated resources.
@@ -2239,6 +2373,11 @@ notmuch_filenames_destroy (notmuch_filenames_t *filenames);
  * set config 'key' to 'value'
  *
  * @since libnotmuch 4.4 (notmuch 0.23)
+ * @retval #NOTMUCH_STATUS_READ_ONLY_DATABASE: Database was opened in
+ *     read-only mode so message cannot be modified.
+ * @retval #NOTMUCH_STATUS_XAPIAN_EXCEPTION: an exception was thrown
+ *      accessing the database.
+ * @retval #NOTMUCH_STATUS_SUCCESS
  */
 notmuch_status_t
 notmuch_database_set_config (notmuch_database_t *db, const char *key, const char *value);
@@ -2253,6 +2392,7 @@ notmuch_database_set_config (notmuch_database_t *db, const char *key, const char
  * caller.
  *
  * @since libnotmuch 4.4 (notmuch 0.23)
+ *
  */
 notmuch_status_t
 notmuch_database_get_config (notmuch_database_t *db, const char *key, char **value);
@@ -2314,6 +2454,152 @@ void
 notmuch_config_list_destroy (notmuch_config_list_t *config_list);
 
 
+/**
+ * Configuration keys known to libnotmuch
+ */
+typedef enum _notmuch_config_key {
+    NOTMUCH_CONFIG_FIRST,
+    NOTMUCH_CONFIG_DATABASE_PATH = NOTMUCH_CONFIG_FIRST,
+    NOTMUCH_CONFIG_HOOK_DIR,
+    NOTMUCH_CONFIG_EXCLUDE_TAGS,
+    NOTMUCH_CONFIG_NEW_TAGS,
+    NOTMUCH_CONFIG_NEW_IGNORE,
+    NOTMUCH_CONFIG_SYNC_MAILDIR_FLAGS,
+    NOTMUCH_CONFIG_PRIMARY_EMAIL,
+    NOTMUCH_CONFIG_OTHER_EMAIL,
+    NOTMUCH_CONFIG_USER_NAME,
+    NOTMUCH_CONFIG_LAST
+} notmuch_config_key_t;
+
+/**
+ * get a configuration value from an open database.
+ *
+ * This value reflects all configuration information given at the time
+ * the database was opened.
+ *
+ * @param[in] notmuch database
+ * @param[in] key configuration key
+ *
+ * @since libnotmuch 5.4 (notmuch 0.32)
+ *
+ * @retval NULL if 'key' unknown or if no value is known for
+ *         'key'.  Otherwise returns a string owned by notmuch which should
+ *         not be modified nor freed by the caller.
+ */
+const char *
+notmuch_config_get (notmuch_database_t *notmuch, notmuch_config_key_t key);
+
+/**
+ * set a configuration value from in an open database.
+ *
+ * This value reflects all configuration information given at the time
+ * the database was opened.
+ *
+ * @param[in,out] notmuch database open read/write
+ * @param[in] key configuration key
+ * @param[in] val configuration value
+ *
+ * @since libnotmuch 5.4 (notmuch 0.32)
+ *
+ * @retval returns any return value for notmuch_database_set_config.
+ */
+notmuch_status_t
+notmuch_config_set (notmuch_database_t *notmuch, notmuch_config_key_t key, const char *val);
+
+/**
+ * Returns an iterator for a ';'-delimited list of configuration values
+ *
+ * These values reflect all configuration information given at the
+ * time the database was opened.
+ *
+ * @param[in] notmuch database
+ * @param[in] key configuration key
+ *
+ * @since libnotmuch 5.4 (notmuch 0.32)
+ *
+ * @retval NULL in case of error.
+ */
+notmuch_config_values_t *
+notmuch_config_get_values (notmuch_database_t *notmuch, notmuch_config_key_t key);
+
+/**
+ * Is the given 'config_values' iterator pointing at a valid element.
+ *
+ * @param[in] values iterator
+ *
+ * @since libnotmuch 5.4 (notmuch 0.32)
+ *
+ * @retval FALSE if passed a NULL pointer, or the iterator is exhausted.
+ *
+ */
+notmuch_bool_t
+notmuch_config_values_valid (notmuch_config_values_t *values);
+
+/**
+ * Get the current value from the 'values' iterator
+ *
+ * @param[in] values iterator
+ *
+ * @since libnotmuch 5.4 (notmuch 0.32)
+ *
+ * @retval a string with the same lifetime as the iterator
+ */
+const char *
+notmuch_config_values_get (notmuch_config_values_t *values);
+
+/**
+ * Move the 'values' iterator to the next element
+ *
+ * @param[in,out] values iterator
+ *
+ * @since libnotmuch 5.4 (notmuch 0.32)
+ *
+ */
+void
+notmuch_config_values_move_to_next (notmuch_config_values_t *values);
+
+
+/**
+ * reset the 'values' iterator to the first element
+ *
+ * @param[in,out] values iterator. A NULL value is ignored.
+ *
+ * @since libnotmuch 5.4 (notmuch 0.32)
+ *
+ */
+void
+notmuch_config_values_start (notmuch_config_values_t *values);
+
+/**
+ * Destroy a config values iterator, along with any associated
+ * resources.
+ *
+ * @param[in,out] values iterator
+ *
+ * @since libnotmuch 5.4 (notmuch 0.32)
+ */
+void
+notmuch_config_values_destroy (notmuch_config_values_t *values);
+
+/**
+ * get a configuration value from an open database as Boolean
+ *
+ * This value reflects all configuration information given at the time
+ * the database was opened.
+ *
+ * @param[in] notmuch database
+ * @param[in] key configuration key
+ * @param[out] val configuration value, converted to Boolean
+ *
+ * @since libnotmuch 5.4 (notmuch 0.32)
+ *
+ * @retval #NOTMUCH_STATUS_ILLEGAL_ARGUMENT if either key is unknown
+ * or the corresponding value does not convert to Boolean.
+ */
+notmuch_status_t
+notmuch_config_get_bool (notmuch_database_t *notmuch,
+                        notmuch_config_key_t key,
+                        notmuch_bool_t *val);
 /**
  * get the current default indexing options for a given database.
  *
diff --git a/lib/open.cc b/lib/open.cc
new file mode 100644 (file)
index 0000000..3b86065
--- /dev/null
@@ -0,0 +1,496 @@
+#include <unistd.h>
+#include "database-private.h"
+#include "parse-time-vrp.h"
+
+#if HAVE_XAPIAN_DB_RETRY_LOCK
+#define DB_ACTION (Xapian::DB_CREATE_OR_OPEN | Xapian::DB_RETRY_LOCK)
+#else
+#define DB_ACTION Xapian::DB_CREATE_OR_OPEN
+#endif
+
+notmuch_status_t
+notmuch_database_open (const char *path,
+                      notmuch_database_mode_t mode,
+                      notmuch_database_t **database)
+{
+    char *status_string = NULL;
+    notmuch_status_t status;
+
+    status = notmuch_database_open_verbose (path, mode, database,
+                                           &status_string);
+
+    if (status_string) {
+       fputs (status_string, stderr);
+       free (status_string);
+    }
+
+    return status;
+}
+
+notmuch_status_t
+notmuch_database_open_verbose (const char *path,
+                              notmuch_database_mode_t mode,
+                              notmuch_database_t **database,
+                              char **status_string)
+{
+    return notmuch_database_open_with_config (path, mode, "", NULL,
+                                             database, status_string);
+}
+
+static const char *
+_xdg_dir (void *ctx,
+         const char *xdg_root_variable,
+         const char *xdg_prefix,
+         const char *profile_name)
+{
+    const char *xdg_root = getenv (xdg_root_variable);
+
+    if (! xdg_root) {
+       const char *home = getenv ("HOME");
+
+       if (! home) return NULL;
+
+       xdg_root = talloc_asprintf (ctx,
+                                   "%s/%s",
+                                   home,
+                                   xdg_prefix);
+    }
+
+    if (! profile_name)
+       profile_name = getenv ("NOTMUCH_PROFILE");
+
+    if (! profile_name)
+       profile_name = "default";
+
+    return talloc_asprintf (ctx,
+                           "%s/notmuch/%s",
+                           xdg_root,
+                           profile_name);
+}
+
+static notmuch_status_t
+_choose_hook_dir (notmuch_database_t *notmuch,
+                 const char *profile,
+                 char **message)
+{
+    const char *config;
+    const char *hook_dir;
+    struct stat st;
+    int err;
+
+    hook_dir = notmuch_config_get (notmuch, NOTMUCH_CONFIG_HOOK_DIR);
+
+    if (hook_dir)
+       return NOTMUCH_STATUS_SUCCESS;
+
+    config = _xdg_dir (notmuch, "XDG_CONFIG_HOME", ".config", profile);
+    if (! config)
+       return  NOTMUCH_STATUS_PATH_ERROR;
+
+    hook_dir = talloc_asprintf (notmuch, "%s/hooks", config);
+
+    err = stat (hook_dir, &st);
+    if (err) {
+       if (errno == ENOENT) {
+           const char *database_path = notmuch_database_get_path (notmuch);
+           hook_dir = talloc_asprintf (notmuch, "%s/.notmuch/hooks", database_path);
+       } else {
+           IGNORE_RESULT (asprintf (message, "Error: Cannot stat %s: %s.\n",
+                                    hook_dir, strerror (errno)));
+           return NOTMUCH_STATUS_FILE_ERROR;
+       }
+    }
+
+    _notmuch_config_cache (notmuch, NOTMUCH_CONFIG_HOOK_DIR, hook_dir);
+
+    return NOTMUCH_STATUS_SUCCESS;
+}
+
+static notmuch_status_t
+_load_key_file (const char *path,
+               const char *profile,
+               GKeyFile **key_file)
+{
+    notmuch_status_t status = NOTMUCH_STATUS_SUCCESS;
+    void *local = talloc_new (NULL);
+
+    if (path && EMPTY_STRING (path))
+       goto DONE;
+
+    if (! path)
+       path = getenv ("NOTMUCH_CONFIG");
+
+    if (! path) {
+       const char *dir = _xdg_dir (local, "XDG_CONFIG_HOME", ".config", profile);
+
+       if (dir) {
+           path = talloc_asprintf (local, "%s/config", dir);
+           if (access (path, R_OK) !=0)
+               path = NULL;
+       }
+    }
+
+    if (! path) {
+       const char *home = getenv ("HOME");
+
+       path = talloc_asprintf (local, "%s/.notmuch-config", home);
+
+       if (! profile)
+           profile = getenv ("NOTMUCH_PROFILE");
+
+       if (profile)
+           path = talloc_asprintf (local, "%s.%s", path, profile);
+    }
+
+    *key_file = g_key_file_new ();
+    if (! g_key_file_load_from_file (*key_file, path, G_KEY_FILE_NONE, NULL)) {
+       status = NOTMUCH_STATUS_NO_CONFIG;
+    }
+
+DONE:
+    talloc_free (local);
+    return status;
+}
+
+static notmuch_status_t
+_choose_database_path (const char *config_path,
+                      const char *profile,
+                      GKeyFile **key_file,
+                      const char **database_path,
+                      char **message)
+{
+    notmuch_status_t status;
+
+    status =_load_key_file (config_path, profile, key_file);
+    if (status) {
+       *message = strdup ("Error: cannot load config file.\n");
+       return status;
+    }
+
+    if (! *database_path && *key_file)
+       *database_path = g_key_file_get_value (*key_file, "database", "path", NULL);
+
+    if (*database_path == NULL) {
+       *message = strdup ("Error: Cannot open a database for a NULL path.\n");
+       return NOTMUCH_STATUS_NULL_POINTER;
+    }
+
+    if (*database_path[0] != '/') {
+       *message = strdup ("Error: Database path must be absolute.\n");
+       return NOTMUCH_STATUS_PATH_ERROR;
+    }
+    return NOTMUCH_STATUS_SUCCESS;
+}
+
+notmuch_status_t
+notmuch_database_open_with_config (const char *database_path,
+                                  notmuch_database_mode_t mode,
+                                  const char *config_path,
+                                  const char *profile,
+                                  notmuch_database_t **database,
+                                  char **status_string)
+{
+    notmuch_status_t status = NOTMUCH_STATUS_SUCCESS;
+    void *local = talloc_new (NULL);
+    notmuch_database_t *notmuch = NULL;
+    char *notmuch_path, *xapian_path, *incompat_features;
+    char *message = NULL;
+    struct stat st;
+    int err;
+    unsigned int version;
+    GKeyFile *key_file = NULL;
+    static int initialized = 0;
+
+    if ((status = _choose_database_path (config_path, profile, &key_file, &database_path, &message)))
+       goto DONE;
+
+    if (! (notmuch_path = talloc_asprintf (local, "%s/%s", database_path, ".notmuch"))) {
+       message = strdup ("Out of memory\n");
+       status = NOTMUCH_STATUS_OUT_OF_MEMORY;
+       goto DONE;
+    }
+
+    err = stat (notmuch_path, &st);
+    if (err) {
+       IGNORE_RESULT (asprintf (&message, "Error opening database at %s: %s\n",
+                                notmuch_path, strerror (errno)));
+       status = NOTMUCH_STATUS_FILE_ERROR;
+       goto DONE;
+    }
+
+    if (! (xapian_path = talloc_asprintf (local, "%s/%s", notmuch_path, "xapian"))) {
+       message = strdup ("Out of memory\n");
+       status = NOTMUCH_STATUS_OUT_OF_MEMORY;
+       goto DONE;
+    }
+
+    /* Initialize the GLib type system and threads */
+#if ! GLIB_CHECK_VERSION (2, 35, 1)
+    g_type_init ();
+#endif
+
+    /* Initialize gmime */
+    if (! initialized) {
+       g_mime_init ();
+       initialized = 1;
+    }
+
+    notmuch = talloc_zero (NULL, notmuch_database_t);
+    notmuch->exception_reported = false;
+    notmuch->status_string = NULL;
+    notmuch->path = talloc_strdup (notmuch, database_path);
+
+    strip_trailing (notmuch->path, '/');
+
+    notmuch->writable_xapian_db = NULL;
+    notmuch->atomic_nesting = 0;
+    notmuch->view = 1;
+    try {
+       std::string last_thread_id;
+       std::string last_mod;
+
+       if (mode == NOTMUCH_DATABASE_MODE_READ_WRITE) {
+           notmuch->writable_xapian_db = new Xapian::WritableDatabase (xapian_path,
+                                                                       DB_ACTION);
+           notmuch->xapian_db = notmuch->writable_xapian_db;
+       } else {
+           notmuch->xapian_db = new Xapian::Database (xapian_path);
+       }
+
+       /* Check version.  As of database version 3, we represent
+        * changes in terms of features, so assume a version bump
+        * means a dramatically incompatible change. */
+       version = notmuch_database_get_version (notmuch);
+       if (version > NOTMUCH_DATABASE_VERSION) {
+           IGNORE_RESULT (asprintf (&message,
+                                    "Error: Notmuch database at %s\n"
+                                    "       has a newer database format version (%u) than supported by this\n"
+                                    "       version of notmuch (%u).\n",
+                                    notmuch_path, version, NOTMUCH_DATABASE_VERSION));
+           notmuch_database_destroy (notmuch);
+           notmuch = NULL;
+           status = NOTMUCH_STATUS_FILE_ERROR;
+           goto DONE;
+       }
+
+       /* Check features. */
+       incompat_features = NULL;
+       notmuch->features = _notmuch_database_parse_features (
+           local, notmuch->xapian_db->get_metadata ("features").c_str (),
+           version, mode == NOTMUCH_DATABASE_MODE_READ_WRITE ? 'w' : 'r',
+           &incompat_features);
+       if (incompat_features) {
+           IGNORE_RESULT (asprintf (&message,
+                                    "Error: Notmuch database at %s\n"
+                                    "       requires features (%s)\n"
+                                    "       not supported by this version of notmuch.\n",
+                                    notmuch_path, incompat_features));
+           notmuch_database_destroy (notmuch);
+           notmuch = NULL;
+           status = NOTMUCH_STATUS_FILE_ERROR;
+           goto DONE;
+       }
+
+       notmuch->last_doc_id = notmuch->xapian_db->get_lastdocid ();
+       last_thread_id = notmuch->xapian_db->get_metadata ("last_thread_id");
+       if (last_thread_id.empty ()) {
+           notmuch->last_thread_id = 0;
+       } else {
+           const char *str;
+           char *end;
+
+           str = last_thread_id.c_str ();
+           notmuch->last_thread_id = strtoull (str, &end, 16);
+           if (*end != '\0')
+               INTERNAL_ERROR ("Malformed database last_thread_id: %s", str);
+       }
+
+       /* Get current highest revision number. */
+       last_mod = notmuch->xapian_db->get_value_upper_bound (
+           NOTMUCH_VALUE_LAST_MOD);
+       if (last_mod.empty ())
+           notmuch->revision = 0;
+       else
+           notmuch->revision = Xapian::sortable_unserialise (last_mod);
+       notmuch->uuid = talloc_strdup (
+           notmuch, notmuch->xapian_db->get_uuid ().c_str ());
+
+       notmuch->query_parser = new Xapian::QueryParser;
+       notmuch->term_gen = new Xapian::TermGenerator;
+       notmuch->term_gen->set_stemmer (Xapian::Stem ("english"));
+       notmuch->value_range_processor = new Xapian::NumberRangeProcessor (NOTMUCH_VALUE_TIMESTAMP);
+       notmuch->date_range_processor = new ParseTimeRangeProcessor (NOTMUCH_VALUE_TIMESTAMP, "date:");
+       notmuch->last_mod_range_processor = new Xapian::NumberRangeProcessor (NOTMUCH_VALUE_LAST_MOD, "lastmod:");
+       notmuch->query_parser->set_default_op (Xapian::Query::OP_AND);
+       notmuch->query_parser->set_database (*notmuch->xapian_db);
+       notmuch->query_parser->set_stemmer (Xapian::Stem ("english"));
+       notmuch->query_parser->set_stemming_strategy (Xapian::QueryParser::STEM_SOME);
+       notmuch->query_parser->add_rangeprocessor (notmuch->value_range_processor);
+       notmuch->query_parser->add_rangeprocessor (notmuch->date_range_processor);
+       notmuch->query_parser->add_rangeprocessor (notmuch->last_mod_range_processor);
+
+       /* Configuration information is needed to set up query parser */
+       status = _notmuch_config_load_from_database (notmuch);
+       if (status)
+           goto DONE;
+
+       if (key_file)
+           status = _notmuch_config_load_from_file (notmuch, key_file);
+       if (status)
+           goto DONE;
+
+       status = _choose_hook_dir (notmuch, profile, &message);
+       if (status)
+           goto DONE;
+
+       status = _notmuch_config_load_defaults (notmuch);
+       if (status)
+           goto DONE;
+
+       status = _notmuch_database_setup_standard_query_fields (notmuch);
+       if (status)
+           goto DONE;
+
+       status = _notmuch_database_setup_user_query_fields (notmuch);
+       if (status)
+           goto DONE;
+
+    } catch (const Xapian::Error &error) {
+       IGNORE_RESULT (asprintf (&message, "A Xapian exception occurred opening database: %s\n",
+                                error.get_msg ().c_str ()));
+       notmuch_database_destroy (notmuch);
+       notmuch = NULL;
+       status = NOTMUCH_STATUS_XAPIAN_EXCEPTION;
+    }
+
+  DONE:
+    talloc_free (local);
+
+    if (message) {
+       if (status_string)
+           *status_string = message;
+       else
+           free (message);
+    }
+
+    if (database)
+       *database = notmuch;
+    else
+       talloc_free (notmuch);
+
+    if (notmuch)
+       notmuch->open = true;
+
+    return status;
+}
+
+notmuch_status_t
+notmuch_database_create (const char *path, notmuch_database_t **database)
+{
+    char *status_string = NULL;
+    notmuch_status_t status;
+
+    status = notmuch_database_create_verbose (path, database,
+                                             &status_string);
+
+    if (status_string) {
+       fputs (status_string, stderr);
+       free (status_string);
+    }
+
+    return status;
+}
+
+notmuch_status_t
+notmuch_database_create_verbose (const char *path,
+                                notmuch_database_t **database,
+                                char **status_string)
+{
+    return notmuch_database_create_with_config (path, "", NULL, database, status_string);
+}
+
+notmuch_status_t
+notmuch_database_create_with_config (const char *database_path,
+                                    const char *config_path,
+                                    const char *profile,
+                                    notmuch_database_t **database,
+                                    char **status_string)
+{
+    notmuch_status_t status = NOTMUCH_STATUS_SUCCESS;
+    notmuch_database_t *notmuch = NULL;
+    char *notmuch_path = NULL;
+    char *message = NULL;
+    GKeyFile *key_file = NULL;
+    struct stat st;
+    int err;
+
+    if ((status = _choose_database_path (config_path, profile, &key_file, &database_path, &message)))
+       goto DONE;
+
+    err = stat (database_path, &st);
+    if (err) {
+       IGNORE_RESULT (asprintf (&message, "Error: Cannot create database at %s: %s.\n",
+                                database_path, strerror (errno)));
+       status = NOTMUCH_STATUS_FILE_ERROR;
+       goto DONE;
+    }
+
+    if (! S_ISDIR (st.st_mode)) {
+       IGNORE_RESULT (asprintf (&message, "Error: Cannot create database at %s: "
+                                "Not a directory.\n",
+                                database_path));
+       status = NOTMUCH_STATUS_FILE_ERROR;
+       goto DONE;
+    }
+
+    notmuch_path = talloc_asprintf (NULL, "%s/%s", database_path, ".notmuch");
+
+    err = mkdir (notmuch_path, 0755);
+    if (err) {
+       if (errno == EEXIST) {
+           status = NOTMUCH_STATUS_DATABASE_EXISTS;
+       } else {
+           IGNORE_RESULT (asprintf (&message, "Error: Cannot create directory %s: %s.\n",
+                                    notmuch_path, strerror (errno)));
+           status = NOTMUCH_STATUS_FILE_ERROR;
+       }
+       goto DONE;
+    }
+
+    /* XXX this reads the config file twice, which is a bit wasteful */
+    status = notmuch_database_open_with_config (database_path,
+                                               NOTMUCH_DATABASE_MODE_READ_WRITE,
+                                               config_path,
+                                               profile,
+                                               &notmuch, &message);
+    if (status)
+       goto DONE;
+
+    /* Upgrade doesn't add these feature to existing databases, but
+     * new databases have them. */
+    notmuch->features |= NOTMUCH_FEATURE_FROM_SUBJECT_ID_VALUES;
+    notmuch->features |= NOTMUCH_FEATURE_INDEXED_MIMETYPES;
+    notmuch->features |= NOTMUCH_FEATURE_UNPREFIX_BODY_ONLY;
+
+    status = notmuch_database_upgrade (notmuch, NULL, NULL);
+    if (status) {
+       notmuch_database_close (notmuch);
+       notmuch = NULL;
+    }
+
+  DONE:
+    if (notmuch_path)
+       talloc_free (notmuch_path);
+
+    if (message) {
+       if (status_string)
+           *status_string = message;
+       else
+           free (message);
+    }
+    if (database)
+       *database = notmuch;
+    else
+       talloc_free (notmuch);
+    return status;
+}
diff --git a/lib/prefix.cc b/lib/prefix.cc
new file mode 100644 (file)
index 0000000..71a7699
--- /dev/null
@@ -0,0 +1,210 @@
+#include "database-private.h"
+#include "query-fp.h"
+#include "thread-fp.h"
+#include "regexp-fields.h"
+#include "parse-time-vrp.h"
+
+typedef struct {
+    const char *name;
+    const char *prefix;
+    notmuch_field_flag_t flags;
+} prefix_t;
+
+/* With these prefix values we follow the conventions published here:
+ *
+ * https://xapian.org/docs/omega/termprefixes.html
+ *
+ * as much as makes sense. Note that I took some liberty in matching
+ * the reserved prefix values to notmuch concepts, (for example, 'G'
+ * is documented as "newsGroup (or similar entity - e.g. a web forum
+ * name)", for which I think the thread is the closest analogue in
+ * notmuch. This in spite of the fact that we will eventually be
+ * storing mailing-list messages where 'G' for "mailing list name"
+ * might be even a closer analogue. I'm treating the single-character
+ * prefixes preferentially for core notmuch concepts (which will be
+ * nearly universal to all mail messages).
+ */
+
+static const
+prefix_t prefix_table[] = {
+    /* name                    term prefix     flags */
+    { "type",                   "T",            NOTMUCH_FIELD_NO_FLAGS },
+    { "reference",              "XREFERENCE",   NOTMUCH_FIELD_NO_FLAGS },
+    { "replyto",                "XREPLYTO",     NOTMUCH_FIELD_NO_FLAGS },
+    { "directory",              "XDIRECTORY",   NOTMUCH_FIELD_NO_FLAGS },
+    { "file-direntry",          "XFDIRENTRY",   NOTMUCH_FIELD_NO_FLAGS },
+    { "directory-direntry",     "XDDIRENTRY",   NOTMUCH_FIELD_NO_FLAGS },
+    { "body",                   "",             NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROBABILISTIC },
+    { "thread",                 "G",            NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROCESSOR },
+    { "tag",                    "K",            NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROCESSOR },
+    { "is",                     "K",            NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROCESSOR },
+    { "id",                     "Q",            NOTMUCH_FIELD_EXTERNAL },
+    { "mid",                    "Q",            NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROCESSOR },
+    { "path",                   "P",            NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROCESSOR },
+    { "property",               "XPROPERTY",    NOTMUCH_FIELD_EXTERNAL },
+    /*
+     * Unconditionally add ':' to reduce potential ambiguity with
+     * overlapping prefixes and/or terms that start with capital
+     * letters. See Xapian document termprefixes.html for related
+     * discussion.
+     */
+    { "folder",                 "XFOLDER:",     NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROCESSOR },
+    { "date",                   NULL,           NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROCESSOR },
+    { "query",                  NULL,           NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROCESSOR },
+    { "from",                   "XFROM",        NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROBABILISTIC |
+      NOTMUCH_FIELD_PROCESSOR },
+    { "to",                     "XTO",          NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROBABILISTIC },
+    { "attachment",             "XATTACHMENT",  NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROBABILISTIC },
+    { "mimetype",               "XMIMETYPE",    NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROBABILISTIC },
+    { "subject",                "XSUBJECT",     NOTMUCH_FIELD_EXTERNAL |
+      NOTMUCH_FIELD_PROBABILISTIC |
+      NOTMUCH_FIELD_PROCESSOR },
+};
+
+static const char *
+_user_prefix (void *ctx, const char *name)
+{
+    return talloc_asprintf (ctx, "XU%s:", name);
+}
+
+const char *
+_find_prefix (const char *name)
+{
+    unsigned int i;
+
+    for (i = 0; i < ARRAY_SIZE (prefix_table); i++) {
+       if (strcmp (name, prefix_table[i].name) == 0)
+           return prefix_table[i].prefix;
+    }
+
+    INTERNAL_ERROR ("No prefix exists for '%s'\n", name);
+
+    return "";
+}
+
+/* Like find prefix, but include the possibility of user defined
+ * prefixes specific to this database */
+
+const char *
+_notmuch_database_prefix (notmuch_database_t *notmuch, const char *name)
+{
+    unsigned int i;
+
+    /*XXX TODO: reduce code duplication */
+    for (i = 0; i < ARRAY_SIZE (prefix_table); i++) {
+       if (strcmp (name, prefix_table[i].name) == 0)
+           return prefix_table[i].prefix;
+    }
+
+    if (notmuch->user_prefix)
+       return _notmuch_string_map_get (notmuch->user_prefix, name);
+
+    return NULL;
+}
+
+static void
+_setup_query_field_default (const prefix_t *prefix, notmuch_database_t *notmuch)
+{
+    if (prefix->prefix)
+       notmuch->query_parser->add_prefix ("", prefix->prefix);
+    if (prefix->flags & NOTMUCH_FIELD_PROBABILISTIC)
+       notmuch->query_parser->add_prefix (prefix->name, prefix->prefix);
+    else
+       notmuch->query_parser->add_boolean_prefix (prefix->name, prefix->prefix);
+}
+
+static void
+_setup_query_field (const prefix_t *prefix, notmuch_database_t *notmuch)
+{
+    if (prefix->flags & NOTMUCH_FIELD_PROCESSOR) {
+       Xapian::FieldProcessor *fp;
+
+       if (STRNCMP_LITERAL (prefix->name, "date") == 0)
+           fp = (new DateFieldProcessor(NOTMUCH_VALUE_TIMESTAMP))->release ();
+       else if (STRNCMP_LITERAL(prefix->name, "query") == 0)
+           fp = (new QueryFieldProcessor (*notmuch->query_parser, notmuch))->release ();
+       else if (STRNCMP_LITERAL (prefix->name, "thread") == 0)
+           fp = (new ThreadFieldProcessor (*notmuch->query_parser, notmuch))->release ();
+       else
+           fp = (new RegexpFieldProcessor (prefix->name, prefix->flags,
+                                           *notmuch->query_parser, notmuch))->release ();
+
+       /* we treat all field-processor fields as boolean in order to get the raw input */
+       if (prefix->prefix)
+           notmuch->query_parser->add_prefix ("", prefix->prefix);
+       notmuch->query_parser->add_boolean_prefix (prefix->name, fp);
+    } else {
+       _setup_query_field_default (prefix, notmuch);
+    }
+}
+
+notmuch_status_t
+_notmuch_database_setup_standard_query_fields (notmuch_database_t *notmuch)
+{
+    for (unsigned int i = 0; i < ARRAY_SIZE (prefix_table); i++) {
+       const prefix_t *prefix = &prefix_table[i];
+       if (prefix->flags & NOTMUCH_FIELD_EXTERNAL) {
+           _setup_query_field (prefix, notmuch);
+       }
+    }
+    return NOTMUCH_STATUS_SUCCESS;
+}
+
+notmuch_status_t
+_notmuch_database_setup_user_query_fields (notmuch_database_t *notmuch)
+{
+    notmuch_string_map_iterator_t *list;
+
+    notmuch->user_prefix = _notmuch_string_map_create (notmuch);
+    if (notmuch->user_prefix == NULL)
+       return NOTMUCH_STATUS_OUT_OF_MEMORY;
+
+    notmuch->user_header = _notmuch_string_map_create (notmuch);
+    if (notmuch->user_header == NULL)
+       return NOTMUCH_STATUS_OUT_OF_MEMORY;
+
+    list = _notmuch_string_map_iterator_create (notmuch->config, CONFIG_HEADER_PREFIX, FALSE);
+    if (! list)
+       INTERNAL_ERROR ("unable to read headers from configuration");
+
+    for (; _notmuch_string_map_iterator_valid (list);
+        _notmuch_string_map_iterator_move_to_next (list)) {
+
+       prefix_t query_field;
+
+       const char *key = _notmuch_string_map_iterator_key (list)
+                         + sizeof (CONFIG_HEADER_PREFIX) - 1;
+
+       _notmuch_string_map_append (notmuch->user_prefix,
+                                   key,
+                                   _user_prefix (notmuch, key));
+
+       _notmuch_string_map_append (notmuch->user_header,
+                                   key,
+                                   _notmuch_string_map_iterator_value (list));
+
+       query_field.name = talloc_strdup (notmuch, key);
+       query_field.prefix = _user_prefix (notmuch, key);
+       query_field.flags = NOTMUCH_FIELD_PROBABILISTIC
+                           | NOTMUCH_FIELD_EXTERNAL;
+
+       _setup_query_field_default (&query_field, notmuch);
+    }
+
+    _notmuch_string_map_iterator_destroy (list);
+
+    return NOTMUCH_STATUS_SUCCESS;
+}
index a88404c734ff5a93ab98349bcc7913229bd19e47..71eac6349a896ef49fe1cbfea3378a308951e1a4 100644 (file)
@@ -143,6 +143,24 @@ bsearch_first (notmuch_string_pair_t *array, size_t len, const char *key, bool e
 
 }
 
+void
+_notmuch_string_map_set (notmuch_string_map_t *map,
+                        const char *key,
+                        const char *val)
+{
+    notmuch_string_pair_t *pair;
+
+    /* this means that calling string_map_set invalidates iterators */
+    _notmuch_string_map_sort (map);
+    pair = bsearch_first (map->pairs, map->length, key, true);
+    if (! pair)
+       _notmuch_string_map_append (map, key, val);
+    else {
+       talloc_free (pair->value);
+       pair->value = talloc_strdup (map->pairs, val);
+    }
+}
+
 const char *
 _notmuch_string_map_get (notmuch_string_map_t *map, const char *key)
 {
index ebd43e8d296ec775808f527b757b73c137528235..f60f540626d94df074f0294d439892b52bf03b46 100644 (file)
@@ -171,46 +171,46 @@ void
 notmuch_exit_if_unsupported_format (void);
 
 int
-notmuch_count_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_count_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_dump_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_dump_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_new_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_new_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_insert_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_insert_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_reindex_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_reindex_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_reply_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_reply_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_restore_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_restore_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_search_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_search_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_address_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_address_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_setup_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_setup_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_show_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_show_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_tag_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_tag_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_config_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_config_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 int
-notmuch_compact_command (notmuch_config_t *config, int argc, char *argv[]);
+notmuch_compact_command (notmuch_config_t *config, notmuch_database_t *notmuch, int argc, char *argv[]);
 
 const char *
 notmuch_time_relative_date (const void *ctx, time_t then);
@@ -253,14 +253,17 @@ json_quote_str (const void *ctx, const char *str);
 /* notmuch-config.c */
 
 typedef enum {
-    NOTMUCH_CONFIG_OPEN                = 1 << 0,
-    NOTMUCH_CONFIG_CREATE      = 1 << 1,
-} notmuch_config_mode_t;
+    NOTMUCH_COMMAND_CONFIG_OPEN                = 1 << 0,
+    NOTMUCH_COMMAND_CONFIG_CREATE      = 1 << 1,
+    NOTMUCH_COMMAND_DATABASE_EARLY     = 1 << 2,
+    NOTMUCH_COMMAND_DATABASE_WRITE     = 1 << 3,
+    NOTMUCH_COMMAND_DATABASE_CREATE    = 1 << 4,