cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [GUI] printed information when streaming is started or finished; 

- [GUI] increased width of bookmark window.
This commit is contained in:
cage 2023-04-14 17:13:41 +02:00
parent 2829c7f4a3
commit 91e6298e7c
7 changed files with 75 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
src/gemini/client.lisp
View File

@ -436,30 +436,35 @@
:fragment (percent-encode-fragment fragment))) :fragment (percent-encode-fragment fragment)))
(ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+))) (ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+)))
(cl+ssl:with-global-context (ctx :auto-free-p t) (cl+ssl:with-global-context (ctx :auto-free-p t)
(let* ((socket (open-tls-socket host port)) (let ((socket (open-tls-socket host port)))
(stream (usocket:socket-stream socket)) (when hooks:*after-gemini-socket*
(ssl-hostname (if (or (iri:ipv4-address-p host) (hooks:run-hooks 'hooks:*after-gemini-socket*))
(iri:ipv6-address-p host)) (let* ((stream (usocket:socket-stream socket))
nil (ssl-hostname (if (or (iri:ipv4-address-p host)
host)) (iri:ipv6-address-p host))
(ssl-stream (cl+ssl:make-ssl-client-stream stream nil
:certificate client-certificate host))
:key certificate-key (ssl-stream (cl+ssl:make-ssl-client-stream stream
:external-format nil ; unsigned byte 8 :certificate client-certificate
:unwrap-stream-p t :key certificate-key
:verify nil :external-format nil ; unsigned byte 8
:hostname ssl-hostname)) :unwrap-stream-p t
(request (format nil "~a~a~a" iri #\return #\newline)) :verify nil
(cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream)))) :hostname ssl-hostname))
(debug-gemini "sending request ~a" request) (request (format nil "~a~a~a" iri #\return #\newline))
(if (not (db:tofu-passes-p host cert-hash)) (cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream))))
(error 'gemini-tofu-error :host host) (debug-gemini "sending request ~a" request)
(progn (if (not (db:tofu-passes-p host cert-hash))
(write-sequence (string->octets request) ssl-stream) (error 'gemini-tofu-error :host host)
(force-output ssl-stream) (progn
(multiple-value-bind (status description meta response) (write-sequence (string->octets request) ssl-stream)
(parse-response ssl-stream) (force-output ssl-stream)
(values status description meta response socket)))))))) (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) (defun missing-dispath-function (status code-description meta response socket iri parsed-iri)
(declare (ignore response socket parsed-iri)) (declare (ignore response socket parsed-iri))

34
src/gui/client/bookmark-window.lisp
View File

@ -27,12 +27,31 @@
(description-text nil)) (description-text nil))
(gui:with-toplevel (toplevel :master master :title (_ "Streams")) (gui:with-toplevel (toplevel :master master :title (_ "Streams"))
(gui:transient toplevel master) (gui:transient toplevel master)
(let* ((iri-label (make-instance 'gui:label :master toplevel :text (_ "Address"))) (let* ((entries-width (gui-goodies:quite-good-dialog-width))
(section-label (make-instance 'gui:label :master toplevel :text (_ "Section"))) (iri-label (make-instance 'gui:label
(description-label (make-instance 'gui:label :master toplevel :text (_ "Description"))) :width entries-width
(iri-entry (make-instance 'gui:entry :master toplevel :text iri)) :master toplevel
(section-entry (make-instance 'gui:entry :master toplevel :text section-text)) :text (_ "Address")))
(description-entry (make-instance 'gui:entry :master toplevel :text description-text)) (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)) (buttons-frame (make-instance 'gui:frame :master toplevel))
(add-button (make-instance 'gui:button (add-button (make-instance 'gui:button
:master buttons-frame :master buttons-frame
@ -117,8 +136,7 @@
:command (update-bookmark-clsr toplevel :command (update-bookmark-clsr toplevel
searchbox searchbox
bookmarks)))) bookmarks))))
(let ((searchbox-width (truncate (min (/ (gui:screen-width) 2 (let ((searchbox-width (gui-goodies:quite-good-dialog-width)))
(gui:font-measure gui:+tk-text-font+ "0"))))))
(gui:configure (gui:listbox searchbox) :width searchbox-width)) (gui:configure (gui:listbox searchbox) :width searchbox-width))
(gui:grid searchbox 0 0 :padx (* 2 +minimum-padding+) :pady (* 2 +minimum-padding+)) (gui:grid searchbox 0 0 :padx (* 2 +minimum-padding+) :pady (* 2 +minimum-padding+))
(gui:grid delete-button 0 0 :sticky :s) (gui:grid delete-button 0 0 :sticky :s)

6
src/gui/client/gui-goodies.lisp
View File

@ -127,3 +127,9 @@
:accessor rows :accessor rows
:initform '() :initform '()
:initarg :rows))) :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))))

2
src/gui/client/main-window.lisp
View File

@ -154,6 +154,7 @@
next-start-fetching)))))))) next-start-fetching))))))))
(loop-fetch) (loop-fetch)
(ev:with-enqueued-process-and-unblock () (ev:with-enqueued-process-and-unblock ()
(print-info-message (_ "Stream finished"))
(render-toc main-window iri)) (render-toc main-window iri))
(if (cev:enqueue-request-and-wait-results :gemini-bookmarked-p (if (cev:enqueue-request-and-wait-results :gemini-bookmarked-p
1 1
@ -181,6 +182,7 @@
(push-db-stream stream-wrapper)) (push-db-stream stream-wrapper))
(flet ((aborting-function () (flet ((aborting-function ()
(eq (status stream-wrapper) +stream-status-canceled+))) (eq (status stream-wrapper) +stream-status-canceled+)))
(print-info-message (_ "Stream started"))
(let ((stream-thread (bt:make-thread (lambda () (let ((stream-thread (bt:make-thread (lambda ()
(slurp-gemini-stream main-window (slurp-gemini-stream main-window
iri iri

3
src/gui/client/tour-window.lisp
View File

@ -33,8 +33,7 @@
:pack '(:side :top :expand t :fill :both) :pack '(:side :top :expand t :fill :both)
:columns (list (_ "Description"))))) :columns (list (_ "Description")))))
(setf tree treeview) (setf tree treeview)
(gui:treeview-heading tree gui:+treeview-first-column-id+ (gui:treeview-heading tree gui:+treeview-first-column-id+ :text (_ "Address"))
:text (_ "Address"))
(resync-rows object new-rows) (resync-rows object new-rows)
object))) object)))

6
src/hooks.lisp
View File

@ -127,3 +127,9 @@ open the links")
(defparameter *after-delete-char-from-command-window* '() (defparameter *after-delete-char-from-command-window* '()
"Run this hooks after deleting a character from the input of the 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")

7
src/package.lisp
View File

@ -1856,7 +1856,9 @@
:*before-displaying-links-hook* :*before-displaying-links-hook*
:*after-char-to-command-window* :*after-char-to-command-window*
:*before-fire-string-event-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 (defpackage :keybindings
(:use (:use
@ -3389,7 +3391,8 @@
:password-dialog :password-dialog
:table-frame :table-frame
:tree :tree
:rows)) :rows
:quite-good-dialog-width))
(defpackage :client-menu-command (defpackage :client-menu-command
(:use (:use