From 68d59a0ebd72c220aa5d7fc594b1761d0e57a5cf Mon Sep 17 00:00:00 2001 From: ueno Date: Tue, 18 Apr 2006 08:38:47 +0000 Subject: [PATCH] * 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. --- ChangeLog | 12 ++++++ epa.el | 138 ++++++++++++++++++++++++++++++++++++++++--------------------- epg.el | 23 ++++++----- 3 files changed, 114 insertions(+), 59 deletions(-) diff --git a/ChangeLog b/ChangeLog index a91a40c..af8763a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +2006-04-18 Daiki Ueno + + * 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 * 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) -- 1.7.10.4