mirror of https://codeberg.org/cage/tinmop/
- [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
parent
ac32e27fcc
commit
ad67612478
|
|
@ -520,7 +520,6 @@
|
|||
(download-stream download-stream)
|
||||
(octect-count octect-count)
|
||||
(support-file support-file)) wrapper-object
|
||||
|
||||
(lambda ()
|
||||
(when-let ((extension (fs:get-extension path)))
|
||||
(setf support-file (fs:temporary-file :extension extension)))
|
||||
|
|
|
|||
|
|
@ -112,10 +112,10 @@
|
|||
(with-notify-errors
|
||||
(apply #'comm:make-request method-name id args))))
|
||||
|
||||
(defun slurp-gemini-stream (iri &key
|
||||
(use-cache t)
|
||||
(process-function #'identity)
|
||||
(aborting-function (constantly nil)))
|
||||
(defun slurp-gemini-stream (iri stream-wrapper &key
|
||||
(use-cache t)
|
||||
(process-function #'identity)
|
||||
(aborting-function (constantly nil)))
|
||||
(enqueue-request-notify-error :gemini-request 1 iri use-cache)
|
||||
(labels ((stream-exausted-p ()
|
||||
(let ((status-completed (enqueue-request-notify-error :gemini-stream-completed-p
|
||||
|
|
@ -135,7 +135,7 @@
|
|||
nil))
|
||||
(next-start-fetching (length 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
|
||||
next-start-fetching))))))))
|
||||
(loop-fetch)))
|
||||
|
|
@ -158,6 +158,7 @@
|
|||
(eq (status stream-wrapper) +stream-status-canceled+)))
|
||||
(let ((stream-thread (bt:make-thread (lambda ()
|
||||
(slurp-gemini-stream iri
|
||||
stream-wrapper
|
||||
:use-cache use-cache
|
||||
:process-function
|
||||
process-function
|
||||
|
|
@ -483,6 +484,36 @@
|
|||
:query encoded-input
|
||||
: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+))
|
||||
(let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request
|
||||
1
|
||||
|
|
@ -534,21 +565,23 @@
|
|||
((gemini-client:header-success-p status-code)
|
||||
(cond
|
||||
((eq status +stream-status-streaming+)
|
||||
(let ((stopped-stream (maybe-stop-steaming-stream-thread)))
|
||||
(clean-gemtext main-window)
|
||||
(start-streaming-thread iri
|
||||
:use-cache nil
|
||||
:process-function
|
||||
(lambda (lines)
|
||||
;; this test ensures that the
|
||||
;; collecting events left on
|
||||
;; the queue won't be actually
|
||||
;; processed, just discarded
|
||||
(when (not (and stopped-stream
|
||||
(eq (status stopped-stream)
|
||||
+stream-status-canceled+)))
|
||||
(collect-ir-lines iri main-window lines)))
|
||||
:status status)))
|
||||
(if (gemini-client:gemini-file-stream-p meta)
|
||||
(progn
|
||||
(maybe-stop-steaming-stream-thread)
|
||||
(clean-gemtext main-window)
|
||||
(start-streaming-thread iri
|
||||
:use-cache nil
|
||||
:status status
|
||||
:process-function
|
||||
(lambda (stream-wrapper lines)
|
||||
;; this test ensures that the
|
||||
;; collecting events left on
|
||||
;; the queue won't be actually
|
||||
;; processed, just discarded
|
||||
(when (not (eq (status stream-wrapper)
|
||||
+stream-status-canceled+))
|
||||
(collect-ir-lines iri main-window lines)))))
|
||||
(slurp-non-text-data main-window iri)))
|
||||
((eq status +stream-status-downloading+)
|
||||
(when (not (find-db-stream-url iri))
|
||||
(enqueue-request-notify-error :gemini-request 1 iri use-cache)))
|
||||
|
|
|
|||
|
|
@ -43,6 +43,46 @@
|
|||
:contents (list :matches matched-strings
|
||||
: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)
|
||||
(declare (ignore iri))
|
||||
(multiple-value-bind (actual-iri host path query port fragment)
|
||||
|
|
@ -99,11 +139,11 @@
|
|||
actual-iri))
|
||||
(t
|
||||
(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
|
||||
:download-stream response
|
||||
:download-socket socket))
|
||||
(thread-fn (gemini-viewer::request-stream-other-document-thread gemini-stream
|
||||
(thread-fn (request-stream-other-document-thread gemini-stream
|
||||
socket
|
||||
host
|
||||
port
|
||||
|
|
@ -114,6 +154,7 @@
|
|||
code-description
|
||||
meta)))
|
||||
(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
|
||||
thread-fn
|
||||
host
|
||||
|
|
@ -180,15 +221,15 @@
|
|||
(gemini-client:debug-gemini "viewer requesting iri ~s" url)
|
||||
(let ((actual-iri (gemini-client:displace-iri (iri:iri-parse url))))
|
||||
(if use-cached-file-if-exists
|
||||
(progn
|
||||
(let ((cached-stream (gemini-viewer:find-db-stream-url actual-iri)))
|
||||
(gemini-client:debug-gemini "checking cache")
|
||||
(if (gemini-viewer:find-db-stream-url actual-iri)
|
||||
(if cached-stream
|
||||
(progn
|
||||
(gemini-client:debug-gemini "caching found for ~a" actual-iri)
|
||||
(gemini-viewer:push-url-to-history *gemini-window* actual-iri)
|
||||
(make-gemini-response (gemini-client:code gemini-client:+success+)
|
||||
(gemini-client:description gemini-client:+success+)
|
||||
nil
|
||||
(make-gemini-response (gw:status-code cached-stream)
|
||||
(gw:status-code-description cached-stream)
|
||||
(gw:meta cached-stream)
|
||||
actual-iri
|
||||
:cached t))
|
||||
(progn
|
||||
|
|
|
|||
Loading…
Reference in New Issue