Sync up with the latest semi-1_13 branch.
[elisp/semi.git] / mime-mc.el
index c645323..43786aa 100644 (file)
    (function (lambda (elem) (apply 'autoload elem)))
    '(
      (mc-gpg-debug-print       "mc-gpg")
+
      (mc-gpg-encrypt-region    "mc-gpg")
+     (mc-gpg-fetch-key         "mc-gpg")
      (mc-gpg-lookup-key                "mc-gpg")
+     (mc-gpg-sign-region       "mc-gpg")
+
      (mc-pgp50-encrypt-region  "mc-pgp5")
+     (mc-pgp50-fetch-key       "mc-pgp5")
      (mc-pgp50-lookup-key      "mc-pgp5")
+     (mc-pgp50-sign-region     "mc-pgp5")
+
      (mc-pgp-encrypt-region    "mc-pgp")
+     (mc-pgp-fetch-key         "mc-pgp")
      (mc-pgp-lookup-key                "mc-pgp")
+     (mc-pgp-sign-region       "mc-pgp")
+
      (mc-snarf-keys            "mc-toplev")
      )))
 
+(defgroup mime-mc nil
+  "Mailcrypt interface for SEMI."
+  :prefix "mime-mc-"
+  :group 'mime)
+
 (defcustom mime-mc-shell-file-name "/bin/sh"
   "File name to load inferior shells from.  Bourne shell or its equivalent
 \(not tcsh) is needed for \"2>\"."
-  :group 'mime
+  :group 'mime-mc
   :type 'file)
 
+(defcustom mime-mc-shell-command-switch "-c"
+  "Switch used to have the shell execute its command line argument."
+  :group 'mime-mc
+  :type 'string)
+
 (defcustom mime-mc-omit-micalg nil
   "Non-nil value means to omit the micalg parameter for multipart/signed.
 See draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME) for more information."
-  :group 'mime
+  :group 'mime-mc
   :type 'boolean)
 
 (defcustom mime-mc-comment-alist
@@ -79,17 +99,34 @@ See draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME) for more information."
          (cons 'pgp string)))
   "Alist of the schemes and strings of the comment field to appear in ASCII
 armor output."
-  :group 'mime
+  :group 'mime-mc
   :type '(repeat (cons :format "%v"
                       (choice (choice-item :tag "GnuPG" gpg)
                               (choice-item :tag "PGP 5.0i" pgp50)
                               (choice-item :tag "PGP 2.6" pgp))
                       (string :tag "Comment"))))
 
+(defvar mime-mc-symbol-format-alist
+  '((comment           . "mc-%s-comment")
+    (fetch-key         . "mc-%s-fetch-key")
+    (insert-key                . "mc-%s-insert-public-key")
+    (mime-encrypt      . "mime-mc-%s-encrypt-region")
+    (mime-sign         . "mime-mc-%s-sign-region")
+    (scheme            . "mc-scheme-%s")
+    (traditional-sign  . "mc-%s-sign-region")
+    )
+  "Alist of service names and corresponding format strings.")
+
+(defmacro mime-mc-symbol (service)
+  (` (intern
+      (format (cdr (assq (, service) mime-mc-symbol-format-alist))
+             pgp-version))))
+
 (defmacro mime-mc-comment ()
   "Return a string of the comment field."
   '(or (cdr (assq pgp-version mime-mc-comment-alist))
-       (symbol-value (intern (format "mc-%s-comment" pgp-version)))))
+       (symbol-value (mime-mc-symbol 'comment))
+       ))
 
 
 ;;; @ Internal variable
@@ -165,51 +202,68 @@ VERSION should be a string or a symbol."
              )))
        (point-max)))))
 
-(defun mime-mc-insert-public-key (&optional userid)
-  (let ((not-loaded (not (fboundp (intern (format "mc-%s-insert-public-key"
-                                                 pgp-version)))))
-       (comment (mime-mc-comment))
-       (scheme (intern (format "mc-scheme-%s" pgp-version))))
-    (cond ((eq 'gpg pgp-version)
-          (if not-loaded
-              (load "mc-gpg")
-            )
-          (let ((mc-gpg-comment (if comment "DUMMY")))
-            (mc-insert-public-key userid scheme))
-          )
-         ((eq 'pgp50 pgp-version)
-          (if not-loaded
-              (load "mc-pgp5")
-            )
-          (let ((mc-pgp50-comment (if comment "DUMMY")))
-            (mc-insert-public-key userid scheme))
-          )
-         (t
-          (if not-loaded
-              (load "mc-pgp")
-            )
-          (let ((mc-pgp-comment (if comment "DUMMY")))
-            (mc-insert-public-key userid scheme))
-          ))
-    (if comment
-       (mime-mc-replace-comment-field comment)
-      )))
-
 (defun mime-mc-verify ()
-  (let ((mc-default-scheme (intern (format "mc-scheme-%s" pgp-version))))
+  "Verify a message in the current buffer. Exact behavior depends on
+current major mode."
+  (let ((mc-default-scheme (mime-mc-symbol 'scheme)))
     (mc-verify)
     ))
 
 (defun mime-mc-decrypt ()
-  (let ((mc-default-scheme (intern (format "mc-scheme-%s" pgp-version))))
+  "Decrypt a message in the current buffer. Exact behavior depends on
+current major mode."
+  (let ((mc-default-scheme (mime-mc-symbol 'scheme)))
     (mc-decrypt)
     ))
 
+(defun mime-mc-fetch-key (&optional id)
+  "Attempt to fetch a key for addition to PGP or GnuPG keyring.
+Interactively, prompt for string matching key to fetch.
+
+Non-interactively, ID must be a pair.  The CAR must be a bare Email
+address and the CDR a keyID (with \"0x\" prefix).  Either, but not
+both, may be nil.
+
+Return t if we think we were successful; nil otherwise.  Note that nil
+is not necessarily an error, since we may have merely fired off an Email
+request for the key."
+  (funcall (mime-mc-symbol 'fetch-key) id)
+  )
+
 (defun mime-mc-snarf-keys ()
-  (let ((mc-default-scheme (intern (format "mc-scheme-%s" pgp-version))))
+  "Add all public keys in the buffer to your keyring."
+  (let ((mc-default-scheme (mime-mc-symbol 'scheme)))
     (mc-snarf-keys)
     ))
 
+(defun mime-mc-sign-region (start end &optional id unclear boundary)
+  (funcall (mime-mc-symbol 'mime-sign) start end id unclear boundary)
+  )
+
+(defun mime-mc-traditional-sign-region (start end &optional id unclear)
+  (funcall (mime-mc-symbol 'traditional-sign) start end id unclear)
+  )
+
+(defun mime-mc-encrypt-region (recipients start end &optional id sign)
+  (funcall (mime-mc-symbol 'mime-encrypt) recipients start end id sign)
+  )
+
+(defun mime-mc-insert-public-key (&optional userid)
+  "Insert your public key at point."
+  (or (fboundp (mime-mc-symbol 'insert-key))
+      (load (concat "mc-" (cdr (assq pgp-version '((gpg . "gpg")
+                                                  (pgp50 . "pgp5")
+                                                  (pgp . "pgp")))))))
+  (let ((mc-comment (mime-mc-symbol 'comment))
+       (comment (mime-mc-comment))
+       (scheme (mime-mc-symbol 'scheme)))
+    (eval (` (let (((, mc-comment) (if (, comment) "DUMMY")))
+              (mc-insert-public-key (, userid) (quote (, scheme)))
+              )))
+    (if comment
+       (mime-mc-replace-comment-field comment)
+      )))
+
 
 ;;; @ GnuPG functions
 ;;;
