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

- [GUI] fixed discarding rendering of lines coming from a stopped stream; 

- [GUI] added downloading and opening of non text data.
This commit is contained in:
cage 2023-03-15 17:18:38 +01:00
parent ac32e27fcc
commit ad67612478
3 changed files with 101 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/gemini-viewer.lisp
View File

@ -520,7 +520,6 @@
(download-stream download-stream) (download-stream download-stream)
(octect-count octect-count) (octect-count octect-count)
(support-file support-file)) wrapper-object (support-file support-file)) wrapper-object
(lambda () (lambda ()
(when-let ((extension (fs:get-extension path))) (when-let ((extension (fs:get-extension path)))
(setf support-file (fs:temporary-file :extension extension))) (setf support-file (fs:temporary-file :extension extension)))

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

@ -112,7 +112,7 @@
(with-notify-errors (with-notify-errors
(apply #'comm:make-request method-name id args)))) (apply #'comm:make-request method-name id args))))
(defun slurp-gemini-stream (iri &key (defun slurp-gemini-stream (iri stream-wrapper &key
(use-cache t) (use-cache t)
(process-function #'identity) (process-function #'identity)
(aborting-function (constantly nil))) (aborting-function (constantly nil)))
@ -135,7 +135,7 @@
nil)) nil))
(next-start-fetching (length last-lines-fetched))) (next-start-fetching (length last-lines-fetched)))
(when last-lines-fetched (when last-lines-fetched
(funcall process-function last-lines-fetched)) (funcall process-function stream-wrapper last-lines-fetched))
(loop-fetch (+ last-lines-fetched-count (loop-fetch (+ last-lines-fetched-count
next-start-fetching)))))))) next-start-fetching))))))))
(loop-fetch))) (loop-fetch)))
@ -158,6 +158,7 @@
(eq (status stream-wrapper) +stream-status-canceled+))) (eq (status stream-wrapper) +stream-status-canceled+)))
(let ((stream-thread (bt:make-thread (lambda () (let ((stream-thread (bt:make-thread (lambda ()
(slurp-gemini-stream iri (slurp-gemini-stream iri
stream-wrapper
:use-cache use-cache :use-cache use-cache
:process-function :process-function
process-function process-function
@ -483,6 +484,36 @@
:query encoded-input :query encoded-input
:port port)))) :port port))))
(defun slurp-non-text-data (main-window iri)
(labels ((maybe-open-if-completed (stream-info support-file)
(if (string-equal (getf stream-info :stream-status)
:completed)
(client-os-utils:open-resource-with-external-program main-window support-file)
(wait-enough-data)))
(wait-enough-data ()
(let* ((stream-info
(cev:enqueue-request-and-wait-results :gemini-stream-info
1
ev:+maximum-event-priority+
iri))
(read-so-far (getf stream-info :octect-count -1))
(support-file (getf stream-info :support-file)))
(multiple-value-bind (program-exists y wait-for-download)
(swconf:link-regex->program-to-use support-file)
(declare (ignore y))
(if program-exists
(if wait-for-download
(maybe-open-if-completed stream-info support-file)
(let ((buffer-size (swconf:link-regex->program-to-use-buffer-size support-file)))
(if (or (and buffer-size
(> read-so-far buffer-size))
(> read-so-far
swconf:+buffer-minimum-size-to-open+))
(client-os-utils:open-resource-with-external-program main-window support-file)
(wait-enough-data))))
(maybe-open-if-completed stream-info support-file))))))
(wait-enough-data)))
(defun start-stream-iri (iri main-window use-cache &optional (status +stream-status-streaming+)) (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 (let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request
1 1
@ -534,21 +565,23 @@
((gemini-client:header-success-p status-code) ((gemini-client:header-success-p status-code)
(cond (cond
((eq status +stream-status-streaming+) ((eq status +stream-status-streaming+)
(let ((stopped-stream (maybe-stop-steaming-stream-thread))) (if (gemini-client:gemini-file-stream-p meta)
(progn
(maybe-stop-steaming-stream-thread)
(clean-gemtext main-window) (clean-gemtext main-window)
(start-streaming-thread iri (start-streaming-thread iri
:use-cache nil :use-cache nil
:status status
:process-function :process-function
(lambda (lines) (lambda (stream-wrapper lines)
;; this test ensures that the ;; this test ensures that the
;; collecting events left on ;; collecting events left on
;; the queue won't be actually ;; the queue won't be actually
;; processed, just discarded ;; processed, just discarded
(when (not (and stopped-stream (when (not (eq (status stream-wrapper)
(eq (status stopped-stream) +stream-status-canceled+))
+stream-status-canceled+))) (collect-ir-lines iri main-window lines)))))
(collect-ir-lines iri main-window lines))) (slurp-non-text-data main-window iri)))
:status status)))
((eq status +stream-status-downloading+) ((eq status +stream-status-downloading+)
(when (not (find-db-stream-url iri)) (when (not (find-db-stream-url iri))
(enqueue-request-notify-error :gemini-request 1 iri use-cache))) (enqueue-request-notify-error :gemini-request 1 iri use-cache)))

55
src/gui/server/public-api-gemini-stream.lisp
View File

@ -43,6 +43,46 @@
:contents (list :matches matched-strings :contents (list :matches matched-strings
:indices indices))))) :indices indices)))))
(defun request-stream-other-document-thread (wrapper-object
socket
host
port
path
query
fragment
status-code
status-code-description
meta)
(declare (ignorable host
port path query fragment
status-code status-code-description meta))
(with-accessors ((download-socket gemini-viewer:download-socket)
(download-stream gemini-viewer:download-stream)
(octect-count gemini-viewer:octect-count)
(support-file gemini-viewer:support-file)) wrapper-object
(lambda ()
(a:when-let ((extension (fs:get-extension path)))
(setf support-file (fs:temporary-file :extension extension)))
(gemini-viewer::with-open-support-file (file-stream support-file)
(labels ((download-completed-p (buffer read-so-far)
(and buffer
(< read-so-far (length buffer))))
(%fill-buffer ()
(when (gemini-viewer:downloading-allowed-p wrapper-object)
(multiple-value-bind (buffer read-so-far)
(ignore-errors (read-array download-stream
gemini-viewer::+read-buffer-size+))
(gemini-viewer::increment-bytes-count wrapper-object read-so-far)
(write-sequence buffer file-stream :start 0 :end read-so-far)
(force-output file-stream)
(misc:dbg "letti ~a" read-so-far)
(if (download-completed-p buffer read-so-far)
(progn
(setf (gemini-viewer:stream-status wrapper-object) :completed)
(gemini-client:close-ssl-socket socket))
(%fill-buffer))))))
(%fill-buffer))))))
(defun request-success-dispatched-fn (status code-description meta response socket iri parsed-iri) (defun request-success-dispatched-fn (status code-description meta response socket iri parsed-iri)
(declare (ignore iri)) (declare (ignore iri))
(multiple-value-bind (actual-iri host path query port fragment) (multiple-value-bind (actual-iri host path query port fragment)
@ -99,11 +139,11 @@
actual-iri)) actual-iri))
(t (t
(let* ((starting-status :streaming) (let* ((starting-status :streaming)
(gemini-stream (make-instance 'gemini-others-data-stream (gemini-stream (make-instance 'gemini-viewer::gemini-others-data-stream
:stream-status starting-status :stream-status starting-status
:download-stream response :download-stream response
:download-socket socket)) :download-socket socket))
(thread-fn (gemini-viewer::request-stream-other-document-thread gemini-stream (thread-fn (request-stream-other-document-thread gemini-stream
socket socket
host host
port port
@ -114,6 +154,7 @@
code-description code-description
meta))) meta)))
(gemini-client:debug-gemini "response is *not* a gemini file stream") (gemini-client:debug-gemini "response is *not* a gemini file stream")
(gemini-viewer:push-db-stream gemini-stream)
(gemini-viewer::downloading-start-thread gemini-stream (gemini-viewer::downloading-start-thread gemini-stream
thread-fn thread-fn
host host
@ -180,15 +221,15 @@
(gemini-client:debug-gemini "viewer requesting iri ~s" url) (gemini-client:debug-gemini "viewer requesting iri ~s" url)
(let ((actual-iri (gemini-client:displace-iri (iri:iri-parse url)))) (let ((actual-iri (gemini-client:displace-iri (iri:iri-parse url))))
(if use-cached-file-if-exists (if use-cached-file-if-exists
(progn (let ((cached-stream (gemini-viewer:find-db-stream-url actual-iri)))
(gemini-client:debug-gemini "checking cache") (gemini-client:debug-gemini "checking cache")
(if (gemini-viewer:find-db-stream-url actual-iri) (if cached-stream
(progn (progn
(gemini-client:debug-gemini "caching found for ~a" actual-iri) (gemini-client:debug-gemini "caching found for ~a" actual-iri)
(gemini-viewer:push-url-to-history *gemini-window* actual-iri) (gemini-viewer:push-url-to-history *gemini-window* actual-iri)
(make-gemini-response (gemini-client:code gemini-client:+success+) (make-gemini-response (gw:status-code cached-stream)
(gemini-client:description gemini-client:+success+) (gw:status-code-description cached-stream)
nil (gw:meta cached-stream)
actual-iri actual-iri
:cached t)) :cached t))
(progn (progn