mirror of https://codeberg.org/cage/tinmop/
- [GUI] printed information when streaming is started or finished;
- [GUI] increased width of bookmark window.
This commit is contained in:
cage
parent
2829c7f4a3
commit
91e6298e7c
|
|
@ -436,30 +436,35 @@
|
|||
:fragment (percent-encode-fragment fragment)))
|
||||
(ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
|
||||
(cl+ssl:with-global-context (ctx :auto-free-p t)
|
||||
(let* ((socket (open-tls-socket host port))
|
||||
(stream (usocket:socket-stream socket))
|
||||
(ssl-hostname (if (or (iri:ipv4-address-p host)
|
||||
(iri:ipv6-address-p host))
|
||||
nil
|
||||
host))
|
||||
(ssl-stream (cl+ssl:make-ssl-client-stream stream
|
||||
:certificate client-certificate
|
||||
:key certificate-key
|
||||
:external-format nil ; unsigned byte 8
|
||||
:unwrap-stream-p t
|
||||
:verify nil
|
||||
:hostname ssl-hostname))
|
||||
(request (format nil "~a~a~a" iri #\return #\newline))
|
||||
(cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream))))
|
||||
(debug-gemini "sending request ~a" request)
|
||||
(if (not (db:tofu-passes-p host cert-hash))
|
||||
(error 'gemini-tofu-error :host host)
|
||||
(progn
|
||||
(write-sequence (string->octets request) ssl-stream)
|
||||
(force-output ssl-stream)
|
||||
(multiple-value-bind (status description meta response)
|
||||
(parse-response ssl-stream)
|
||||
(values status description meta response socket))))))))
|
||||
(let ((socket (open-tls-socket host port)))
|
||||
(when hooks:*after-gemini-socket*
|
||||
(hooks:run-hooks 'hooks:*after-gemini-socket*))
|
||||
(let* ((stream (usocket:socket-stream socket))
|
||||
(ssl-hostname (if (or (iri:ipv4-address-p host)
|
||||
(iri:ipv6-address-p host))
|
||||
nil
|
||||
host))
|
||||
(ssl-stream (cl+ssl:make-ssl-client-stream stream
|
||||
:certificate client-certificate
|
||||
:key certificate-key
|
||||
:external-format nil ; unsigned byte 8
|
||||
:unwrap-stream-p t
|
||||
:verify nil
|
||||
:hostname ssl-hostname))
|
||||
(request (format nil "~a~a~a" iri #\return #\newline))
|
||||
(cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream))))
|
||||
(debug-gemini "sending request ~a" request)
|
||||
(if (not (db:tofu-passes-p host cert-hash))
|
||||
(error 'gemini-tofu-error :host host)
|
||||
(progn
|
||||
(write-sequence (string->octets request) ssl-stream)
|
||||
(force-output ssl-stream)
|
||||
(misc:dbg "client hook ~a" hooks:*after-gemini-request-sent*)
|
||||
(when hooks:*after-gemini-request-sent*
|
||||
(hooks:run-hooks 'hooks:*after-gemini-request-sent*))
|
||||
(multiple-value-bind (status description meta response)
|
||||
(parse-response ssl-stream)
|
||||
(values status description meta response socket)))))))))
|
||||
|
||||
(defun missing-dispath-function (status code-description meta response socket iri parsed-iri)
|
||||
(declare (ignore response socket parsed-iri))
|
||||
|
|
|
|||
|
|
@ -27,12 +27,31 @@
|
|||
(description-text nil))
|
||||
(gui:with-toplevel (toplevel :master master :title (_ "Streams"))
|
||||
(gui:transient toplevel master)
|
||||
(let* ((iri-label (make-instance 'gui:label :master toplevel :text (_ "Address")))
|
||||
(section-label (make-instance 'gui:label :master toplevel :text (_ "Section")))
|
||||
(description-label (make-instance 'gui:label :master toplevel :text (_ "Description")))
|
||||
(iri-entry (make-instance 'gui:entry :master toplevel :text iri))
|
||||
(section-entry (make-instance 'gui:entry :master toplevel :text section-text))
|
||||
(description-entry (make-instance 'gui:entry :master toplevel :text description-text))
|
||||
(let* ((entries-width (gui-goodies:quite-good-dialog-width))
|
||||
(iri-label (make-instance 'gui:label
|
||||
:width entries-width
|
||||
:master toplevel
|
||||
:text (_ "Address")))
|
||||
(section-label (make-instance 'gui:label
|
||||
:width entries-width
|
||||
:master toplevel
|
||||
:text (_ "Section")))
|
||||
(description-label (make-instance 'gui:label
|
||||
:width entries-width
|
||||
:master toplevel
|
||||
:text (_ "Description")))
|
||||
(iri-entry (make-instance 'gui:entry
|
||||
:width entries-width
|
||||
:master toplevel
|
||||
:text iri))
|
||||
(section-entry (make-instance 'gui:entry
|
||||
:width entries-width
|
||||
:master toplevel
|
||||
:text section-text))
|
||||
(description-entry (make-instance 'gui:entry
|
||||
:width entries-width
|
||||
:master toplevel
|
||||
:text description-text))
|
||||
(buttons-frame (make-instance 'gui:frame :master toplevel))
|
||||
(add-button (make-instance 'gui:button
|
||||
:master buttons-frame
|
||||
|
|
@ -117,8 +136,7 @@
|
|||
:command (update-bookmark-clsr toplevel
|
||||
searchbox
|
||||
bookmarks))))
|
||||
(let ((searchbox-width (truncate (min (/ (gui:screen-width) 2
|
||||
(gui:font-measure gui:+tk-text-font+ "0"))))))
|
||||
(let ((searchbox-width (gui-goodies:quite-good-dialog-width)))
|
||||
(gui:configure (gui:listbox searchbox) :width searchbox-width))
|
||||
(gui:grid searchbox 0 0 :padx (* 2 +minimum-padding+) :pady (* 2 +minimum-padding+))
|
||||
(gui:grid delete-button 0 0 :sticky :s)
|
||||
|
|
|
|||
|
|
@ -127,3 +127,9 @@
|
|||
:accessor rows
|
||||
:initform '()
|
||||
:initarg :rows)))
|
||||
|
||||
(defun quite-good-dialog-width (&optional (chars-unit t))
|
||||
(if chars-unit
|
||||
(truncate (min (/ (gui:screen-width) 2
|
||||
(gui:font-measure gui:+tk-text-font+ "0"))))
|
||||
(truncate (/ (gui:screen-width) 2))))
|
||||
|
|
|
|||
|
|
@ -154,6 +154,7 @@
|
|||
next-start-fetching))))))))
|
||||
(loop-fetch)
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(print-info-message (_ "Stream finished"))
|
||||
(render-toc main-window iri))
|
||||
(if (cev:enqueue-request-and-wait-results :gemini-bookmarked-p
|
||||
1
|
||||
|
|
@ -181,6 +182,7 @@
|
|||
(push-db-stream stream-wrapper))
|
||||
(flet ((aborting-function ()
|
||||
(eq (status stream-wrapper) +stream-status-canceled+)))
|
||||
(print-info-message (_ "Stream started"))
|
||||
(let ((stream-thread (bt:make-thread (lambda ()
|
||||
(slurp-gemini-stream main-window
|
||||
iri
|
||||
|
|
|
|||
|
|
@ -33,8 +33,7 @@
|
|||
:pack '(:side :top :expand t :fill :both)
|
||||
:columns (list (_ "Description")))))
|
||||
(setf tree treeview)
|
||||
(gui:treeview-heading tree gui:+treeview-first-column-id+
|
||||
:text (_ "Address"))
|
||||
(gui:treeview-heading tree gui:+treeview-first-column-id+ :text (_ "Address"))
|
||||
(resync-rows object new-rows)
|
||||
object)))
|
||||
|
||||
|
|
|
|||
|
|
@ -127,3 +127,9 @@ open the links")
|
|||
|
||||
(defparameter *after-delete-char-from-command-window* '()
|
||||
"Run this hooks after deleting a character from the input of the command-window.")
|
||||
|
||||
(defparameter *after-gemini-socket* '()
|
||||
"Run these hooks after a gemini socket has been estabilshed")
|
||||
|
||||
(defparameter *after-gemini-request-sent* '()
|
||||
"Run these hooks after a gemini request has been sent")
|
||||
|
|
|
|||
|
|
@ -1856,7 +1856,9 @@
|
|||
:*before-displaying-links-hook*
|
||||
:*after-char-to-command-window*
|
||||
:*before-fire-string-event-command-window*
|
||||
:*after-delete-char-from-command-window*))
|
||||
:*after-delete-char-from-command-window*
|
||||
:*after-gemini-socket*
|
||||
:*after-gemini-request-sent*))
|
||||
|
||||
(defpackage :keybindings
|
||||
(:use
|
||||
|
|
@ -3389,7 +3391,8 @@
|
|||
:password-dialog
|
||||
:table-frame
|
||||
:tree
|
||||
:rows))
|
||||
:rows
|
||||
:quite-good-dialog-width))
|
||||
|
||||
(defpackage :client-menu-command
|
||||
(:use
|
||||
|
|
|
|||
Loading…
Reference in New Issue