scratch/tzz/auth-source-reveal-mode 52c9556: lisp/auth-source.el: rewrite authinfo-mode as minor auth-source-reveal-mode

[Teodor Zlatanov]

branch: scratch/tzz/auth-source-reveal-mode
commit 52c9556bb59f3bfc64da73a435cf03f2d87d1d94
Author: Ted Zlatanov <tzz@lifelogs.com>
Commit: Ted Zlatanov <tzz@lifelogs.com>

    lisp/auth-source.el: rewrite authinfo-mode as minor auth-source-reveal-mode
---
 lisp/auth-source.el         | 97 ++++++++++++++++++++++++++++++---------------
 lisp/progmodes/prog-mode.el | 56 +++++++++++++++++++++++---
 2 files changed, 116 insertions(+), 37 deletions(-)

diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 7a0e09b..38db658 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -44,6 +44,7 @@
 
 (require 'cl-lib)
 (require 'eieio)
+(require 'prog-mode)
 
 (autoload 'secrets-create-item "secrets")
 (autoload 'secrets-delete-item "secrets")
@@ -2405,44 +2406,78 @@ MODE can be \"login\" or \"password\"."
       (setq password (funcall password)))
     (list user password auth-info)))
 
-;;; Tiny mode for editing .netrc/.authinfo modes (that basically just
-;;; hides passwords).
+;;; Tiny minor mode for editing .netrc/.authinfo modes (that basically
+;;; just hides passwords).
 
-(defcustom authinfo-hidden "password"
-  "Regexp matching elements in .authinfo/.netrc files that should be hidden."
+(defcustom auth-source-reveal-regex "password"
+  "Regexp matching tokens or JSON keys in .authinfo/.netrc/JSON files.
+The text following the tokens or under the JSON keys will be hidden."
   :type 'regexp
   :version "27.1")
 
-;;;###autoload
-(define-derived-mode authinfo-mode fundamental-mode "Authinfo"
-  "Mode for editing .authinfo/.netrc files.
+(defcustom auth-source-reveal-json-modes '(json-mode js-mode js2-mode 
rjsx-mode)
+  "List of symbols for modes that should use JSON parsing logic."
+  :type 'list
+  :version "27.1")
 
-This is just like `fundamental-mode', but hides passwords.  The
-passwords are revealed when point moved into the password.
+(defcustom auth-source-reveal-hider '(?* (base-right . base-left) ?© 
(base-right . base-left) ?© (base-right . base-left) ?*)
+  "A character or a composition list to hide passwords.
+In the composition list form, you can use the format
+(?h (base-right . base-left) ?i (base-right . base-left) ?d (base-right . 
base-left) ?e)
+to show the string \"hide\" (by aligning character left/right baselines).
 
-\\{authinfo-mode-map}"
-  (authinfo--hide-passwords (point-min) (point-max))
-  (reveal-mode))
+Other composition keywords you can use: top-left/tl,
+top-center/tc, top-right/tr, base-left/Bl, base-center/Bc,
+base-right/Br, bottom-left/bl, bottom-center/bc, bottom-right/br,
+center-left/cl, center-center/cc, center-right/cr."
+  :type '(choice
+          (const :tag "A single copyright sign" ?©)
+          (character :tag "Any character")
+          (sexp :tag "A composition list"))
+  :version "27.1")
 
-(defun authinfo--hide-passwords (start end)
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char start)
-      (while (re-search-forward (format "\\(\\s-\\|^\\)\\(%s\\)\\s-+"
-                                        authinfo-hidden)
-                                nil t)
-        (when (auth-source-netrc-looking-at-token)
-          (let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
-            (overlay-put overlay 'display (propertize "****"
-                                                      'face 'warning))
-            (overlay-put overlay 'reveal-toggle-invisible
-                         #'authinfo--toggle-display)))))))
-
-(defun authinfo--toggle-display (overlay hide)
-  (if hide
-      (overlay-put overlay 'display (propertize "****" 'face 'warning))
-    (overlay-put overlay 'display nil)))
+(defun auth-source-reveal-compose-p (start end _match)
+  "Return true iff the symbol MATCH should be composed.
+The symbol starts at position START and ends at position END.
+This overrides the default for `prettify-symbols-compose-predicate'."
+  ;; Check that the chars should really be composed into a symbol.
+  t)
+
+;;;###autoload
+(define-minor-mode auth-source-reveal-mode
+  "Toggle password hiding for auth-source files using `prettify-symbols-mode'.
+
+If called interactively, enable auth-source-reveal mode if ARG is
+positive, and disable it if ARG is zero or negative.  If called
+from Lisp, also enable the mode if ARG is omitted or nil, and
+toggle it if ARG is toggle; disable the mode otherwise.
+
+When auth-source-reveal mode is enabled, passwords will be
+hidden. To reveal them when point is inside them, see
+`prettify-symbols-unprettify-at-point'.
+
+See `auth-source-password-hide-regex' for the regex matching the
+tokens and keys associated with passwords."
+  ;; The initial value.
+  :init-value nil
+  ;; The indicator for the mode line.
+  :lighter " asr"
+  :group 'auth-source
+
+  (when auth-source-reveal-mode
+    (setq-local
+     prettify-symbols-compose-predicate #'auth-source-reveal-compose-p
+     prettify-symbols-alist
+     `((prettify-regexp
+        ,(if (member major-mode auth-source-reveal-json-modes)
+             (format "\"?password\"?[:[:blank:]]+\"\\([^\t\r\n\"]+\\)\"" 
auth-source-reveal-regex)
+           (format "\\b%s\\b\\s-+\\([^ \t\r\n]+\\)" auth-source-reveal-regex))
+        ,auth-source-reveal-hider)))
+    (unless prettify-symbols-unprettify-at-point
+      (auth-source-do-warn
+       "Please set `prettify-symbols-unprettify-at-point' to see passwords")))
+
+  (prettify-symbols-mode (if auth-source-reveal-mode 1 -1)))
 
 (provide 'auth-source)
 
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index d3d3dea..73461b7 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -92,10 +92,14 @@ instead."
 
 (defvar-local prettify-symbols-alist nil
   "Alist of symbol prettifications.
-Each element looks like (SYMBOL . CHARACTER), where the symbol
+Each element can look like (SYMBOL . CHARACTER), where the symbol
 matching SYMBOL (a string, not a regexp) will be shown as
 CHARACTER instead.
 
+Elements can also look like (prettify-regexp REGEXP CHARACTER)
+which will behave like the simpler (SYMBOL . CHARACTER) form
+except it will match regular expressions.
+
 CHARACTER can be a character, or it can be a list or vector, in
 which case it will be used to compose the new symbol as per the
 third argument of `compose-region'.")
@@ -121,6 +125,30 @@ The matched symbol is the car of one entry in 
`prettify-symbols-alist'.
 The predicate receives the match's start and end positions as well
 as the match-string as arguments.")
 
+;; (prettify-symbols-default-compose-replacer '(("xyz" 231) (prettify-regexp 
"aaa\\(bbb\\)" 169)) 568 574 "aaabbb")
+(defun prettify-symbols-default-compose-replacer (alist start end match)
+  "Return the compose-region prettification for MATCH from ALIST.
+START and END are passed back and may be modified (narrowed)."
+  (let ((quick-assoc (cdr (assoc match alist))))
+    (if quick-assoc
+        ;; Return the quick lookup if we can, else...
+        (list start end quick-assoc)
+      (cl-loop for ps in alist
+               ;; Did we get a valid regexp entry, and does it match?
+               if (and (eq 'prettify-regexp (car-safe ps))
+                       (string-match (nth 1 ps) match))
+               ;; Return the actual start and end of the prettified symbol
+               return (list (+ start (match-beginning 1))
+                            (+ start(match-end 1))
+                            (nth 2 ps))))))
+
+(defvar-local prettify-symbols-compose-replacer
+  #'prettify-symbols-default-compose-replacer
+  "A function to generate the replacement for a matched string.
+The function receives the current prettify-symbols-alist, the
+match's start and end positions, and the match-string as
+arguments.")
+
 (defun prettify-symbols--compose-symbol (alist)
   "Compose a sequence of characters into a symbol.
 Regexp match data 0 specifies the characters to be composed."
@@ -132,10 +160,14 @@ Regexp match data 0 specifies the characters to be 
composed."
              (funcall prettify-symbols-compose-predicate start end match))
         ;; That's a symbol alright, so add the composition.
         (with-silent-modifications
-          (compose-region start end (cdr (assoc match alist)))
-          (add-text-properties
-           start end
-           `(prettify-symbols-start ,start prettify-symbols-end ,end)))
+          (let* ((replacement (funcall prettify-symbols-compose-replacer
+                                       alist start end match))
+                 (start (nth 0 replacement))
+                 (end (nth 1 replacement)))
+            (apply #'compose-region replacement)
+            (add-text-properties
+             start end
+             `(prettify-symbols-start ,start prettify-symbols-end ,end))))
       ;; No composition for you.  Let's actually remove any
       ;; composition we may have added earlier and which is now
       ;; incorrect.
@@ -146,9 +178,21 @@ Regexp match data 0 specifies the characters to be 
composed."
   ;; Return nil because we're not adding any face property.
   nil)
 
+(defun prettify-symbols--make-matcher ()
+  "Make the matcher portion of the font-lock keywords."
+  (mapconcat #'identity
+             (cons (regexp-opt (cl-loop for s in (mapcar 'car 
prettify-symbols-alist)
+                                        if (stringp s)
+                                        collect s)
+                               t)
+                   (cl-loop for ps in prettify-symbols-alist
+                            if (eq 'prettify-regexp (car-safe ps))
+                            collect (nth 1 ps)))
+             "\\|"))
+
 (defun prettify-symbols--make-keywords ()
   (if prettify-symbols-alist
-      `((,(regexp-opt (mapcar 'car prettify-symbols-alist) t)
+      `((,(prettify-symbols--make-matcher)
          (0 (prettify-symbols--compose-symbol ',prettify-symbols-alist))))
     nil))