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

- fixed 'loop-fetch'.

This commit is contained in:
cage 2024-09-29 14:55:54 +02:00
parent ac757ce4a6
commit 8230416499
2 changed files with 59 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/gemini/dummy-server.lisp
View File

@ -59,6 +59,21 @@ and key stored in the file pointed by the filesystem path
request
client-cert-fingerprint)
(cond
((cl-ppcre:scan "pause" request)
(let ((response (format nil
"~a text/gemini~a~a"
(code gemini-client::+20+)
#\return #\newline)))
(write-sequence (text-utils:string->octets response)
stream)
(loop for i from 0 below 100 do
(when (= i 10)
(sleep 1))
(write-sequence (text-utils:string->octets (format nil "~a~%" i))
stream)
(finish-output stream))
(close stream)
(get-data)))
((cl-ppcre:scan "slow" request)
(format t "slow...~%")
(let ((response (format nil
@ -79,6 +94,21 @@ and key stored in the file pointed by the filesystem path
((cl-ppcre:scan "timeout" request)
(format t "timeout...~%")
(sleep 3600))
((cl-ppcre:scan "empty-response" request)
(close stream)
(format t "empty response.~%")
(get-data))
((cl-ppcre:scan "empty-body-response" request)
(format t "empty-body...~%")
(let ((response (format nil
"~a text/gemini~a~a"
(code gemini-client::+20+)
#\return #\newline)))
(format t "sending: ~a~%" response)
(write-sequence (text-utils:string->octets response)
stream)
(close stream)
(get-data)))
((null client-cert-fingerprint)
(let ((response (format nil
"~a please provide a certificate~a~a"

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

@ -163,29 +163,36 @@
nil)
nil)))
(fetch-latest-lines (iri last-lines-fetched-count)
(gui-goodies:with-notify-errors
(handler-case
(cev:enqueue-request-and-wait-results :gemini-stream-parsed-line-slice
1
ev:+standard-event-priority+
iri
last-lines-fetched-count ; start slice
nil))) ; end slice
(loop-fetch (&optional (last-lines-fetched-count 0))
(let* ((last-lines-fetched (fetch-latest-lines iri last-lines-fetched-count))
(next-start-fetching (length last-lines-fetched)))
(misc:dbg "loop fetch ~a ~a" iri last-lines-fetched-count)
(loop while (not (or (funcall aborting-function)
(and (stream-exausted-p)
(<= next-start-fetching 0))))
nil) ; end slice
(error (e)
(ev:with-enqueued-process-and-unblock ()
(gui-goodies:error-dialog main-window e)))))
(loop-fetch ()
(let* ((last-lines-fetched (fetch-latest-lines iri 0))
(last-lines-fetched-count (length last-lines-fetched)))
(loop named fetching
while (not (funcall aborting-function))
do
(progn
(when last-lines-fetched
(ev:with-enqueued-process-and-unblock ()
(gui-goodies:with-notify-errors
(funcall process-function stream-wrapper last-lines-fetched))))
(setf last-lines-fetched (fetch-latest-lines iri last-lines-fetched-count))
(setf next-start-fetching (length last-lines-fetched))
(incf last-lines-fetched-count next-start-fetching)))
(let* ((stream-finished (stream-exausted-p))
(new-lines-fetched (fetch-latest-lines iri
last-lines-fetched-count))
(new-line-fetched-count (length new-lines-fetched)))
(if (and (= new-line-fetched-count 0)
stream-finished)
(return-from fetching t)
(progn
(setf last-lines-fetched new-lines-fetched)
(incf last-lines-fetched-count new-line-fetched-count)))))
(ev:with-enqueued-process-and-unblock ()
(gui-goodies:with-notify-errors
(perform-after-stream-exausted-actions))))))