* epg.el (epg-start): Insert the command-line arguments to the

debug buffer.
(epg-start-encrypt): Wait for BEGIN_ENCRYPTION.

* epa.el (epa-key): New widget.
(epa-key-widget-action): New function.
(epa-key-widget-value-create): New function.
(epa-key-widget-button-face-get): New function.
(epa-key-widget-help-echo): New function.

diff --git a/ChangeLog b/ChangeLog
index a91a40c..af8763a 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2006-04-18  Daiki Ueno  <ueno@unixuser.org>
+
+       * epg.el (epg-start): Insert the command-line arguments to the
+       debug buffer.
+       (epg-start-encrypt): Wait for BEGIN_ENCRYPTION.
+
+       * epa.el (epa-key): New widget.
+       (epa-key-widget-action): New function.
+       (epa-key-widget-value-create): New function.
+       (epa-key-widget-button-face-get): New function.
+       (epa-key-widget-help-echo): New function.
+
 2006-04-17  Daiki Ueno  <ueno@unixuser.org>
 
        * epa-file.el (epa-file-write-region): Check if START is a string.

diff --git a/epa.el b/epa.el
index 75b8934..e0c0ab1 100644 (file)
--- a/epa.el
+++ b/epa.el
@@ -81,6 +81,15 @@
   :group 'epa-faces)
 (defvar epa-string-face 'epa-string-face)
 
+(defface epa-mark-face
+  '((((class color) (background dark))
+     (:foreground "orange" :bold t))
+    (t
+     (:foreground "red" :bold t)))
+  "Face used for displaying the high validity."
+  :group 'epa-faces)
+(defvar epa-mark-face 'epa-mark-face)
+
 (defface epa-field-name-face
   '((((class color) (background dark))
      (:foreground "PaleTurquoise" :bold t))
@@ -98,26 +107,24 @@
 (defvar epa-field-body-face 'epa-field-body-face)
 
 (defcustom epa-validity-face-alist
-  '((?o . epa-validity-disabled-face)
-    (?i . epa-validity-disabled-face)
-    (?d . epa-validity-disabled-face)
-    (?r . epa-validity-disabled-face)
-    (?e . epa-validity-disabled-face)
-    (?- . epa-validity-low-face)
-    (?q . epa-validity-low-face)
-    (?n . epa-validity-low-face)
-    (?m . epa-validity-medium-face)
-    (?f . epa-validity-high-face)
-    (?u . epa-validity-high-face)
-    (?  . epa-validity-high-face))
-  "An alist mapping marks on epa-keys-buffer to faces."
+  '((unknown . epa-validity-disabled-face)
+    (invalid . epa-validity-disabled-face)
+    (disabled . epa-validity-disabled-face)
+    (revoked . epa-validity-disabled-face)
+    (expired . epa-validity-disabled-face)
+    (none . epa-validity-low-face)
+    (undefined . epa-validity-low-face)
+    (never . epa-validity-low-face)
+    (marginal . epa-validity-medium-face)
+    (full . epa-validity-high-face)
+    (ultimate . epa-validity-high-face))
+  "An alist mapping validity values to faces."
   :type 'list
   :group 'epa)
 
 (defcustom epa-font-lock-keywords
-  '(("^[* ]\\(\\([oidreqnmfu -]\\) .*\\)"
-     (1 (cdr (assq (aref (match-string 2) 0)
-                  epa-validity-face-alist))))
+  '(("^\\*"
+     (0 epa-mark-face))
     ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$"
      (1 epa-field-name-face)
      (2 epa-field-body-face)))
@@ -153,6 +160,42 @@
     (define-key keymap "q" 'bury-buffer)
     keymap))
 
