mirror of https://codeberg.org/cage/tinmop/
- [GUI] added code to deal with query input (status 10 and 11).
This commit is contained in:
parent
d4a871d769
commit
fa6844a2ab
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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")
|
||||
|
|
|
@ -3358,7 +3358,8 @@
|
|||
:with-entry-text-validate
|
||||
:attach-tooltip
|
||||
:attach-tooltips
|
||||
:with-busy*))
|
||||
:with-busy*
|
||||
:password-dialog))
|
||||
|
||||
(defpackage :client-menu-command
|
||||
(:use
|
||||
|
|
Loading…
Reference in New Issue