emacs: Add new option notmuch-search-hide-excluded

[notmuch] / emacs / notmuch-draft.el

diff --git a/emacs/notmuch-draft.el b/emacs/notmuch-draft.el
index fb7f4f55ed572d5d37d4e1e17f666493f6a25422..fcc45503c6b0816d4ab12ab98a6c86cf6b2d3eb9 100644 (file)
--- a/emacs/notmuch-draft.el
+++ b/emacs/notmuch-draft.el
@@ -1,7 +1,8 @@
-;;; 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
 ;;
 ;; Copyright © Mark Walters
 ;; Copyright © David Bremner

+;; Copyright © Leo Gaspard

 ;;
 ;; This file is part of Notmuch.
 ;;
 ;;
 ;; This file is part of Notmuch.
 ;;


@@ -20,21 +21,28 @@
 ;;
 ;; Authors: Mark Walters <markwalters1009@gmail.com>
 ;;         David Bremner <david@tethera.net>
 ;;
 ;; Authors: Mark Walters <markwalters1009@gmail.com>
 ;;         David Bremner <david@tethera.net>

+;;         Leo Gaspard <leo@gaspard.io>

 
 ;;; Code:
 
 
 ;;; 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")
 
 (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)
 
 (defcustom notmuch-draft-tags '("+draft")
 (defgroup notmuch-draft nil
   "Saving and editing drafts in Notmuch."
   :group 'notmuch)
 
 (defcustom notmuch-draft-tags '("+draft")

-  "List of tags changes to apply to a draft message when it is saved in the database.
+  "List of tag changes to apply when saving a draft message in the database.

 
 Tags starting with \"+\" (or not starting with either \"+\" or
 \"-\") in the list will be added, and tags starting with \"-\"
 
 Tags starting with \"+\" (or not starting with either \"+\" or
 \"-\") in the list will be added, and tags starting with \"-\"


@@ -73,9 +81,11 @@ postponing and resuming a message."
   :group 'notmuch-send)
 
 (defcustom notmuch-draft-save-plaintext 'ask
   :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)
   :type '(radio
          (const :tag "Never" nil)
          (const :tag "Ask every time" ask)


@@ -83,13 +93,14 @@ postponing and resuming a message."
   :group 'notmuch-draft
   :group 'notmuch-crypto)
 
   :group 'notmuch-draft
   :group 'notmuch-crypto)
 

+;;; Internal
+

 (defvar notmuch-draft-encryption-tag-regex
   "<#\\(part encrypt\\|secure.*mode=.*encrypt>\\)"
 (defvar notmuch-draft-encryption-tag-regex
   "<#\\(part encrypt\\|secure.*mode=.*encrypt>\\)"

-  "Regular expression matching mml tags indicating encryption of part or message")
+  "Regular expression matching mml tags indicating encryption of part or message.")

 
 

-(defvar notmuch-draft-id nil
-  "Message-id of the most recent saved draft of this message")
-(make-variable-buffer-local 'notmuch-draft-id)
+(defvar-local notmuch-draft-id nil
+  "Message-id of the most recent saved draft of this message.")

 
 (defun notmuch-draft--mark-deleted ()
   "Tag the last saved draft deleted.
 
 (defun notmuch-draft--mark-deleted ()
   "Tag the last saved draft deleted.


@@ -99,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 ()
     (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)
   (save-excursion
     ;; First we deal with any secure tag separately.
     (message-goto-body)


@@ -120,7 +131,7 @@ Used when a new version is saved, or the message is sent."
          (insert "!"))))))
 
 (defun notmuch-draft-unquote-some-mml ()
          (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 "<#!+/?\\("
   (save-excursion
     (when notmuch-draft-quoted-tags
       (let ((re (concat "<#!+/?\\("


@@ -134,43 +145,47 @@ Used when a new version is saved, or the message is sent."
     (let (secure-tag)
       (save-restriction
        (message-narrow-to-headers)
     (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 ()
        (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)
   (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 ()
 
 (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."
 
 `notmuch-draft-save-plaintext' controls the behaviour."

-  (case notmuch-draft-save-plaintext
-       ((ask)
-        (unless (yes-or-no-p "(Customize `notmuch-draft-save-plaintext' to avoid this warning)
+  (cl-case notmuch-draft-save-plaintext
+    ((ask)
+     (unless (yes-or-no-p
+             "(Customize `notmuch-draft-save-plaintext' to avoid this warning)

 This message contains mml tags that suggest it is intended to be encrypted.
 Really save and index an unencrypted copy? ")
 This message contains mml tags that suggest it is intended to be encrypted.
 Really save and index an unencrypted copy? ")

-          (error "Save aborted")))
-       ((nil)
-        (error "Refusing to save draft with encryption tags (see `notmuch-draft-save-plaintext')"))
-       ((t)
-        (ignore))))
+       (error "Save aborted")))
+    ((nil)
+     (error "Refusing to save draft with encryption tags (see `%s')"
+           'notmuch-draft-save-plaintext))
+    ((t)
+     (ignore))))

 
 (defun notmuch-draft--make-message-id ()
   ;; message-make-message-id gives the id inside a "<" ">" pair,
   ;; but notmuch doesn't want that form, so remove them.
   (concat "draft-" (substring (message-make-message-id) 1 -1)))
 
 
 (defun notmuch-draft--make-message-id ()
   ;; message-make-message-id gives the id inside a "<" ">" pair,
   ;; 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
 (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)
 applied to newly inserted messages)."
   (interactive)
   (when (notmuch-draft--has-encryption-tag)


@@ -181,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
      ;; 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.
      ;; 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.


@@ -190,19 +205,21 @@ applied to newly inserted messages)."
        (message-remove-header "Message-ID")
        (message-add-header (concat "Message-ID: <" id ">")))
       (t
        (message-remove-header "Message-ID")
        (message-add-header (concat "Message-ID: <" id ">")))
       (t

-       (message "You have customized emacs so Message-ID is not a deletable header, so not changing it")
+       (message "You have customized emacs so Message-ID is not a %s"
+               "deletable header, so not changing it")

        (setq id nil)))
      (cond
       ((member 'Date message-deletable-headers)
        (message-remove-header "Date")
        (message-add-header (concat "Date: " (message-make-date))))
       (t
        (setq id nil)))
      (cond
       ((member 'Date message-deletable-headers)
        (message-remove-header "Date")
        (message-add-header (concat "Date: " (message-make-date))))
       (t

-       (message "You have customized emacs so Date is not a deletable header, so not changing it")))
+       (message "You have customized emacs so Date is not a deletable %s"
+               "header, so not changing it")))

      (message-add-header "X-Notmuch-Emacs-Draft: True")
      (notmuch-draft-quote-some-mml)
      (notmuch-maildir-setup-message-for-saving)
      (notmuch-maildir-notmuch-insert-current-buffer
      (message-add-header "X-Notmuch-Emacs-Draft: True")
      (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
     ;; 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


@@ -221,16 +238,18 @@ applied to newly inserted messages)."
 
 (defun notmuch-draft-resume (id)
   "Resume editing of message with id ID."
 
 (defun notmuch-draft-resume (id)
   "Resume editing of message with id ID."

-  (let* ((tags (process-lines notmuch-command "search" "--output=tags"
+  ;; Used by command `notmuch-show-resume-message'.
+  (let* ((tags (notmuch--process-lines notmuch-command "search" "--output=tags"

                              "--exclude=false" id))
         (draft (equal tags (notmuch-update-tags tags notmuch-draft-tags))))
     (when (or draft
                              "--exclude=false" id))
         (draft (equal tags (notmuch-update-tags tags notmuch-draft-tags))))
     (when (or draft

-             (yes-or-no-p "Message does not appear to be a draft: really resume? "))
-      (switch-to-buffer (get-buffer-create (concat "*notmuch-draft-" id "*")))
+             (yes-or-no-p "Message does not appear to be a draft: edit as new? "))
+      (pop-to-buffer-same-window
+       (get-buffer-create (concat "*notmuch-draft-" id "*")))

       (setq buffer-read-only nil)
       (erase-buffer)
       (let ((coding-system-for-read 'no-conversion))
       (setq buffer-read-only nil)
       (erase-buffer)
       (let ((coding-system-for-read 'no-conversion))

-       (call-process notmuch-command nil t nil "show" "--format=raw" id))
+       (notmuch--call-process notmuch-command nil t nil "show" "--format=raw" id))

       (mime-to-mml)
       (goto-char (point-min))
       (when (re-search-forward "^$" nil t)
       (mime-to-mml)
       (goto-char (point-min))
       (when (re-search-forward "^$" nil t)


@@ -244,6 +263,7 @@ applied to newly inserted messages)."
          (message-remove-header "Message-ID"))
        (when (member 'Date message-deletable-headers)
          (message-remove-header "Date"))
          (message-remove-header "Message-ID"))
        (when (member 'Date message-deletable-headers)
          (message-remove-header "Date"))

+       (unless draft (notmuch-fcc-header-setup))

        ;; The X-Notmuch-Emacs-Draft header is a more reliable
        ;; indication of whether the message really is a draft.
        (setq draft (> (message-remove-header "X-Notmuch-Emacs-Draft") 0)))
        ;; The X-Notmuch-Emacs-Draft header is a more reliable
        ;; indication of whether the message really is a draft.
        (setq draft (> (message-remove-header "X-Notmuch-Emacs-Draft") 0)))


@@ -256,12 +276,12 @@ applied to newly inserted messages)."
       ;; If the resumed message was a draft then set the draft
       ;; message-id so that we can delete the current saved draft if the
       ;; message is resaved or sent.
       ;; If the resumed message was a draft then set the draft
       ;; message-id so that we can delete the current saved draft if the
       ;; message is resaved or sent.

-      (setq notmuch-draft-id (when draft id)))))
+      (setq notmuch-draft-id (and draft id)))))

 
 

+;;; _

 
 (add-hook 'message-send-hook 'notmuch-draft--mark-deleted)
 
 
 (add-hook 'message-send-hook 'notmuch-draft--mark-deleted)
 

-

 (provide 'notmuch-draft)
 
 ;;; notmuch-draft.el ends here
 (provide 'notmuch-draft)
 
 ;;; notmuch-draft.el ends here