+(define-widget 'epa-key 'push-button
+  "Button for representing a epg-key object."
+  :format "%[%v%]"
+  :button-face-get 'epa-key-widget-button-face-get
+  :value-create 'epa-key-widget-value-create
+  :action 'epa-key-widget-action
+  :help-echo 'epa-key-widget-help-echo)
+
+(defun epa-key-widget-action (widget &optional event)
+  (epa-show-key (widget-get widget :value)))
+
+(defun epa-key-widget-value-create (widget)
+  (let* ((key (widget-get widget :value))
+        (primary-sub-key (car (epg-key-sub-key-list key)))
+        (primary-user-id (car (epg-key-user-id-list key))))
+    (insert (format "%c "
+                   (if (epg-sub-key-validity primary-sub-key)
+                       (car (rassq (epg-sub-key-validity primary-sub-key)
+                                   epg-key-validity-alist))
+                     ? ))
+           (epg-sub-key-id primary-sub-key)
+           " "
+           (epg-user-id-name primary-user-id))))
+
+(defun epa-key-widget-button-face-get (widget)
+  (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
+                                             (widget-get widget :value))))))
+    (if validity
+       (cdr (assq validity epa-validity-face-alist))
+      'default)))
+
+(defun epa-key-widget-help-echo (widget)
+  (format "Show %s"
+         (epg-sub-key-id (car (epg-key-sub-key-list
+                               (widget-get widget :value))))))
+
 (defun epa-keys-mode ()
   "Major mode for `epa-list-keys'."
   (kill-all-local-variables)
@@ -193,40 +236,34 @@
   (run-hooks 'epa-key-mode-hook))
 
 ;;;###autoload
-(defun epa-list-keys (&optional name)
-  (interactive "sPattern: ")
+(defun epa-list-keys (&optional name mode)
+  (interactive
+   (let ((name (read-string "Pattern: ")))
+     (list (if (equal name "") nil name)
+          current-prefix-arg)))
   (unless (and epa-keys-buffer
               (buffer-live-p epa-keys-buffer))
     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
   (set-buffer epa-keys-buffer)
-  (erase-buffer)
-  (epa-list-keys-1 name nil)
-  (epa-keys-mode)
+  (let ((inhibit-read-only t)
+       buffer-read-only)
+    (erase-buffer)
+    (epa-list-keys-1 name nil)
+    (epa-keys-mode))
   (goto-char (point-min))
   (pop-to-buffer (current-buffer)))
 
 (defun epa-list-keys-1 (name mode)
   (let ((inhibit-read-only t)
        buffer-read-only
-       keys point primary-sub-key primary-user-id)
-    (setq keys (epg-list-keys name mode))
+       (keys (epg-list-keys name mode))
+       point)
     (while keys
-      (setq point (point)
-           primary-sub-key (car (epg-key-sub-key-list (car keys)))
-           primary-user-id (car (epg-key-user-id-list (car keys))))
-      (insert " " (or (char-to-string
-                      (car (rassq (epg-sub-key-validity primary-sub-key)
-                                  epg-key-validity-alist)))
-                     " ") " ")
-      (widget-create 'link 
-                    :tag (epg-sub-key-id primary-sub-key)
-                    :notify 'epa-show-key-notify
-                    :help-echo
-                    (format "Show key %s"
-                            (epg-sub-key-id primary-sub-key))
-                    (car keys))
-      (insert " " (epg-user-id-name primary-user-id) "\n")
+      (setq point (point))
+      (insert "  ")
       (put-text-property point (point) 'epa-key (car keys))
+      (widget-create 'epa-key :value (car keys))
+      (insert "\n")
       (setq keys (cdr keys)))))
 
 (defun epa-select-keys (prompt &optional names)
@@ -296,9 +333,11 @@
     (setq pointer (epg-key-user-id-list key))
     (while pointer
       (insert " "
-             (char-to-string
-              (car (rassq (epg-user-id-validity (car pointer))
-                          epg-key-validity-alist)))
+             (if (epg-user-id-validity (car pointer))
+                 (char-to-string
+                  (car (rassq (epg-user-id-validity (car pointer))
+                              epg-key-validity-alist)))
+               " ")
              " "
              (epg-user-id-name (car pointer))
              "\n")
@@ -306,9 +345,11 @@
     (setq pointer (epg-key-sub-key-list key))
     (while pointer
       (insert " "
-             (char-to-string
-              (car (rassq (epg-sub-key-validity (car pointer))
-                          epg-key-validity-alist)))
+             (if (epg-sub-key-validity (car pointer))
+                 (char-to-string
+                  (car (rassq (epg-sub-key-validity (car pointer))
+                              epg-key-validity-alist)))
+               " ")
              " "
              (epg-sub-key-id (car pointer))
              " "
@@ -336,7 +377,7 @@
     (epa-key-mode)))
 
 (defun epa-show-key-notify (widget &rest ignore)
-  (epa-show-key (widget-value widget)))
+  (epa-show-key (widget-get widget :value)))
 
 (defun epa-mark (&optional arg)
   "Mark the current line."
@@ -434,7 +475,7 @@ If no one is selected, symmetric encryption will be performed.  "))))
     (insert "Cipher:\n")
     (apply #'widget-create 'radio-button-choice
           :notify (lambda (widget &rest ignore)
-                    (message "Set %s" (widget-value widget)))
+                    (message "Set %s" (widget-get widget :value)))
           (mapcar
            (lambda (algorithm)
              (list 'item
@@ -444,7 +485,7 @@ If no one is selected, symmetric encryption will be performed.  "))))
     (insert "Digest:\n")
     (apply #'widget-create 'radio-button-choice
           :notify (lambda (widget &rest ignore)
-                    (message "Set %s" (widget-value widget)))
+                    (message "Set %s" (widget-get widget :value)))
           (mapcar
            (lambda (algorithm)
              (list 'item
@@ -454,10 +495,11 @@ If no one is selected, symmetric encryption will be performed.  "))))
     (insert "Compress:\n")
     (apply #'widget-create 'radio-button-choice
           :notify (lambda (widget &rest ignore)
-                    (message "Set %s" (widget-value widget)))
+                    (message "Set %s" (widget-get widget :value)))
           (mapcar
            (lambda (algorithm)
              (list 'item
+                   :inline t
                    :tag (cdr (assq algorithm epg-compress-algorithm-alist))
                    algorithm))
            (cdr (assq 'compress configuration))))

diff --git a/epg.el b/epg.el
index abd5d85..fcff786 100644 (file)
--- a/epg.el
+++ b/epg.el
@@ -107,8 +107,7 @@
     (?n . never)
     (?m . marginal)
     (?f . full)
-    (?u . ultimate)
-    (?  . empty)))
+    (?u . ultimate)))
 
 (defvar epg-key-capablity-alist
   '((?e . encrypt)
@@ -415,6 +414,12 @@ This function is for internal use only."
         (orig-mode (default-file-modes))
         (buffer (generate-new-buffer " *epg*"))
         process)
+    (if epg-debug
+       (save-excursion
+         (set-buffer (get-buffer-create  " *epg-debug*"))
+         (goto-char (point-max))
+         (insert (format "%s %s\n" epg-gpg-program
+                         (mapconcat #'identity args " ")))))
     (with-current-buffer buffer
       (make-local-variable 'epg-read-point)
       (setq epg-read-point (point-min))
@@ -757,8 +762,7 @@ This function is for internal use only."
 (defun epg-make-sub-key-1 (line)
   (epg-make-sub-key
    (if (aref line 1)
-       (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist))
-     'empty)
+       (cdr (assq (string-to-char (aref line 1)) epg-key-validity-alist)))
    (delq nil
         (mapcar (lambda (char) (cdr (assq char epg-key-capablity-alist)))
                 (aref line 11)))
@@ -785,8 +789,7 @@ This function is for internal use only."
        (setq keys (cons (epg-make-key
                          (if (aref (car lines) 8)
                              (cdr (assq (string-to-char (aref (car lines) 8))
-                                        epg-key-validity-alist))
-                           'empty))
+                                        epg-key-validity-alist))))
                         keys))
        (epg-key-set-sub-key-list
         (car keys)
@@ -803,8 +806,7 @@ This function is for internal use only."
         (cons (epg-make-user-id
                (if (aref (car lines) 1)
                    (cdr (assq (string-to-char (aref (car lines) 1))
-                              epg-key-validity-alist))
-                 'empty)
+                              epg-key-validity-alist)))
                (aref (car lines) 9))
               (epg-key-user-id-list (car keys)))))
        ((equal (aref (car lines) 0) "fpr")
@@ -1111,9 +1113,8 @@ If you are unsure, use synchronous version of this function
                     (if (epg-data-file plain)
                         (list (epg-data-file plain)))))
   (if sign
-      (epg-wait-for-status context '("BEGIN_SIGNING"))
-    (if (null recipients)
-       (epg-wait-for-status context '("BEGIN_ENCRYPTION"))))
+      (epg-wait-for-status context '("BEGIN_SIGNING")))
+  (epg-wait-for-status context '("BEGIN_ENCRYPTION"))
   (if (and (epg-data-string plain)
           (eq (process-status (epg-context-process context)) 'run))
       (process-send-string (epg-context-process context)