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

- [GUI] fixed rendering of gemtext's slices 

Rendering was working only when the  whole gemtext was received in a
  single block  over the net.  If not  the rendering code  printed the
  text lines out of order or even replicating the first lines.
This commit is contained in:
cage 2023-06-30 14:45:54 +02:00
parent 3d642b4531
commit 6335419058
1 changed files with 41 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -136,7 +136,7 @@
(funcall process-function stream-wrapper last-lines-fetched))
(when (not (or (funcall aborting-function)
(and (stream-exausted-p)
next-start-fetching)))
(<= next-start-fetching 0))))
(loop-fetch (+ last-lines-fetched-count
next-start-fetching))))))))
(loop-fetch)
@ -561,7 +561,7 @@
(incf skip-index (length emoji-code-points)))
(incf skip-index)))))))
(defun render-ir-lines (request-iri main-window)
(defun render-ir-lines (request-iri main-window &key (starting-index 0))
(with-accessors ((ir-lines ir-lines)
(ir-rendered-lines ir-rendered-lines)
(gemtext-font-scaling gemtext-font-scaling)
@ -614,17 +614,17 @@
(gui-conf:gemini-quote-justification))
((:pre :pre-end :as-is)
(gui-conf:gemini-preformatted-text-justification))))
(render-link (line line-number)
(render-link (line link-rendered-label line-number)
(multiple-value-bind (link-bg link-fg)
(gui-conf:gemini-link-colors)
(let ((link-font (scale-font (gui-conf:gemini-link-font-configuration)
gemtext-font-scaling)))
(multiple-value-bind (link-rendered-label link-name link-value)
(multiple-value-bind (x link-name link-value)
(linkify line)
(declare (ignore x))
(let ((target-iri (absolutize-link request-iri link-value))
(new-text-line-start `(:line ,line-number :char 0)))
(vector-push-extend link-rendered-label ir-rendered-lines)
(gui:append-text gemtext-widget (a:last-elt ir-rendered-lines))
(gui:append-text gemtext-widget link-rendered-label)
(let ((tag-link (gui:make-link-button gemtext-widget
new-text-line-start
`(- :end 1 :chars)
@ -667,12 +667,10 @@
;; does not works because of a TK bug
;;(colorize-emoji main-window (1- line-number))
(gui:tag-lower gemtext-widget tag))))))
(loop with render-line-count = 0
with starting-pre-block-line = -1
with ending-pre-block-line = -1
(loop with render-line-count = starting-index
with current-pre-block-alt-text = nil
for rendered-line across ir-rendered-lines
for ir-line across ir-lines
for rendered-line across (subseq ir-rendered-lines starting-index)
for ir-line across (subseq ir-lines starting-index)
do
(let ((type (ir-type ir-line)))
(ecase (format-keyword type)
@ -711,19 +709,17 @@
(render-line :quote rendered-line render-line-count))
(:pre
(incf render-line-count)
(setf starting-pre-block-line (1+ render-line-count))
(setf current-pre-block-alt-text (ir-pre-alt-text ir-line))
(render-line :pre
rendered-line
render-line-count
:wrap :none))
(:pre-end
(setf ending-pre-block-line (1+ render-line-count))
(incf render-line-count)
(render-line :pre-end rendered-line render-line-count))
(:a
(incf render-line-count)
(render-link ir-line render-line-count))))))))
(render-link ir-line rendered-line render-line-count))))))))
(defun collect-ir-lines (request-iri main-window lines)
(with-accessors ((ir-lines ir-lines)
@ -735,33 +731,36 @@
(vector-push-extend raw-line ir-rendered-lines)))
(collect-link (line)
(vector-push-extend (linkify line) ir-rendered-lines)))
(loop for line in lines do
(vector-push-extend line ir-lines)
(let ((type (ir-type line)))
(ecase (format-keyword type)
(:vertical-space
(vector-push-extend (format nil "") ir-rendered-lines))
(:as-is
(vector-push-extend (ir-line line) ir-rendered-lines))
(:text
(vector-push-extend (ir-line line) ir-rendered-lines))
(:h1
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:h2
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:h3
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:li
(push-prefixed (gui-conf:gemini-bullet-prefix) line))
(:quote
(push-prefixed (gui-conf:gemini-quote-prefix) line))
(:pre
(vector-push-extend (format nil "") ir-rendered-lines))
(:pre-end
(vector-push-extend (format nil "") ir-rendered-lines))
(:a
(collect-link line)))))
(render-ir-lines request-iri main-window))))
(let ((starting-index (if (not (vector-empty-p ir-lines))
0
(length ir-lines))))
(loop for line in lines do
(vector-push-extend line ir-lines)
(let ((type (ir-type line)))
(ecase (format-keyword type)
(:vertical-space
(vector-push-extend (format nil "") ir-rendered-lines))
(:as-is
(vector-push-extend (ir-line line) ir-rendered-lines))
(:text
(vector-push-extend (ir-line line) ir-rendered-lines))
(:h1
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:h2
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:h3
(push-prefixed (gui-conf:gemini-h1-prefix) line))
(:li
(push-prefixed (gui-conf:gemini-bullet-prefix) line))
(:quote
(push-prefixed (gui-conf:gemini-quote-prefix) line))
(:pre
(vector-push-extend (format nil "") ir-rendered-lines))
(:pre-end
(vector-push-extend (format nil "") ir-rendered-lines))
(:a
(collect-link line)))))
(render-ir-lines request-iri main-window :starting-index starting-index)))))
(defun displace-gemini-response (response)
(values (getf response :status)
@ -973,7 +972,7 @@
(initialize-ir-lines main-window)
(start-streaming-thread main-window
iri
:use-cache nil
:use-cache t
:status status
:process-function
(lambda (stream-wrapper lines)