mirror of https://codeberg.org/cage/tinmop/
- [GUI] fixed test for checking if a stream is exhausted;
- [RPC] force a maximum width for the TOC entry.
This commit is contained in:
parent
1d09d25082
commit
82de38f891
|
@ -118,14 +118,12 @@
|
||||||
(aborting-function (constantly nil)))
|
(aborting-function (constantly nil)))
|
||||||
(enqueue-request-notify-error :gemini-request 1 iri use-cache)
|
(enqueue-request-notify-error :gemini-request 1 iri use-cache)
|
||||||
(labels ((stream-exausted-p ()
|
(labels ((stream-exausted-p ()
|
||||||
(let ((status-completed (enqueue-request-notify-error :gemini-stream-completed-p
|
(let ((status-completed (cev:enqueue-request-and-wait-results :gemini-stream-completed-p
|
||||||
1
|
1
|
||||||
|
ev:+maximum-event-priority+
|
||||||
iri)))
|
iri)))
|
||||||
|
|
||||||
status-completed))
|
status-completed))
|
||||||
(loop-fetch (&optional (last-lines-fetched-count 0))
|
(loop-fetch (&optional (last-lines-fetched-count 0))
|
||||||
(when (not (or (funcall aborting-function)
|
|
||||||
(stream-exausted-p)))
|
|
||||||
(ev:with-enqueued-process-and-unblock ()
|
(ev:with-enqueued-process-and-unblock ()
|
||||||
(with-notify-errors
|
(with-notify-errors
|
||||||
(let* ((last-lines-fetched (comm:make-request :gemini-stream-parsed-line-slice
|
(let* ((last-lines-fetched (comm:make-request :gemini-stream-parsed-line-slice
|
||||||
|
@ -136,6 +134,9 @@
|
||||||
(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 stream-wrapper last-lines-fetched))
|
(funcall process-function stream-wrapper last-lines-fetched))
|
||||||
|
(when (not (or (funcall aborting-function)
|
||||||
|
(and (stream-exausted-p)
|
||||||
|
next-start-fetching)))
|
||||||
(loop-fetch (+ last-lines-fetched-count
|
(loop-fetch (+ last-lines-fetched-count
|
||||||
next-start-fetching))))))))
|
next-start-fetching))))))))
|
||||||
(loop-fetch)))
|
(loop-fetch)))
|
||||||
|
|
|
@ -408,7 +408,7 @@
|
||||||
(let ((status (gemini-stream-status iri)))
|
(let ((status (gemini-stream-status iri)))
|
||||||
(eq status :completed)))
|
(eq status :completed)))
|
||||||
|
|
||||||
(defun build-gemini-toc (iri)
|
(defun build-gemini-toc (iri width)
|
||||||
(a:when-let* ((ordered-headers-tag '(:h1 :h2 :h3))
|
(a:when-let* ((ordered-headers-tag '(:h1 :h2 :h3))
|
||||||
(stream-wrapper (gw:find-db-stream-url iri))
|
(stream-wrapper (gw:find-db-stream-url iri))
|
||||||
(parsed-lines (gw:parsed-lines stream-wrapper))
|
(parsed-lines (gw:parsed-lines stream-wrapper))
|
||||||
|
@ -464,7 +464,7 @@
|
||||||
for text in toc-entries-text
|
for text in toc-entries-text
|
||||||
collect
|
collect
|
||||||
(list :header-group-id (getf toc-entry :group-id)
|
(list :header-group-id (getf toc-entry :group-id)
|
||||||
:text text))
|
:text (ellipsize text width)))
|
||||||
toc)))))
|
toc)))))
|
||||||
|
|
||||||
(defclass gemini-toc (box) ())
|
(defclass gemini-toc (box) ())
|
||||||
|
@ -478,8 +478,9 @@
|
||||||
(loop for element in list do
|
(loop for element in list do
|
||||||
(json:encode-array-element element))))))
|
(json:encode-array-element element))))))
|
||||||
|
|
||||||
(defun gemini-table-of-contents (iri)
|
(defun gemini-table-of-contents (iri width)
|
||||||
(make-instance 'gemini-toc :contents (build-gemini-toc iri)))
|
(make-instance 'gemini-toc
|
||||||
|
:contents (build-gemini-toc iri width)))
|
||||||
|
|
||||||
(defmethod yason:encode ((object gemini-toc) &optional (stream *standard-output*))
|
(defmethod yason:encode ((object gemini-toc) &optional (stream *standard-output*))
|
||||||
(encode-flat-array-of-plists (unbox object) stream))
|
(encode-flat-array-of-plists (unbox object) stream))
|
||||||
|
|
Loading…
Reference in New Issue