From fa6844a2abf051ce6bb4be1cb84d665579d3cf7b Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
Date: Sun, 12 Mar 2023 12:35:01 +0100
Subject: [PATCH] - [GUI] added code to deal with query input (status 10 and
 11).

---
 src/gemini/package.lisp         |  1 +
 src/gui/client/gui-goodies.lisp | 21 +++++++++++++++++++++
 src/gui/client/main-window.lisp | 31 +++++++++++++++++++++++++++++++
 src/package.lisp                |  3 ++-
 4 files changed, 55 insertions(+), 1 deletion(-)

diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp
index b61a088..a21ee62 100644
--- a/src/gemini/package.lisp
+++ b/src/gemini/package.lisp
@@ -152,6 +152,7 @@
    :header-permanent-failure-p
    :header-certificate-failure-p
    :header-certificate-requested-p
+   :header-input-request-p
    :header-input-p
    :header-sensitive-input-p
    :gemini-protocol-error
diff --git a/src/gui/client/gui-goodies.lisp b/src/gui/client/gui-goodies.lisp
index 9313b80..46acaa5 100644
--- a/src/gui/client/gui-goodies.lisp
+++ b/src/gui/client/gui-goodies.lisp
@@ -96,3 +96,24 @@
      (with-busy (,root-widget)
        (with-hourglass ,(list root-widget)
          ,@body))))
+
+(defun password-dialog (parent title message &key (button-message "OK"))
+  (let ((res nil))
+    (gui:with-modal-toplevel (toplevel :title title)
+      (gui:transient toplevel parent)
+      (let* ((widget    (make-instance 'gui-mw:password-entry
+                                       :show-password nil
+                                       :master        toplevel))
+             (label     (make-instance 'gui:label
+                                       :master toplevel
+                                       :text   message))
+             (ok-button (make-instance 'gui:button
+                                       :text   button-message
+                                       :master toplevel
+                                       :command (lambda ()
+                                                  (setf res (gui-mw:secret-string widget))
+                                                  (gui:break-mainloop)))))
+        (gui:grid label     0 0 :sticky :news)
+        (gui:grid widget    1 0 :sticky :news)
+        (gui:grid ok-button 1 1 :sticky :news)))
+    res))
diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp
index 29b0843..d03d50e 100644
--- a/src/gui/client/main-window.lisp
+++ b/src/gui/client/main-window.lisp
@@ -461,6 +461,30 @@
     (error (e)
       (notify-request-error e))))
 
+(defun get-user-request-query (iri meta main-window &key (sensitive nil))
+  (let* ((parsed-iri    (iri:iri-parse iri))
+         (prompt        (format nil
+                                (_ "The server asks:~2%~a")
+                                meta))
+         (button-label  (_ "Submit"))
+         (dialog-title  (_ "Input query"))
+         (dialog-function (if sensitive
+                              #'gui-goodies:password-dialog
+                              #'gui-mw:text-input-dialog))
+         (raw-input     (funcall dialog-function
+                                 main-window
+                                 dialog-title
+                                 prompt
+                                 :button-message button-label))
+         (encoded-input (maybe-percent-encode raw-input)))
+    (multiple-value-bind (actual-iri host path query port fragment)
+        (gemini-client:displace-iri parsed-iri)
+      (declare (ignore actual-iri query fragment))
+      (gemini-parser:make-gemini-iri host
+                                     path
+                                     :query encoded-input
+                                     :port  port))))
+
 (defun start-stream-iri (iri main-window use-cache &optional (status +stream-status-streaming+))
   (let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request
                                                                    1
@@ -473,7 +497,14 @@
                            cached
                            original-iri)
         (displace-gemini-response connecting-response)
+      (declare (ignore original-iri cached))
       (cond
+        ((gemini-client:header-input-p status-code)
+         (let ((actual-iri (get-user-request-query iri meta main-window)))
+           (start-stream-iri actual-iri main-window nil)))
+        ((gemini-client:header-sensitive-input-p status-code)
+         (let ((actual-iri (get-user-request-query iri meta main-window :sensitive t)))
+           (start-stream-iri actual-iri main-window nil)))
         ((= status-code comm:+tofu-error-status-code+)
          (when (gui:ask-yesno meta
                               :title (_ "Server certificate error")
diff --git a/src/package.lisp b/src/package.lisp
index 393e0f0..27016ca 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -3358,7 +3358,8 @@
    :with-entry-text-validate
    :attach-tooltip
    :attach-tooltips
-   :with-busy*))
+   :with-busy*
+   :password-dialog))
 
 (defpackage :client-menu-command
   (:use