@@ -222,6 +276,7 @@ optional argument COMMENT if it is specified."
   (let ((obuf (current-buffer))
        (process-connection-type nil)
        (shell-file-name mime-mc-shell-file-name)
+       (shell-command-switch mime-mc-shell-command-switch)
        ; other local vars
        mybuf 
        stderr-tempfilename stderr-buf
@@ -238,9 +293,8 @@ optional argument COMMENT if it is specified."
          (make-temp-name (expand-file-name "mailcrypt-gpg-status-"
                                            mc-temp-directory)))
     (unwind-protect
-       (progn
-         ;; Returns non-nil if success, otherwise nil with error message.
-         (catch 'mime-mc-gpg-process-region-done
+       (catch ;; Returns non-nil if success, otherwise nil with error message.
+           'mime-mc-gpg-process-region-done
 
          ;; get output places ready
          (setq mybuf (get-buffer-create " *mailcrypt stdout temp"))
@@ -375,7 +429,7 @@ Content-Transfer-Encoding: 7bit
 
          ;; return result
          (cdr parser-result)
-         ))
+         )
       ;; cleanup forms
       (if (and proc (eq 'run (process-status proc)))
          ;; it is still running. kill it.
@@ -448,6 +502,7 @@ Content-Transfer-Encoding: 7bit
                            )
                      (set-alist 'mime-mc-micalg-alist (cdr key) micalg)
                      )
+                 (or mc-passwd-timeout (mc-deactivate-passwd t))
                  ))
            )))
     (if (or mime-mc-omit-micalg micalg)
@@ -503,14 +558,14 @@ optional argument COMMENT if it is specified."
   (let ((obuf (current-buffer))
        (process-connection-type nil)
        (shell-file-name mime-mc-shell-file-name)
+       (shell-command-switch mime-mc-shell-command-switch)
        mybuf result rgn proc results)
     (if comment
        (setq args (cons "+comment=DUMMY" args))
       )
     (unwind-protect
-       (progn
-         ;; Returns non-nil if success, otherwise nil with error message.
-         (catch 'mime-mc-pgp50-process-region-done
+       (catch ;; Returns non-nil if success, otherwise nil with error message.
+           'mime-mc-pgp50-process-region-done
 
          (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp")))
          (set-buffer mybuf)
@@ -576,7 +631,7 @@ Content-Transfer-Encoding: 7bit
                (delete-region (car rgn) (cdr rgn))))
 
          ;; Return nil on failure and exit code on success
-         (if rgn result nil)))
+         (if rgn result nil))
 
       ;; Cleanup even on nonlocal exit
       (if (and proc (eq 'run (process-status proc)))
@@ -736,6 +791,7 @@ Content-Transfer-Encoding: 7bit
                (setq micalg (downcase (or (std11-fetch-field "Hash") "md5")))
                (set-alist 'mime-mc-micalg-alist (cdr key) micalg)
                )
+           (or mc-passwd-timeout (mc-deactivate-passwd t))
            ))
       )
     (if (or mime-mc-omit-micalg micalg)