auth-source-reveal-mode: fixes from code review

* lisp/auth-source.el (auth-source-reveal-mode): Add new minor
mode to hide passwords. Remove authinfo-mode which provided a
major mode for the same purpose before.

* doc/misc/auth.texi (Hiding passwords in text buffers): Document
auth-source-reveal-mode.

doc/misc/auth.texi

@@ -1,6 +1,6 @@
 \input texinfo                  @c -*-texinfo-*-
 
-@set VERSION 0.3
+@set VERSION 0.4
 
 @setfilename ../../info/auth.info
 @settitle Emacs auth-source Library @value{VERSION}
@@ -58,6 +58,7 @@ It is a way for multiple applications to share a single configuration
 * Overview::                    Overview of the auth-source library.
 * Help for users::
 * Multiple GMail accounts with Gnus::
+* Hiding passwords in text buffers::
 * Secret Service API::
 * The Unix password store::
 * Help for developers::
@@ -280,6 +281,50 @@ machine gmail login account@@gmail.com password "account password" port imap
 machine gmail2 login account2@@gmail.com password "account2 password" port imap
 @end example
 
+@node Hiding passwords in text buffers
+@chapter Hiding passwords in text buffers
+
+Emacs users and developers have to look at netrc files in text or JSON
+formats sometimes. Pro Tip: one easy way to protect from
+password-shoulder-surfers is to enter a hair band, grow long hair,
+curl it daily until it creates a visual barrier, become famous, keep
+using Emacs.
+
+An alternative is to enable @code{auth-source-reveal-mode} as follows:
+
+@example
+(require 'auth-source)
+(setq prettify-symbols-unprettify-at-point 'right-edge) ;; or customize it
+
+(add-hook 'prog-mode-hook 'turn-on-auth-source-reveal-mode)
+(add-hook 'text-mode-hook 'turn-on-auth-source-reveal-mode)
+(add-hook 'json-mode-hook 'turn-on-auth-source-reveal-mode)
+@end example
+
+You should definitely customize
+@code{prettify-symbols-unprettify-at-point} to be t or
+@code{right-edge}. If it's nil (the default), the password will not be
+revealed when you're inside it, which will annoy you AND
+password-shoulder-surfers.
+
+You can further customize the following.
+@defvar auth-source-reveal-regex
+A regular expression matching the text preceding the password (or, in JSON format, the key under which the password lives). By default it will be just ``password'' which also matches e.g. ``my_password''.
+
+Use only non-capturing parens inside this regular expression.
+@end defvar
+
+@defvar auth-source-reveal-json-modes
+This is a list of modes where the JSON regular expression logic should be installed, instead of the plaintext logic. By default this includes @code{json-mode} for instance.
+@end defvar
+
+@itemize @bullet
+@item
+Q: How does it work? A: Underneath, @code{prettify-symbols-mode} is used to hide passwords based on a regular expression for netrc plain text or JSON files.
+@item
+Q: Why does it depend on prettify-symbols-mode? A: Eventually it won't. For now it does.
+@end itemize
+
 @node Secret Service API
 @chapter Secret Service API
 

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,87 @@ 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")
 
+(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")
+
+(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).
+
+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 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-derived-mode authinfo-mode fundamental-mode "Authinfo"
-  "Mode for editing .authinfo/.netrc files.
+(define-minor-mode auth-source-reveal-mode
+  "Toggle password hiding for auth-source files using `prettify-symbols-mode'.
 
-This is just like `fundamental-mode', but hides passwords.  The
-passwords are revealed when point moved into the password.
+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.
 
-\\{authinfo-mode-map}"
-  (authinfo--hide-passwords (point-min) (point-max))
-  (reveal-mode))
+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'.
 
-(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)))))))
+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
 
-(defun authinfo--toggle-display (overlay hide)
-  (if hide
-      (overlay-put overlay 'display (propertize "****" 'face 'warning))
-    (overlay-put overlay 'display nil)))
+  (when auth-source-reveal-mode
+    ;; Install the prettification magic.
+    (prettify-symbols-add-prettification-rx
+     'auth-source-reveal-mode-prettify-regexp ; The identifier symbol.
+     ;; regexp to hide/reveal
+     (if (apply #'derived-mode-p 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)
+
+    (setq-local
+     prettify-symbols-compose-predicate #'auth-source-reveal-compose-p)
+    (unless prettify-symbols-unprettify-at-point
+      (auth-source-do-warn
+       "Please set `%s' to _see_ passwords at point"
+       'prettify-symbols-unprettify-at-point)))
+
+  (prettify-symbols-mode (if auth-source-reveal-mode 1 -1)))
+
+(defun turn-on-auth-source-reveal-mode ()
+  (when (and (not auth-source-reveal-mode)
+             (local-variable-p 'prettify-symbols-alist))
+    (auth-source-reveal-mode 1)))
 
 (provide 'auth-source)
 

lisp/progmodes/prog-mode.el

@@ -91,10 +91,30 @@ instead."
   (or (car prog-indentation-context) 0))
 
 (defvar-local prettify-symbols-alist nil
-  "Alist of symbol prettifications.
-Each element looks like (SYMBOL . CHARACTER), where the symbol
-matching SYMBOL (a string, not a regexp) will be shown as
-CHARACTER instead.
+  "Alist of symbol string prettifications.
+Each element can look like (STRING . CHARACTER), where the
+STRING (a string, not a regexp) will be shown as CHARACTER
+instead.
+
+For example: \"->\" to the Unicode RIGHT ARROW →
+ (\"->\" . ?→)
+
+Elements can also look like (IDENTIFIER REGEXP CHARACTER) which
+will behave like the simpler (SYMBOL-STRING . CHARACTER) form
+except it will match regular expressions. The REGEXP can have
+capturing groups, in which case the first such group will be
+prettified. If there are no capturing groups, the whole REGEXP is
+prettified.
+
+The IDENTIFIER can be any symbol and should be unique to every
+package that augments `prettify-symbols-alist' (in order to
+remove prettifications easily with
+`prettify-symbols-remove-prettifications').
+
+For example: \"abc[123]\" matching \"abc1\", \"abc2\", or
+\"abc3\" could be mapped to the Unicode WORLD MAP. Note again the
+IDENTIFIER is an arbitrary Lisp symbol.
+ (my-worldmap \"abc[123]\" ?\U0001f5fa)
 
 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
@@ -121,7 +141,45 @@ 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.")
 
-(defun prettify-symbols--compose-symbol (alist)
+;; (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 &optional identifier)
+  "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
+               ;; the identifier (if packaged in the call) or the regexp?
+               if (and (symbolp (car-safe ps))
+                       ;; We must match the identifier symbol if we got it.
+                       (if identifier
+                           (eq identifier (car ps))
+                         t) ; But if there's no identifier, pass safely.
+
+                       ;; ...We need to always do a string-match for the bounds.
+                       (string-match (nth 1 ps) match))
+               ;; Now return the actual prettification start and end.
+               return (list (+ start (or
+                                      (match-beginning 1)
+                                      (match-beginning 0)))
+                            (+ start (or
+                                      (match-end 1)
+                                      (match-end 0)))
+                            (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.
+
+For regexp matches, the function will also receive the symbol
+that identifies the match, as per `prettify-symbols-alist'.")
+
+(defun prettify-symbols--compose-symbol (alist &optional identifier)
   "Compose a sequence of characters into a symbol.
 Regexp match data 0 specifies the characters to be composed."
   ;; Check that the chars should really be composed into a symbol.
@@ -132,10 +190,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 identifier))
+                 (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,10 +208,30 @@ 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-fixed-matcher (alist)
+  "Make the fixed string matcher portion of the font-lock keywords from ALIST."
+  (regexp-opt (cl-loop for s in (mapcar 'car alist)
+                       if (stringp s)
+                       collect s)
+              t))
+
+(defun prettify-symbols--make-regexp-keywords (alist)
+  "Make the regexp string matcher portion of the font-lock keywords from ALIST."
+  ;; Collect the symbols to generate matchers keyed on them.
+  (cl-loop for ps in alist
+           if (symbolp (car-safe ps))
+           collect `(
+                     ,(nth 1 ps)          ; the regexp
+                     ;; the symbol composer called with the identifier
+                     (0 (prettify-symbols--compose-symbol
+                         ',prettify-symbols-alist
+                         ',(car ps))))))
+
 (defun prettify-symbols--make-keywords ()
   (if prettify-symbols-alist
-      `((,(regexp-opt (mapcar 'car prettify-symbols-alist) t)
-         (0 (prettify-symbols--compose-symbol ',prettify-symbols-alist))))
+      `((,(prettify-symbols--make-fixed-matcher prettify-symbols-alist)
+         (0 (prettify-symbols--compose-symbol ',prettify-symbols-alist)))
+        ,@(prettify-symbols--make-regexp-keywords prettify-symbols-alist))
     nil))
 
 (defvar-local prettify-symbols--keywords nil)
@@ -183,6 +265,11 @@ on the symbol."
 		   (> (point) (cadr prettify-symbols--current-symbol-bounds))
 		   (and (not (eq prettify-symbols-unprettify-at-point 'right-edge))
 			(= (point) (cadr prettify-symbols--current-symbol-bounds)))))
+      ;; Adjust the bounds in case either end is invalid.
+      (setf (car prettify-symbols--current-symbol-bounds)
+            (max (car prettify-symbols--current-symbol-bounds) (point-min))
+            (cadr prettify-symbols--current-symbol-bounds)
+            (min (cadr prettify-symbols--current-symbol-bounds) (point-max)))
       (apply #'font-lock-flush prettify-symbols--current-symbol-bounds)
       (setq prettify-symbols--current-symbol-bounds nil))
     ;; Unprettify the current symbol.
@@ -195,6 +282,38 @@ on the symbol."
 	(setq prettify-symbols--current-symbol-bounds (list s e))
         (remove-text-properties s e '(composition nil))))))
 
+(defun prettify-symbols-add-prettification-entry (entry)
+  "Add ENTRY to `prettify-symbols-alist' for the current buffer.
+ENTRY is formatted as per `prettify-symbols-alist' (which see).
+Duplicates according to `equal' will not be added."
+  (setq-local prettify-symbols-alist (cl-adjoin entry
+                                                prettify-symbols-alist
+                                                :test #'equal)))
+
+(defun prettify-symbols-add-prettification-rx (identifier regexp replacement)
+  "Convenience wrapper of `prettify-symbols-add-prettification-entry' to prettify REGEXP with REPLACEMENT."
+  (prettify-symbols-add-prettification-entry
+   (list identifier regexp replacement)))
+
+(defun prettify-symbols-add-prettification-string (fixed-string replacement)
+  "Convenience wrapper of `prettify-symbols-add-prettification-entry' to prettify FIXED-STRING with REPLACEMENT."
+  (prettify-symbols-add-prettification-entry
+   (cons fixed-string replacement)))
+
+(defun prettify-symbols-remove-prettification (entry)
+  "Remove ENTRY to `prettify-symbols-alist' for the current buffer.
+ENTRY is found with an `equal' test."
+  (setq-local prettify-symbols-alist (cl-remove entry
+                                                prettify-symbols-alist
+                                                :test #'equal)))
+
+(defun prettify-symbols-remove-prettifications (identifier)
+  "Remove all IDENTIFIER entries from `prettify-symbols-alist' for the current buffer.
+IDENTIFIER is as per `prettify-symbols-alist' (which see)."
+  (setq-local prettify-symbols-alist (cl-remove identifier
+                                                prettify-symbols-alist
+                                                :test #'car)))
+
 ;;;###autoload
 (define-minor-mode prettify-symbols-mode
   "Toggle Prettify Symbols mode.