(require 'json)
(require 'password-cache)
+(require 'icons)
(require 'cl-lib)
(require 'eieio)
(propertize "****" 'face 'font-lock-doc-face))
(overlay-put overlay 'display nil)))
+;; It would be preferable to use "👁" ("\N{EYE}"). However, there is
+;; no corresponding Unicode char with a slash. So we use symbols as
+;; fallback only, with "⦵" ("\N{CIRCLE WITH HORIZONTAL BAR}") for
+;; hiding the password.
+(define-icon read-passwd--show-password-icon nil
+ '((image "reveal.svg" "reveal.pbm" :height (0.8 . em))
+ (symbol "👁")
+ (text "<o>"))
+ "Mode line icon to show a hidden password."
+ :group mode-line-faces
+ :version "30.1"
+ :help-echo "mouse-1: Toggle password visibility")
+
+(define-icon read-passwd--hide-password-icon nil
+ '((image "conceal.svg" "conceal.pbm" :height (0.8 . em))
+ (symbol "⦵")
+ (text "<\\>"))
+ "Mode line icon to hide a visible password."
+ :group mode-line-faces
+ :version "30.1"
+ :help-echo "mouse-1: Toggle password visibility")
+
+(defvar read-passwd--mode-line-buffer nil
+ "Buffer to modify `mode-line-format' for showing/hiding passwords.")
+
+(defvar read-passwd--mode-line-icon nil
+ "Propertized mode line icon for showing/hiding passwords.")
+
+(defvar read-passwd--hide-password t
+ "Toggle whether password should be hidden in minubuffer.")
+
+(defun read-passwd--hide-password ()
+ "Make password in minibuffer hidden or visible."
+ (let ((beg (minibuffer-prompt-end)))
+ (dotimes (i (1+ (- (buffer-size) beg)))
+ (if read-passwd--hide-password
+ (put-text-property
+ (+ i beg) (+ 1 i beg) 'display (string (or read-hide-char ?*)))
+ (remove-list-of-text-properties (+ i beg) (+ 1 i beg) '(display)))
+ (put-text-property
+ (+ i beg) (+ 1 i beg)
+ 'help-echo "C-u: Clear password\nTAB: Toggle password visibility"))))
+
+(defun read-passwd-toggle-visibility ()
+ "Toggle minibuffer contents visibility.
+Adapt also mode line."
+ (interactive)
+ (setq read-passwd--hide-password (not read-passwd--hide-password))
+ (with-current-buffer read-passwd--mode-line-buffer
+ (setq read-passwd--mode-line-icon
+ `(:propertize
+ ,(if icon-preference
+ (icon-string
+ (if read-passwd--hide-password
+ 'read-passwd--show-password-icon
+ 'read-passwd--hide-password-icon))
+ "")
+ mouse-face mode-line-highlight
+ local-map
+ (keymap
+ (mode-line keymap (mouse-1 . read-passwd-toggle-visibility)))))
+ (force-mode-line-update))
+ (read-passwd--hide-password))
+
+(defvar read-passwd-map
+ ;; BEWARE: `defconst' would purecopy it, breaking the sharing with
+ ;; minibuffer-local-map along the way!
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570
+ (define-key map "\t" #'read-passwd-toggle-visibility)
+ map)
+ "Keymap used while reading passwords.")
+
+(define-minor-mode read-passwd-mode
+ "Toggle visibility of password in minibuffer."
+ :group 'mode-line
+ :group 'minibuffer
+ :keymap read-passwd-map
+ :version "30.1"
+
+ (setq read-passwd--hide-password nil
+ ;; Stolen from `eldoc-minibuffer-message'.
+ read-passwd--mode-line-buffer
+ (window-buffer
+ (or (window-in-direction 'above (minibuffer-window))
+ (minibuffer-selected-window)
+ (get-largest-window))))
+
+ (if read-passwd-mode
+ (with-current-buffer read-passwd--mode-line-buffer
+ ;; Add `read-passwd--mode-line-icon'.
+ (when (listp mode-line-format)
+ (setq mode-line-format
+ (cons '(:eval read-passwd--mode-line-icon)
+ mode-line-format))))
+ (with-current-buffer read-passwd--mode-line-buffer
+ ;; Remove `read-passwd--mode-line-icon'.
+ (when (listp mode-line-format)
+ (setq mode-line-format (cdr mode-line-format)))))
+
+ (when read-passwd-mode
+ (read-passwd-toggle-visibility)))
+
+;;;###autoload
+(defun read-passwd (prompt &optional confirm default)
+ "Read a password, prompting with PROMPT, and return it.
+If optional CONFIRM is non-nil, read the password twice to make sure.
+Optional DEFAULT is a default password to use instead of empty input.
+
+This function echoes `*' for each character that the user types.
+You could let-bind `read-hide-char' to another hiding character, though.
+
+Once the caller uses the password, it can erase the password
+by doing (clear-string STRING)."
+ (if confirm
+ (let (success)
+ (while (not success)
+ (let ((first (read-passwd prompt nil default))
+ (second (read-passwd "Confirm password: " nil default)))
+ (if (equal first second)
+ (progn
+ (and (arrayp second) (not (eq first second)) (clear-string second))
+ (setq success first))
+ (and (arrayp first) (clear-string first))
+ (and (arrayp second) (clear-string second))
+ (message "Password not repeated accurately; please start over")
+ (sit-for 1))))
+ success)
+ (let (minibuf)
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq minibuf (current-buffer))
+ ;; Turn off electricity.
+ (setq-local post-self-insert-hook nil)
+ (setq-local buffer-undo-list t)
+ (setq-local select-active-regions nil)
+ (use-local-map read-passwd-map)
+ (setq-local inhibit-modification-hooks nil) ;bug#15501.
+ (setq-local show-paren-mode nil) ;bug#16091.
+ (setq-local inhibit--record-char t)
+ (read-passwd-mode 1)
+ (add-hook 'post-command-hook #'read-passwd--hide-password nil t))
+ (unwind-protect
+ (let ((enable-recursive-minibuffers t)
+ (read-hide-char (or read-hide-char ?*))
+ (overriding-text-conversion-style 'password))
+ (read-string prompt nil t default)) ; t = "no history"
+ (when (buffer-live-p minibuf)
+ (with-current-buffer minibuf
+ (read-passwd-mode -1)
+ ;; Not sure why but it seems that there might be cases where the
+ ;; minibuffer is not always properly reset later on, so undo
+ ;; whatever we've done here (bug#11392).
+ (remove-hook 'after-change-functions
+ #'read-passwd--hide-password 'local)
+ (kill-local-variable 'post-self-insert-hook)
+ ;; And of course, don't keep the sensitive data around.
+ (erase-buffer)
+ ;; Then restore the previous text conversion style.
+ (set-text-conversion-style text-conversion-style))))))))
+
(provide 'auth-source)
;;; auth-source.el ends here
buffer-invisibility-spec)
(setq buffer-invisibility-spec nil)))
-\f
-(defvar read-passwd--mode-line-buffer nil
- "Buffer to modify `mode-line-format' for showing/hiding passwords.")
-
-(defvar read-passwd--mode-line-icon nil
- "Propertized mode line icon for showing/hiding passwords.")
-
-(defun read-passwd-toggle-visibility ()
- "Toggle minibuffer contents visibility.
-Adapt also mode line."
- (interactive)
- (setq read-passwd--hide-password (not read-passwd--hide-password))
- (with-current-buffer read-passwd--mode-line-buffer
- (setq read-passwd--mode-line-icon
- `(:propertize
- ,(if icon-preference
- (icon-string
- (if read-passwd--hide-password
- 'read-passwd--show-password-icon
- 'read-passwd--hide-password-icon))
- "")
- mouse-face mode-line-highlight
- local-map
- (keymap
- (mode-line keymap (mouse-1 . read-passwd-toggle-visibility)))))
- (force-mode-line-update))
- (read-passwd--hide-password))
-
-(define-minor-mode read-passwd-mode
- "Toggle visibility of password in minibuffer."
- :group 'mode-line
- :group 'minibuffer
- :keymap read-passwd-map
- :version "30.1"
-
- (require 'icons)
- ;; It would be preferable to use "👁" ("\N{EYE}"). However, there is
- ;; no corresponding Unicode char with a slash. So we use symbols as
- ;; fallback only, with "⦵" ("\N{CIRCLE WITH HORIZONTAL BAR}") for
- ;; hiding the password.
- (define-icon read-passwd--show-password-icon nil
- '((image "reveal.svg" "reveal.pbm" :height (0.8 . em))
- (symbol "👁")
- (text "<o>"))
- "Mode line icon to show a hidden password."
- :group mode-line-faces
- :version "30.1"
- :help-echo "mouse-1: Toggle password visibility")
- (define-icon read-passwd--hide-password-icon nil
- '((image "conceal.svg" "conceal.pbm" :height (0.8 . em))
- (symbol "⦵")
- (text "<\\>"))
- "Mode line icon to hide a visible password."
- :group mode-line-faces
- :version "30.1"
- :help-echo "mouse-1: Toggle password visibility")
-
- (setq read-passwd--hide-password nil
- ;; Stolen from `eldoc-minibuffer-message'.
- read-passwd--mode-line-buffer
- (window-buffer
- (or (window-in-direction 'above (minibuffer-window))
- (minibuffer-selected-window)
- (get-largest-window))))
-
- (if read-passwd-mode
- (with-current-buffer read-passwd--mode-line-buffer
- ;; Add `read-passwd--mode-line-icon'.
- (when (listp mode-line-format)
- (setq mode-line-format
- (cons '(:eval read-passwd--mode-line-icon)
- mode-line-format))))
- (with-current-buffer read-passwd--mode-line-buffer
- ;; Remove `read-passwd--mode-line-icon'.
- (when (listp mode-line-format)
- (setq mode-line-format (cdr mode-line-format)))))
-
- (when read-passwd-mode
- (read-passwd-toggle-visibility)))
-
\f
(defvar messages-buffer-mode-map
(let ((map (make-sparse-keymap)))
t)
(read-event)))
-(defvar read-passwd-map
- ;; BEWARE: `defconst' would purecopy it, breaking the sharing with
- ;; minibuffer-local-map along the way!
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map "\C-u" #'delete-minibuffer-contents) ;bug#12570
- (define-key map "\t" #'read-passwd-toggle-visibility)
- map)
- "Keymap used while reading passwords.")
-
-(defvar read-passwd--hide-password t)
-
-(defun read-passwd--hide-password ()
- "Make password in minibuffer hidden or visible."
- (let ((beg (minibuffer-prompt-end)))
- (dotimes (i (1+ (- (buffer-size) beg)))
- (if read-passwd--hide-password
- (put-text-property
- (+ i beg) (+ 1 i beg) 'display (string (or read-hide-char ?*)))
- (remove-list-of-text-properties (+ i beg) (+ 1 i beg) '(display)))
- (put-text-property
- (+ i beg) (+ 1 i beg)
- 'help-echo "C-u: Clear password\nTAB: Toggle password visibility"))))
-
-;; Actually in textconv.c.
-(defvar overriding-text-conversion-style)
-(declare-function set-text-conversion-style "textconv.c")
-
-(defun read-passwd (prompt &optional confirm default)
- "Read a password, prompting with PROMPT, and return it.
-If optional CONFIRM is non-nil, read the password twice to make sure.
-Optional DEFAULT is a default password to use instead of empty input.
-
-This function echoes `*' for each character that the user types.
-You could let-bind `read-hide-char' to another hiding character, though.
-
-Once the caller uses the password, it can erase the password
-by doing (clear-string STRING)."
- (if confirm
- (let (success)
- (while (not success)
- (let ((first (read-passwd prompt nil default))
- (second (read-passwd "Confirm password: " nil default)))
- (if (equal first second)
- (progn
- (and (arrayp second) (not (eq first second)) (clear-string second))
- (setq success first))
- (and (arrayp first) (clear-string first))
- (and (arrayp second) (clear-string second))
- (message "Password not repeated accurately; please start over")
- (sit-for 1))))
- success)
- (let (minibuf)
- (minibuffer-with-setup-hook
- (lambda ()
- (setq minibuf (current-buffer))
- ;; Turn off electricity.
- (setq-local post-self-insert-hook nil)
- (setq-local buffer-undo-list t)
- (setq-local select-active-regions nil)
- (use-local-map read-passwd-map)
- (setq-local inhibit-modification-hooks nil) ;bug#15501.
- (setq-local show-paren-mode nil) ;bug#16091.
- (setq-local inhibit--record-char t)
- (read-passwd-mode 1)
- (add-hook 'post-command-hook #'read-passwd--hide-password nil t))
- (unwind-protect
- (let ((enable-recursive-minibuffers t)
- (read-hide-char (or read-hide-char ?*))
- (overriding-text-conversion-style 'password))
- (read-string prompt nil t default)) ; t = "no history"
- (when (buffer-live-p minibuf)
- (with-current-buffer minibuf
- (read-passwd-mode -1)
- ;; Not sure why but it seems that there might be cases where the
- ;; minibuffer is not always properly reset later on, so undo
- ;; whatever we've done here (bug#11392).
- (remove-hook 'after-change-functions
- #'read-passwd--hide-password 'local)
- (kill-local-variable 'post-self-insert-hook)
- ;; And of course, don't keep the sensitive data around.
- (erase-buffer)
- ;; Then restore the previous text conversion style.
- (when (fboundp 'set-text-conversion-style)
- (set-text-conversion-style text-conversion-style)))))))))
-
(defvar read-number-history nil
"The default history for the `read-number' function.")