master 517285f: Rewrite the epa key interface to use buttons instead of widgets

[Lars Ingebrigtsen]

branch: master
commit 517285f7caed462c822c779efe14033645dccba0
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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.
---
 lisp/epa.el | 132 ++++++++++++++++++------------------------------------------
 1 file changed, 39 insertions(+), 93 deletions(-)

diff --git a/lisp/epa.el b/lisp/epa.el
index 5140d3f..3c80436 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))