From: Lars Ingebrigtsen Date: Mon, 24 Aug 2020 19:54:56 +0000 (+0200) Subject: Rewrite the epa key interface to use buttons instead of widgets X-Git-Tag: emacs-28.0.90~6424 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=517285f7caed462c822c779efe14033645dccba0;p=emacs.git Rewrite the epa key interface to use buttons instead of widgets * lisp/epa.el (epa-font-lock-keywords): Removed. (epa-key-list-mode-map): Bind tab/backtab to button navigation. (epa-key): Remove widget. (epa--button-key-text): Return the propertized text instead of return a widget text. (epa-key-list-mode): Don't use font locking; everything is output as it should be. (epa--insert-keys): Rewrite to just output the data instead of widgetising. (epa--select-keys): Insert buttons instead of widgets. --- diff --git a/lisp/epa.el b/lisp/epa.el index 5140d3f0a69..3c804361c36 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -25,10 +25,7 @@ (require 'epg) (require 'font-lock) -(require 'widget) -(eval-when-compile - (require 'subr-x) - (require 'wid-edit)) +(eval-when-compile (require 'subr-x)) (require 'derived) ;;; Options @@ -153,14 +150,6 @@ The command `epa-mail-encrypt' uses this." ;;; Variables -(defvar epa-font-lock-keywords - '(("^\\*" - (0 'epa-mark)) - ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$" - (1 'epa-field-name) - (2 'epa-field-body))) - "Default expressions to addon in epa-mode.") - (defconst epa-pubkey-algorithm-letter-alist '((1 . ?R) (2 . ?r) @@ -197,8 +186,9 @@ You should bind this variable with `let', but do not set it globally.") (defvar epa-key-list-mode-map (let ((keymap (make-sparse-keymap)) (menu-map (make-sparse-keymap))) - (set-keymap-parent keymap widget-keymap) (define-key keymap "\C-m" 'epa-show-key) + (define-key keymap [?\t] 'forward-button) + (define-key keymap [backtab] 'backward-button) (define-key keymap "m" 'epa-mark-key) (define-key keymap "u" 'epa-unmark-key) (define-key keymap "d" 'epa-decrypt-file) @@ -259,48 +249,28 @@ You should bind this variable with `let', but do not set it globally.") (defvar epa-exit-buffer-function #'quit-window) -;;; Key Widget - -(define-widget 'epa-key 'push-button - "Button for representing an 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) - (save-selected-window - (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) - " " - (if primary-user-id - (if (stringp (epg-user-id-string primary-user-id)) - (epg-user-id-string primary-user-id) - (epg-decode-dn (epg-user-id-string 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--button-key-text (key) + (let ((primary-sub-key (car (epg-key-sub-key-list key))) + (primary-user-id (car (epg-key-user-id-list key))) + (validity (epg-sub-key-validity (car (epg-key-sub-key-list key))))) + (propertize + (concat + (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) + " " + (if primary-user-id + (if (stringp (epg-user-id-string primary-user-id)) + (epg-user-id-string primary-user-id) + (epg-decode-dn (epg-user-id-string primary-user-id))) + "")) + 'face + (if validity + (cdr (assq validity epa-validity-face-alist)) + 'default)))) ;;; Modes @@ -309,7 +279,6 @@ You should bind this variable with `let', but do not set it globally.") (buffer-disable-undo) (setq truncate-lines t buffer-read-only t) - (setq-local font-lock-defaults '(epa-font-lock-keywords t)) (make-local-variable 'epa-exit-buffer-function) (setq-local revert-buffer-function #'epa--key-list-revert-buffer)) @@ -318,7 +287,6 @@ You should bind this variable with `let', but do not set it globally.") (buffer-disable-undo) (setq truncate-lines t buffer-read-only t) - (setq-local font-lock-defaults '(epa-font-lock-keywords t)) (make-local-variable 'epa-exit-buffer-function)) (define-derived-mode epa-info-mode special-mode "EPA Info" @@ -362,28 +330,14 @@ If ARG is non-nil, mark the key." ;;;; Listing and Selecting (defun epa--insert-keys (keys) - (save-excursion - (save-restriction - (narrow-to-region (point) (point)) - (let (point) - (while keys - (setq point (point)) - (insert " ") - (add-text-properties point (point) - (list 'epa-key (car keys) - 'front-sticky nil - 'rear-nonsticky t - 'start-open t - 'end-open t)) - (widget-create 'epa-key :value (car keys)) - (insert "\n") - (setq keys (cdr keys)))) - (add-text-properties (point-min) (point-max) - (list 'epa-list-keys t - 'front-sticky nil - 'rear-nonsticky t - 'start-open t - 'end-open t))))) + (dolist (key keys) + (insert + (propertize + (concat " " (epa--button-key-text key)) + 'epa-key key + 'help-echo (format "Show %s" + (epg-sub-key-id (car (epg-key-sub-key-list key)))))) + (insert "\n"))) (defun epa--list-keys (name secret &optional doc) "NAME specifies which key to list. @@ -420,8 +374,7 @@ DOC is documentation text to insert at the start." (point-max))) (goto-char point)) - (epa--insert-keys (epg-list-keys context name secret)) - (widget-setup)) + (epa--insert-keys (epg-list-keys context name secret))) (make-local-variable 'epa-list-keys-arguments) (setq epa-list-keys-arguments (list name secret)) (goto-char (point-min)) @@ -488,20 +441,13 @@ q trust status questionable. - trust status unspecified. (substitute-command-keys "\ - `\\[epa-mark-key]' to mark a key on the line - `\\[epa-unmark-key]' to unmark a key on the line\n")) - (widget-create 'push-button - :notify (lambda (&rest _ignore) (abort-recursive-edit)) - :help-echo - "Click here or \\[abort-recursive-edit] to cancel" - "Cancel") - (widget-create 'push-button - :notify (lambda (&rest _ignore) (exit-recursive-edit)) - :help-echo - "Click here or \\[exit-recursive-edit] to finish" - "OK") + (insert-button "[Cancel]" + 'action (lambda (_button) (abort-recursive-edit))) + (insert " ") + (insert-button "[OK]" + 'action (lambda (_button) (exit-recursive-edit))) (insert "\n\n") (epa--insert-keys keys) - (widget-setup) - (set-keymap-parent (current-local-map) widget-keymap) (setq epa-exit-buffer-function #'abort-recursive-edit) (goto-char (point-min)) (let ((display-buffer-mark-dedicated 'soft))