- added a slot in 'command-window' to allow the user to insert secret

input.

 the same character is echoed instead of the actual input.

etc/default-theme.conf

@@ -37,6 +37,10 @@ main-window.foreground                             = white
 
 crypted.mark.value                                 = " 🔏👌"
 
+# the string to be drawn instead of actual character when input password
+
+password-echo-character                            = "•"
+
 # the character used to draw the vote's horizontal histogram
 # note: keeps it one character wide
 

src/command-window.lisp

@@ -22,6 +22,13 @@
     :initarg  :command-line
     :accessor command-line
     :documentation "A list of keys so far inserted by the user")
+   (echo-character
+    :initform nil
+    :initarg  :echo-character
+    :accessor echo-character
+    :documentation "If  non nil  print a number  of copies  (equals to
+  length  of  slot  'command-line'  of  this  string  instead  of  the
+  command-line itself")
    (error-message
     :initform nil
     :initarg  :error-message
@@ -159,23 +166,31 @@ be either `:keybinding' or `:string'.  the former for key command the latter for
                    (point-position point-position)
                    (point-bg       point-bg)
                    (point-fg       point-fg)
-                   (prompt         prompt)) win
+                   (prompt         prompt)
-    (let* ((length-cmd-line     (length command-line))
+                   (echo-character echo-character)) win
-           (no-prompt-point-pos (no-prompt-point-pos win))
+    (flet ((print-echo-character ()
-           (cursor-value    (if (and (> length-cmd-line 0)
+             (let ((echoed (with-output-to-string (stream)
-                                     (< no-prompt-point-pos
+                             (loop repeat (length command-line) do
-                                        length-cmd-line))
+                                  (princ echo-character stream)))))
-                                (elt command-line no-prompt-point-pos)
+               (print-text win echoed (length prompt) 0))))
-                                #\Space)))
+      (let* ((length-cmd-line     (length command-line))
-      (print-text win prompt 0 0)
+             (no-prompt-point-pos (no-prompt-point-pos win))
-      (when command-line
+             (cursor-value    (if (and (> length-cmd-line 0)
-        (print-text win command-line (length prompt) 0))
+                                       (< no-prompt-point-pos
-      (print-text win
+                                          length-cmd-line))
-                  cursor-value
+                                  (elt command-line no-prompt-point-pos)
-                  point-position
+                                  #\Space)))
-                  0
+        (print-text win prompt 0 0)
-                  :fgcolor point-fg
+        (when command-line
-                  :bgcolor point-bg))))
+          (if echo-character
+              (print-echo-character)
+              (print-text win command-line (length prompt) 0)))
+        (print-text win
+                    cursor-value
+                    point-position
+                    0
+                    :fgcolor point-fg
+                    :bgcolor point-bg)))))
 
 (defmethod draw ((object command-window))
   (with-accessors ((command-line              command-line)

src/package.lisp

@@ -993,6 +993,7 @@
    :config-notification-life
    :config-server-name
    :config-username
+   :config-password-echo-character
    :config-win-focus-mark
    :thread-message-symbol
    :thread-message-read-colors
@@ -1784,6 +1785,7 @@
    :print-error
    :command-window
    :command-line
+   :echo-character
    :event-to-answer
    :prompt
    :add-error-message

src/program-events.lisp

@@ -172,6 +172,10 @@
     :initform nil
     :initarg  :initial-value
     :accessor initial-value)
+    (echo-character
+     :initform nil
+     :initarg  :echo-character
+     :accessor echo-character)
     (complete-fn
     :initform nil
     :initarg  :complete-fn
@@ -189,9 +193,10 @@
         (setf (priority object) (truncate (/ +standard-event-priority+ 2)))))
 
 (defmethod process-event ((object ask-user-input-string-event))
-  (with-accessors ((prompt        prompt)
+  (with-accessors ((prompt         prompt)
-                   (initial-value initial-value)
+                   (initial-value  initial-value)
-                   (complete-fn   complete-fn)) object
+                   (complete-fn    complete-fn)
+                   (echo-character echo-character)) object
     (setf (command-window:event-to-answer specials:*command-window*)
           object)
     (setf (point-tracker:prompt specials:*command-window*)
@@ -203,7 +208,9 @@
     (setf (command-window:command-line specials:*command-window*)
           initial-value)
     (point-tracker:move-point-to-end        specials:*command-window* initial-value)
-    (windows:draw                           specials:*command-window*)))
+    (setf (command-window:echo-character specials:*command-window*)
+          echo-character)
+    (windows:draw specials:*command-window*)))
 
 (defclass user-input-string-event (ask-user-input-string-event)
   ()
@@ -220,6 +227,8 @@
 (defmethod process-event ((object user-input-string-event))
   (with-accessors ((lock               lock)
                    (condition-variable condition-variable)) object
+    (setf (command-window:echo-character specials:*command-window*)
+          nil)
     (with-lock (lock)
       (bt:condition-notify condition-variable))))
 

src/software-configuration.lisp

@@ -399,6 +399,7 @@
                    input
                    read
                    unread
+                   password-echo-character
                    color-re
                    ignore-user-re
                    purge-history-days-offset
@@ -657,6 +658,9 @@
 (gen-simple-access (username)
                    +key-username+)
 
+(gen-simple-access (password-echo-character)
+                   +key-password-echo-character+)
+
 (defun config-win-focus-mark ()
   (values (access:accesses  *software-configuration*
                             +key-window+

src/tui-utils.lisp

@@ -155,7 +155,7 @@ as argument `complex-string'."
   (croatoan:concat-complex-string a b :color-attributes-contagion color-attributes-contagion))
 
 (defmethod cat-complex-string ((a complex-string) (b complex-string)
-                                  &key (color-attributes-contagion t))
+                                  &key (color-attributes-contagion nil))
   "Return a complex string that is the results of concatenating of `a'
   and  `b': two  `complex-string'. If  `color-attributes-contagion' is
   non nil `b' will inherit all the attributes and color of a."

src/ui-goodies.lisp

@@ -145,17 +145,21 @@
 
 (defun ask-string-input (on-input-complete-fn
                          &key
-                           (priority      nil)
+                           (hide-input      nil)
-                           (initial-value nil)
+                           (priority        nil)
-                           (prompt        +default-command-prompt+)
+                           (initial-value   nil)
-                           (complete-fn   #'complete:directory-complete))
+                           (prompt          +default-command-prompt+)
+                           (complete-fn     #'complete:directory-complete))
   (flet ((thread-fn ()
-           (let ((event (make-instance 'ask-user-input-string-event
+           (let* ((password-echo (and hide-input
-                                       :forced-priority priority
+                                      (swconf:config-password-echo-character)))
-                                       :initial-value   initial-value
+                  (event         (make-instance 'ask-user-input-string-event
-                                       :complete-fn     complete-fn
+                                                :echo-character  password-echo
-                                       :prompt          prompt
+                                                :forced-priority priority
-                                       :payload         (box:dbox nil))))
+                                                :initial-value   initial-value
+                                                :complete-fn     complete-fn
+                                                :prompt          prompt
+                                                :payload         (box:dbox nil))))
              (with-accessors ((lock               lock)
                               (condition-variable condition-variable)) event
                (push-event event)