From: ueno <ueno>
Date: Tue, 18 Apr 2006 08:38:47 +0000 (+0000)
Subject: * epg.el (epg-start): Insert the command-line arguments to the
X-Git-Tag: epgsm-branchpoint~39
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=68d59a0ebd72c220aa5d7fc594b1761d0e57a5cf;p=elisp%2Fepg.git

* 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
--- 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
--- 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
--- 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)