5 files changed, 134 insertions(+), 156 deletions(-)

M autocrypt-gnus.el
M autocrypt-message.el
M autocrypt-mu4e.el
M autocrypt-rmail.el
M autocrypt.el

@@ 23,13 23,19 @@
 ;;; Code:
 
 (require 'gnus)
+(require 'autocrypt)
 
-(cl-defmethod autocrypt-mode-hooks ((_mode (eql gnus)))
-  "Return the hook to install autocrypt."
-  '(gnus-article-prepare-hook))
+;;;###autoload
+(defun autocrypt-gnus--install ()
+  "Prepare autocrypt for Gnus."
+  (add-hook 'gnus-article-prepare-hook #'autocrypt-process-header nil t))
 
-(cl-defmethod autocrypt-get-header ((_mode (eql gnus)) header)
-  "Return the value for HEADER."
+(defun autocrypt-gnus--uninstall ()
+  "Undo `autocrypt-gnus--install'."
+  (remove-hook 'gnus-article-prepare-hook #'autocrypt-process-header t))
+
+(defun autocrypt-gnus--get-header (header)
+  "Return value for HEADER from current message."
   (gnus-fetch-original-field header))
 
 (provide 'autocrypt-gnus)

@@ 23,35 23,38 @@
 ;;; Code:
 
 (require 'message)
+(require 'autocrypt)
 
-(cl-defmethod autocrypt-install ((_mode (eql message)))
-  "Install autocrypt hooks for message mode."
-  (add-hook 'message-setup-hook #'autocrypt-compose-setup)
-  (add-hook 'message-send-hook #'autocrypt-compose-pre-send)
+;;;###autoload
+(defun autocrypt-message--install ()
+  "Prepare autocrypt for message buffers."
+  (add-hook 'message-setup-hook #'autocrypt-compose-setup nil t)
+  (add-hook 'message-send-hook #'autocrypt-compose-pre-send nil t)
   (unless (lookup-key message-mode-map (kbd "C-c RET C-a"))
-    (define-key message-mode-map (kbd "C-c RET C-a") #'autocrypt-compose-setup)))
+    (local-set-key (kbd "C-c RET C-a") #'autocrypt-compose-setup)))
 
-(defun autocrypt-message-uninstall ()
+(defun autocrypt-message--uninstall ()
   "Remove autocrypt hooks for message mode."
-  (remove-hook 'message-setup-hook #'autocrypt-compose-setup)
-  (remove-hook 'message-send-hook #'autocrypt-compose-pre-send)
+  (remove-hook 'message-setup-hook #'autocrypt-compose-setup t)
+  (remove-hook 'message-send-hook #'autocrypt-compose-pre-send t)
   (when (eq (lookup-key message-mode-map (kbd "C-c RET C-a"))
             #'autocrypt-compose-setup)
-    (define-key message-mode-map (kbd "C-c RET C-a") nil)))
+    (local-set-key (kbd "C-c RET C-a") nil)))
 
-(cl-defmethod autocrypt-get-header ((_ (eql message)) header)
+(defun autocrypt-message--get-header (header)
   "Return the value for HEADER."
   (message-fetch-field header))
 
-(cl-defmethod autocrypt-add-header ((_mode (eql message)) header value)
+(defun autocrypt-message--add-header (header value)
   "Insert HEADER with VALUE into the message head."
-  (message-add-header (concat header ": " value)))
+  (with-silent-modifications
+    (message-add-header (concat header ": " value))))
 
-(cl-defmethod autocrypt-sign-encrypt ((_mode (eql message)))
+(defun autocrypt-message--sign-encrypt ()
   "Sign and encrypt message."
   (mml-secure-message-sign-encrypt "pgpmime"))
 
-(cl-defmethod autocrypt-sign-secure-attach ((_mode (eql message)) payload)
+(defun autocrypt-message--sign-secure-attach (payload)
   "Attach and encrypt buffer PAYLOAD."
   (mml-attach-buffer payload)
   (mml-secure-part "pgpmime")


@@ 59,7 62,7 @@
             (lambda () (kill-buffer payload))
             nil t))
 
-(cl-defmethod autocrypt-encrypted-p ((_mode (eql message)))
+(defun autocrypt--message-encrypted-p ()
   "Check if the current message is encrypted."
   (mml-secure-is-encrypted-p))
 

@@ 22,19 22,22 @@
 
 ;;; Code:
 
-(declare-function mu4e-view-raw-message "mu4e" () )
+(require 'autocrypt)
 
-(cl-defmethod autocrypt-install ((_mode (eql mu4e)))
+(declare-function mu4e-view-raw-message "mu4e" ())
+
+;;;###autocrypt
+(defun autocrypt-mu4e--install ()
   "Install autocrypt hooks for mu4e."
-  (add-hook 'mu4e-view-mode-hook #'autocrypt-process-header)
-  (add-hook 'mu4e-compose-mode-hook #'autocrypt-compose-setup))
+  (add-hook 'mu4e-view-mode-hook #'autocrypt-process-header nil t)
+  (add-hook 'mu4e-compose-mode-hook #'autocrypt-compose-setup nil t))
 
-(cl-defmethod autocrypt-uninstall ((_mode (eql mu4e)))
+(defun autocrypt-mu4e--uninstall ()
   "Remove autocrypt hooks for mu4e."
   (remove-hook 'mu4e-view-mode-hook #'autocrypt-process-header)
   (remove-hook 'mu4e-compose-mode-hook #'autocrypt-compose-setup))
 
-(cl-defmethod autocrypt-get-header ((_mode (eql mu4e)) header)
+(defun autocrypt-mu4e--get-header (header)
   "Ask mu4e to return HEADER."
   (save-window-excursion
     (with-current-buffer (mu4e-view-raw-message)

@@ 22,19 22,22 @@
 
 ;;; Code:
 
+(require 'autocrypt)
 (require 'rmail)
 
-;;; NOTE: rmail does not use derived modes, so these methods match the
-;;;       exact mode.
+(defun autocrypt-rmail--install ()
+  "Install autocrypt functions into the current rmail buffer."
+  (add-hook 'rmail-show-message-hook #'autocrypt-process-header nil t))
 
-(cl-defmethod autocrypt-mode-hooks ((_mode (eql rmail-mode)))
-  "Return the hook to install autocrypt."
-  '(rmail-show-message-hook))
+(defun autocrypt-rmail--uninstall ()
+  "Remove autocrypt from current buffer."
+  (add-hook 'rmail-show-message-hook #'autocrypt-process-header t))
 
-(cl-defmethod autocrypt-get-header ((_mode (eql rmail-mode)) header)
+(defun autocrypt-rmail--get-header (header)
   "Ask Rmail to return HEADER."
-  (rmail-apply-in-message rmail-current-message
-                          (lambda () (mail-fetch-field header))))
+  (rmail-apply-in-message
+   rmail-current-message
+   (lambda () (mail-fetch-field header))))
 
 (provide 'autocrypt-rmail)
 

@@ 26,7 26,6 @@
 ;;; Code:
 
 (require 'cl-lib)
-(require 'cl-generic)
 (eval-when-compile (require 'rx))
 (require 'epg)
 (require 'ietf-drums)


@@ 35,7 34,7 @@
 ;;; CUSTOMIZABLES
 
 (defgroup autocrypt nil
-  "Autocrypt protocol implementation for Emacs MUAs"
+  "Autocrypt protocol implementation for Emacs MUAs."
   :tag "Autocrypt"
   :group 'mail
   :link '(url-link "https://autocrypt.org/")


@@ 72,18 71,6 @@ process \"Autocrypt-Gossip\" headers when received."
 
 ;;; INTERNAL STATE
 
-(defvar autocrypt-backends
-  '(((mu4e-main-mode mu4e-view-mode) mu4e autocrypt-mu4e)
-    ((gnus-mode) gnus autocrypt-gnus)
-    ((rmail-mode) rmail autocrypt-rmail)
-    ((message-mode) message autocrypt-message))
-  "Alist of supported backends.
-Each entry consists of a list of major modes, the method
-specializer and optionally the feature that has to be loaded.")
-
-(defvar-local autocrypt-current-backend nil
-  "Currently active backend.")
-
 (defvar autocrypt-accounts nil
   "Alist of supported Autocrypt accounts.
 


@@ 112,90 99,74 @@ Every member of this list has to be an instance of the
 
 ;;; MUA TRANSLATION LAYER
 
-(cl-defgeneric autocrypt-mode-hooks (mode)
-  "Return a list of hooks for MODE that process headers.")
+(defvar autocrypt-backends
+  '(((mu4e-main-mode mu4e-view-mode) . mu4e)
+    ((gnus-mode) . gnus)
+    ((rmail-mode) . rmail)
+    ((message-mode) . message))
+  "Alist of known backends.
+Each entry has the form (MODES . NAME), where MODES is a list of
+major modes where the backend applies, and NAME is a symbol to
+designate this backend.")
+
+(defvar-local autocrypt-backend-function nil
+  "Override the function called by `autocrypt-find-function'.
+This function must accept one argument, a symbol designating the
+command (`install', `get-header', ...) and returns a function
+with the right signature.")
+
+(defun autocrypt-find-function (command)
+  "Return a function for handling COMMAND."
+  (if autocrypt-backend-function
+      (funcall autocrypt-backend-function command)
+    (catch 'ok
+      (dolist (backend-data autocrypt-backends)
+        (let ((modes (car backend-data))
+              (backend (cdr backend-data)))
+          (when (apply #'derived-mode-p modes)
+            (dolist (fn (mapcar
+                         #'intern
+                         (list (format "autocrypt-%S--%S" backend command)
+                               (format "%S-autocrypt-%S" backend command)
+                               (format "%S--autocrypt-%S" backend command))))
+              (when (and fn (fboundp fn))
+                (throw 'ok fn))))))
+      (error "No autocrypt backend found"))))
+
+(defun autocrypt-make-function (command signature)
+  "Return a function to handle COMMAND.
+The advertised calling convention is set to SIGNATURE."
+  (let ((f (lambda (&rest args)
+             (apply (autocrypt-find-function command) args))))
+    (set-advertised-calling-convention f signature nil)
+    f))
+
+(defalias 'autocrypt-install (autocrypt-make-function 'install '())
+  "Install necessary autocrypt functions into the MUA.")
+
+(defalias 'autocrypt-uninstall (autocrypt-make-function 'uninstall '())
+  "Remove all modifications by autocrypt.")
+
+(defalias 'autocrypt-get-header (autocrypt-make-function 'get-header '(header))
+  "Return the value of HEADER.")
 
-(cl-defgeneric autocrypt-install (mode)
-  "Install autocrypt for MODE."
-  (dolist (hook (autocrypt-mode-hooks mode))
-    (add-hook hook #'autocrypt-process-header)))
+(defalias 'autocrypt-add-header (autocrypt-make-function 'add-header '(header value))
+  "Insert HEADER with VALUE into message.")
 
-(defun autocrypt--install ()
-  "Install necessary autocrypt functions into the MUA."
-  (cl-assert autocrypt-current-backend)
-  (autocrypt-install autocrypt-current-backend))
+(defalias 'autocrypt-remove-header (autocrypt-make-function 'remove-header '(header))
+  "Remove HEADER from message.")
 
-(cl-defgeneric autocrypt-uninstall (mode)
-  "Undo `autocrypt-install' for MODE."
-  (dolist (hook (autocrypt-mode-hooks mode))
-    (remove-hook hook #'autocrypt-process-header)))
+(defalias 'autocrypt-sign-encrypt (autocrypt-make-function 'sign-encrypt '())
+  "Make the message to be signed and encrypted.")
 
-(defun autocrypt--uninstall ()
-  "Remove all modifications by autocrypt."
-  (cl-assert autocrypt-current-backend)
-  (autocrypt-install autocrypt-current-backend))
+(defalias 'autocrypt-secure-attach (autocrypt-make-function 'secure-attach '(payload))
+  "Add PAYLOAD as an encrypted attachment.")
 
-(cl-defgeneric autocrypt-get-header (_mode _header)
-  "Return the value of HEADER.")
+(defalias 'autocrypt-encrypted-p (autocrypt-make-function 'encrypted-p '())
+  "Check the the current message is encrypted.")
 
-(defun autocrypt--get-header (header)
-  "Return the value of HEADER."
-  (cl-assert autocrypt-current-backend)
-  (autocrypt-get-header autocrypt-current-backend header))
-
-(cl-defgeneric autocrypt-add-header (_mode _header _value)
-  "Insert HEADER with VALUE into message."
-  'n/a)
-
-(defun autocrypt--add-header (header value)
-  "Insert HEADER with VALUE into message."
-  (cl-assert autocrypt-current-backend)
-  (autocrypt-add-header autocrypt-current-backend header value))
-
-(cl-defgeneric autocrypt-remove-header (_mode _header)
-  "Remove HEADER from message."
-  'n/a)
-
-(defun autocrypt--remove-header (header)
-  "Remove HEADER from message."
-  (cl-assert autocrypt-current-backend)
-  (autocrypt-remove-header autocrypt-current-backend header))
-
-(cl-defgeneric autocrypt-sign-encrypt (_mode)
-  "Sign and encrypt this message."
-  'n/a)
-
-(defun autocrypt--sign-encrypt ()
-  "Sign and encrypt this message."
-  (cl-assert autocrypt-current-backend)
-  (autocrypt-sign-encrypt autocrypt-current-backend))
-
-(cl-defgeneric autocrypt-secure-attach (_mode _payload)
-  "Add PAYLOAD as an encrypted attachment."
-  'n/a)
-
-(defun autocrypt--secure-attach (payload)
-  "Add PAYLOAD as an encrypted attachment."
-  (cl-assert autocrypt-current-backend)
-  (autocrypt--secure-attach autocrypt-current-backend payload))
-
-(cl-defgeneric autocrypt-encrypted-p (_mode)
-  "Check the the current message is encrypted."
-  'n/a)
-
-(defun autocrypt--encrypted-p ()
-  "Check the the current message is encrypted."
-  (cl-assert autocrypt-current-backend)
-  (autocrypt-encrypted-p autocrypt-current-backend))
-
-(cl-defgeneric autocrypt-get-part (_mode _nr)
-  "Return the NR'th part of the current message."
-  'n/a)
-
-(defun autocrypt--get-part (nr)
-  "Return the NR'th part of the current message."
-  (cl-assert autocrypt-current-backend)
-  (autocrypt-get-part autocrypt-current-backend nr))
+(defalias 'autocrypt-get-part (autocrypt-make-function 'get-part '(index))
+  "Return the INDEX'th part of the current message.")
 
 
 ;;; INTERNAL FUNCTIONS


@@ 300,7 271,7 @@ well-formed, otherwise returns just nil."
   "Return a list of all recipients to this message."
   (let (recipients)
     (dolist (header '("To" "Cc" "Reply-To"))
-      (let* ((f (autocrypt--get-header header))
+      (let* ((f (autocrypt-get-header header))
              (r (and f (mail-extract-address-components f t))))
         (setq recipients (nconc (mapcar #'cadr r) recipients))))
     (delete-dups recipients)))


@@ 311,7 282,7 @@ well-formed, otherwise returns just nil."
 
 Argument DATE contains the time value of the \"From\" tag."
   (let ((recip (autocrypt-list-recipients))
-        (root (autocrypt--get-part 0))
+        (root (autocrypt-get-part 0))
         (re (rx bol "Autocrypt-Gossip:" (* space)
                 (group (+ (or nonl (: "\n "))))
                 eol))


@@ 357,9 328,9 @@ Argument DATE contains the time value of the \"From\" tag."
 ;; https://autocrypt.org/level1.html#updating-autocrypt-peer-state
 (defun autocrypt-process-header ()
   "Update internal autocrypt state."
-  (let* ((from (autocrypt-canonicalise (autocrypt--get-header "From")))
-         (date (ietf-drums-parse-date (autocrypt--get-header "Date")))
-         (header (autocrypt--get-header "Autocrypt"))
+  (let* ((from (autocrypt-canonicalise (autocrypt-get-header "From")))
+         (date (ietf-drums-parse-date (autocrypt-get-header "Date")))
+         (header (autocrypt-get-header "Autocrypt"))
          parse addr preference keydata peer)
     (when header
       (when (setq parse (autocrypt-parse-header header))


@@ 446,7 417,7 @@ preference (\"prefer-encrypt\")."
 Argument RECIPIENTS is a list of addresses this message is
 addressed to."
   (and autocrypt-do-gossip
-       (autocrypt--encrypted-p)
+       (autocrypt-encrypted-p)
        (< 1 (length recipients))
        (cl-every
         (lambda (rec)


@@ 458,39 429,39 @@ addressed to."
   "Check if Autocrypt is possible, and add pseudo headers."
   (interactive)
   (let ((recs (autocrypt-list-recipients))
-        (from (autocrypt-canonicalise (autocrypt--get-header "From"))))
+        (from (autocrypt-canonicalise (autocrypt-get-header "From"))))
     ;; encrypt message if applicable
     (save-excursion
       (cl-case (autocrypt-recommendation from recs)
         (encrypt
-         (autocrypt--sign-encrypt))
+         (autocrypt-sign-encrypt))
         (available
-         (autocrypt--add-header "Do-Autocrypt" "no"))
+         (autocrypt-add-header "Do-Autocrypt" "no"))
         (discourage
-         (autocrypt--add-header "Do-Discouraged-Autocrypt" "no"))))))
+         (autocrypt-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--get-header "From"))))
+         (from (autocrypt-canonicalise (autocrypt-get-header "From"))))
     ;; encrypt message if applicable
     (when (eq (autocrypt-recommendation from recs) 'encrypt)
-      (autocrypt--sign-encrypt))
+      (autocrypt-sign-encrypt))
     ;; check for manual autocrypt confirmations
-    (let ((do-autocrypt (autocrypt--get-header "Do-Autocrypt"))
-          (ddo-autocrypt (autocrypt--get-header "Do-Discouraged-Autocrypt"))
+    (let ((do-autocrypt (autocrypt-get-header "Do-Autocrypt"))
+          (ddo-autocrypt (autocrypt-get-header "Do-Discouraged-Autocrypt"))
           (query "Are you sure you want to use Autocrypt, even though it is discouraged?"))
-      (when (and (not (autocrypt--encrypted-p))
+      (when (and (not (autocrypt-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--sign-encrypt)))
-    (autocrypt--remove-header "Do-Autocrypt")
-    (autocrypt--remove-header "Do-Discouraged-Autocrypt")
+        (autocrypt-sign-encrypt)))
+    (autocrypt-remove-header "Do-Autocrypt")
+    (autocrypt-remove-header "Do-Discouraged-Autocrypt")
     ;; insert gossip data
     (when (autocrypt-gossip-p recs)
       (let ((payload (generate-new-buffer " *autocrypt gossip*")))


@@ 498,11 469,11 @@ Will handle and remove \"Do-(Discourage-)Autocrypt\" if found."
           (dolist (addr (autocrypt-list-recipients))
             (let ((header (autocrypt-generate-header addr t)))
               (insert "Autocrypt-Gossip: " header "\n"))))
-        (autocrypt--secure-attach payload)))
+        (autocrypt-secure-attach payload)))
     ;; insert autocrypt header
     (let ((header (and from (autocrypt-generate-header from))))
       (when header
-        (autocrypt--add-header "Autocrypt" header)))))
+        (autocrypt-add-header "Autocrypt" header)))))
 
 ;;;###autoload
 (defun autocrypt-create-account ()


@@ 552,16 523,8 @@ Will handle and remove \"Do-(Discourage-)Autocrypt\" if found."
   (if autocrypt-mode
       (progn
         (autocrypt-load-data)
-        (catch 'found
-          (dolist (backend autocrypt-backends)
-            (when (apply #'derived-mode-p (car backend))
-              (setq autocrypt-current-backend (cadr backend))
-              (when (caddr backend)
-                (require (caddr backend)))
-              (throw 'found nil)))
-          (error "No autocrypt backend found"))
-        (autocrypt--install))
-    (autocrypt--uninstall)))
+        (autocrypt-install))
+    (autocrypt-uninstall)))
 
 (provide 'autocrypt)