[elpa] externals/autocrypt cb40022cba 23/94: refactored message specific code into autocrypt-compose-* functions

[ELPA Syncer]

branch: externals/autocrypt
commit cb40022cba2a9a9f677ba8fd36ffde4d2477f91b
Author: Philip K <philip@warpmail.net>
Commit: Philip K <philip@warpmail.net>

    refactored message specific code into autocrypt-compose-* functions
---
 autocrypt-message.el | 98 ++++++++++++++--------------------------------------
 autocrypt.el         | 72 +++++++++++++++++++++++++++++++++++++-
 2 files changed, 96 insertions(+), 74 deletions(-)

diff --git a/autocrypt-message.el b/autocrypt-message.el
index 41926caa8d..012d9d1f12 100644
--- a/autocrypt-message.el
+++ b/autocrypt-message.el
@@ -28,82 +28,34 @@
 ;;;###autoload
 (defun autocrypt-message-install ()
   "Install autocrypt hooks for message mode."
-  (add-hook 'message-setup-hook #'autocrypt-message-setup)
-  (add-hook 'message-send-hook #'autocrypt-message-pre-send)
-  (define-key message-mode-map (kbd "C-c RET C-a") #'autocrypt-message-setup))
+  (add-hook 'message-setup-hook #'autocrypt-compose-setup)
+  (add-hook 'message-send-hook #'autocrypt-compose-pre-send)
+  (unless (lookup-key message-mode-map (kbd "C-c RET C-a"))
+    (define-key message-mode-map (kbd "C-c RET C-a") 
#'autocrypt-message-setup)))
 
 (defun autocrypt-message-uninstall ()
   "Remove autocrypt hooks for message mode."
-  (remove-hook 'message-setup-hook #'autocrypt-message-setup)
-  (remove-hook 'message-send-hook #'autocrypt-message-pre-send)
-  (define-key message-mode-map (kbd "C-c RET C-a") nil))
-
-;; https://autocrypt.org/level1.html#key-gossip-injection-in-outbound-messages
-(defun autocrypt-message-gossip-p (recipients)
-  "Find out if the current message should have gossip headers.
-Argument RECIPIENTS is a list of addresses this message is
-addressed to."
-  (and (mml-secure-is-encrypted-p)
-       (< 1 (length recipients))
-       (cl-every
-        (lambda (rec)
-          (let ((peer (cdr (assoc rec autocrypt-peers))))
-            (and peer (not (autocrypt-peer-deactivated peer)))))
-        recipients)))
-
-(defun autocrypt-message-setup ()
-  "Check if Autocrypt is possible, and add pseudo headers."
-  (interactive)
-  (let ((recs (autocrypt-list-recipients))
-        (from (autocrypt-canonicalise (message-field-value "from"))))
-    ;; encrypt message if applicable
-    (save-excursion
-      (cl-case (autocrypt-recommendation from recs)
-        (encrypt
-         (mml-secure-message-sign-encrypt "pgpmime"))
-        (available
-         (message-add-header "Do-Autocrypt: no"))
-        (discourage
-         (message-add-header "Do-Discouraged-Autocrypt: no"))))))
-
-(defun autocrypt-message-pre-send ()
-  "Insert Autocrypt headers before sending a message.
-
-Will handle and remove \"Do-(Discourage-)Autocrypt\" if found."
-  (let* ((recs (autocrypt-list-recipients))
-         (from (autocrypt-canonicalise (message-field-value "from"))))
-    ;; encrypt message if applicable
-    (when (eq (autocrypt-recommendation from recs) 'encrypt)
-      (mml-secure-message-sign-encrypt "pgpmime"))
-    ;; check for manual autocrypt confirmations
-    (let ((do-autocrypt (message-fetch-field "Do-Autocrypt"))
-          (ddo-autocrypt (message-fetch-field "Do-Discouraged-Autocrypt"))
-          (query "Are you sure you want to use Autocrypt, even though it is 
discouraged?"))
-      (when (and (not (mml-secure-is-encrypted-p))
-                 (or (and do-autocrypt
-                          (string= (downcase do-autocrypt) "yes"))
-                     (and ddo-autocrypt
-                          (string= (downcase ddo-autocrypt) "yes")
-                          (yes-or-no-p query))))
-        (mml-secure-message-sign-encrypt "pgpmime")))
-    (message-remove-header "Do-Autocrypt")
-    (message-remove-header "Do-Discouraged-Autocrypt")
-    ;; insert gossip data
-    (when (autocrypt-message-gossip-p recs)
-      (let ((buf (generate-new-buffer " *autocrypt gossip*")))
-        (with-current-buffer buf
-          (dolist (addr (autocrypt-list-recipients))
-            (let ((header (autocrypt-generate-header addr t)))
-              (insert "Autocrypt-Gossip: " header "\n"))))
-        (mml-attach-buffer buf)
-        (mml-secure-part "pgpmime")
-        (add-hook 'message-send-hook
-                  (lambda () (kill-buffer buf))
-                  nil t)))
-    ;; insert autocrypt header
-    (let ((header (and from (autocrypt-generate-header from))))
-      (when header
-        (message-add-header (concat "Autocrypt: " header))))))
+  (remove-hook 'message-setup-hook #'autocrypt-compose-setup)
+  (remove-hook 'message-send-hook #'autocrypt-compose-pre-send)
+  (when (eq (lookup-key message-mode-map (kbd "C-c RET C-a"))
+            #'autocrypt-message-setup)
+    (define-key message-mode-map (kbd "C-c RET C-a") nil)))
+
+(defun autocrypt-message-add-header (key val)
+  "Insert header with key KEY and value VAL into message head."
+  (message-add-header (concat key ": " val)))
+
+(defun autocrypt-message-sign-encrypt ()
+  "Sign and encrypt message."
+  (mml-secure-message-sign-encrypt "pgpmime"))
+
+(defun autocrypt-message-secure-attach (payload)
+  "Attach and encrypt buffer PAYLOAD."
+  (mml-attach-buffer payload)
+  (mml-secure-part "pgpmime")
+  (add-hook 'message-send-hook
+            (lambda () (kill-buffer payload))
+            nil t))
 
 (provide 'autocrypt-message)
 
diff --git a/autocrypt.el b/autocrypt.el
index 713e27264f..112e4e1f6d 100644
--- a/autocrypt.el
+++ b/autocrypt.el
@@ -121,7 +121,12 @@ Every member of this list has to be an instance of the
     (message
      :install autocrypt-message-install
      :uninstall autocrypt-message-uninstall
-     :header message-fetch-field))
+     :header message-fetch-field
+     :add-header autocrypt-message-add-header
+     :remove-header message-remove-header
+     :sign-encrypt autocrypt-message-sign-encrypt
+     :secure-attach autocrypt-message-secure-attach
+     :encrypted-p mml-secure-is-encrypted-p))
   "Alist for all MUA specific functions.
 
 The value of each record is a plist. The value of each property
@@ -409,6 +414,71 @@ preference (\"prefer-encrypt\")."
         (and (< (buffer-size) (* 10 1024))
              (buffer-string))))))
 
+(defun autocrypt-gossip-p (recipients)
+  "Find out if the current message should have gossip headers.
+Argument RECIPIENTS is a list of addresses this message is
+addressed to."
+  (and (autocrypt-mua-call :encrypted-p)
+       (< 1 (length recipients))
+       (cl-every
+        (lambda (rec)
+          (let ((peer (cdr (assoc rec autocrypt-peers))))
+            (and peer (not (autocrypt-peer-deactivated peer)))))
+        recipients)))
+
+(defun autocrypt-compose-setup ()
+  "Check if Autocrypt is possible, and add pseudo headers."
+  (interactive)
+  (let ((recs (autocrypt-list-recipients))
+        (can-remove (autocrypt-mua-func :remove-header))
+        (from (autocrypt-canonicalise (autocrypt-mua-call :header "From"))))
+    ;; encrypt message if applicable
+    (save-excursion
+      (cl-case (autocrypt-recommendation from recs)
+        (encrypt
+         (autocrypt-mua-call :sign-encrypt))
+        (available
+         (when can-remove
+           (autocrypt-mua-call :add-header "Do-Autocrypt" "no")))
+        (discourage
+         (when can-remove
+           (autocrypt-mua-call :add-header "Do-Discouraged-Autocrypt" 
"no")))))))
+
+(defun autocrypt-compose-pre-send ()
+  "Insert Autocrypt headers before sending a message.
+
+Will handle and remove \"Do-(Discourage-)Autocrypt\" if found."
+  (let* ((recs (autocrypt-list-recipients))
+         (from (autocrypt-canonicalise (autocrypt-mua-call :header "From"))))
+    ;; encrypt message if applicable
+    (when (eq (autocrypt-recommendation from recs) 'encrypt)
+      (autocrypt-mua-call :sign-encrypt))
+    ;; check for manual autocrypt confirmations
+    (let ((do-autocrypt (autocrypt-mua-call :header "Do-Autocrypt"))
+          (ddo-autocrypt (autocrypt-mua-call :header 
"Do-Discouraged-Autocrypt"))
+          (query "Are you sure you want to use Autocrypt, even though it is 
discouraged?"))
+      (when (and (not (autocrypt-mua-call :encrypted-p))
+                 (or (and do-autocrypt
+                          (string= (downcase do-autocrypt) "yes"))
+                     (and ddo-autocrypt
+                          (string= (downcase ddo-autocrypt) "yes")
+                          (yes-or-no-p query))))
+        (autocrypt-mua-call :sign-encrypt)))
+    (autocrypt-mua-call :remove-header "Do-Autocrypt")
+    (autocrypt-mua-call :remove-header "Do-Discouraged-Autocrypt")
+    ;; insert gossip data
+    (when (autocrypt-gossip-p recs)
+      (let ((payload (generate-new-buffer " *autocrypt gossip*")))
+        (with-current-buffer payload
+          (dolist (addr (autocrypt-list-recipients))
+            (let ((header (autocrypt-generate-header addr t)))
+              (insert "Autocrypt-Gossip: " header "\n"))))
+        (autocrypt-mua-call :secure-attach payload)))
+    ;; insert autocrypt header
+    (let ((header (and from (autocrypt-generate-header from))))
+      (when header
+        (autocrypt-mua-call :add-header "Autocrypt" header)))))
+
 (defun autocrypt-create-account ()
   "Create a GPG key for Autocrypt."
   (interactive)