mirror of https://codeberg.org/cage/tinmop/
- [GUI] improved rendering speed by not applying text tags to empty lines and normal text, moreover cached the gemtext fonts.
This commit is contained in:
parent
9682b53522
commit
7cd0b5740b
|
@ -615,161 +615,165 @@ local file paths."
|
||||||
(ir-rendered-lines ir-rendered-lines)
|
(ir-rendered-lines ir-rendered-lines)
|
||||||
(gemtext-font-scaling gemtext-font-scaling)
|
(gemtext-font-scaling gemtext-font-scaling)
|
||||||
(gemtext-widget gemtext-widget)) main-window
|
(gemtext-widget gemtext-widget)) main-window
|
||||||
(labels ((key->font (key)
|
(let ((font-cache '()))
|
||||||
(let ((font (ecase key
|
(labels ((key->font (key)
|
||||||
((:vertical-space :text :li)
|
(or (cdr (assoc :key font-cache))
|
||||||
(gui-conf:gemini-text-font-configuration))
|
(let ((font (ecase key
|
||||||
(:h1
|
((:vertical-space :text :li)
|
||||||
(gui-conf:gemini-h1-font-configuration))
|
(gui-conf:gemini-text-font-configuration))
|
||||||
(:h2
|
(:h1
|
||||||
(gui-conf:gemini-h2-font-configuration))
|
(gui-conf:gemini-h1-font-configuration))
|
||||||
(:h3
|
(:h2
|
||||||
(gui-conf:gemini-h3-font-configuration))
|
(gui-conf:gemini-h2-font-configuration))
|
||||||
(:quote
|
(:h3
|
||||||
(gui-conf:gemini-quote-font-configuration))
|
(gui-conf:gemini-h3-font-configuration))
|
||||||
((:pre :pre-end :as-is)
|
(:quote
|
||||||
(gui-conf:gemini-preformatted-text-font-configuration))
|
(gui-conf:gemini-quote-font-configuration))
|
||||||
(:a
|
((:pre :pre-end :as-is)
|
||||||
(gui-conf:gemini-link-font-configuration)))))
|
(gui-conf:gemini-preformatted-text-font-configuration))
|
||||||
(scale-font font gemtext-font-scaling)
|
(:a
|
||||||
font))
|
(gui-conf:gemini-link-font-configuration)))))
|
||||||
(key->colors (key)
|
(scale-font font gemtext-font-scaling)
|
||||||
(ecase key
|
(setf font-cache (acons key font font-cache))
|
||||||
((:vertical-space :text :li)
|
font)))
|
||||||
(gui-conf:gemini-window-colors))
|
(key->colors (key)
|
||||||
(:h1
|
(ecase key
|
||||||
(gui-conf:gemini-h1-colors))
|
((:vertical-space :text :li)
|
||||||
(:h2
|
(gui-conf:gemini-window-colors))
|
||||||
(gui-conf:gemini-h2-colors))
|
|
||||||
(:h3
|
|
||||||
(gui-conf:gemini-h3-colors))
|
|
||||||
(:quote
|
|
||||||
(gui-conf:gemini-quote-colors))
|
|
||||||
((:pre :pre-end :as-is)
|
|
||||||
(gui-conf:gemini-preformatted-text-colors))
|
|
||||||
(:a
|
|
||||||
(gui-conf:gemini-link-colors))))
|
|
||||||
(key->justification (key)
|
|
||||||
(ecase key
|
|
||||||
((:vertical-space :text :li :a)
|
|
||||||
:left)
|
|
||||||
(:h1
|
|
||||||
(gui-conf:gemini-h1-justification))
|
|
||||||
(:h2
|
|
||||||
(gui-conf:gemini-h2-justification))
|
|
||||||
(:h3
|
|
||||||
(gui-conf:gemini-h3-justification))
|
|
||||||
(:quote
|
|
||||||
(gui-conf:gemini-quote-justification))
|
|
||||||
((:pre :pre-end :as-is)
|
|
||||||
(gui-conf:gemini-preformatted-text-justification))))
|
|
||||||
(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 (x link-name link-value)
|
|
||||||
(linkify line)
|
|
||||||
(declare (ignore x))
|
|
||||||
(let ((target-iri (remove-standard-port (absolutize-link request-iri
|
|
||||||
link-value)))
|
|
||||||
(new-text-line-start `(:line ,line-number :char 0)))
|
|
||||||
(gui:append-text gemtext-widget link-rendered-label)
|
|
||||||
(let ((tag-link (gui:make-link-button gemtext-widget
|
|
||||||
new-text-line-start
|
|
||||||
`(- :end 1 :chars)
|
|
||||||
link-font
|
|
||||||
link-fg
|
|
||||||
link-bg
|
|
||||||
(link-click-mouse-1-callback-clsr target-iri
|
|
||||||
main-window)
|
|
||||||
:cursor-outside
|
|
||||||
(gui:find-cursor :xterm)
|
|
||||||
:button-3-callback
|
|
||||||
(contextual-menu-link-clrs link-name
|
|
||||||
target-iri
|
|
||||||
main-window)
|
|
||||||
:over-callback
|
|
||||||
(lambda () (print-info-message target-iri))
|
|
||||||
:leave-callback
|
|
||||||
(lambda () (print-info-message "")))))
|
|
||||||
(gui:tag-lower gemtext-widget tag-link)
|
|
||||||
(gui:append-line gemtext-widget "")))))))
|
|
||||||
(render-line (key text line-number &key (wrap :word))
|
|
||||||
(let ((font (key->font key))
|
|
||||||
(justification (key->justification key))
|
|
||||||
(start-index `(:line ,line-number :char 0)))
|
|
||||||
(gui:append-text gemtext-widget text)
|
|
||||||
(gui:append-line gemtext-widget "")
|
|
||||||
(multiple-value-bind (background foreground)
|
|
||||||
(key->colors key)
|
|
||||||
(let ((tag (gui:tag-create gemtext-widget
|
|
||||||
(gui::create-tag-name)
|
|
||||||
start-index
|
|
||||||
(gui:make-indices-end))))
|
|
||||||
(gui:tag-configure gemtext-widget
|
|
||||||
tag
|
|
||||||
:wrap wrap
|
|
||||||
:font font
|
|
||||||
:foreground foreground
|
|
||||||
:background background
|
|
||||||
:justify justification)
|
|
||||||
;; 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 = starting-index
|
|
||||||
with current-pre-block-alt-text = nil
|
|
||||||
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)
|
|
||||||
(:vertical-space
|
|
||||||
(incf render-line-count)
|
|
||||||
(render-line :vertical-space rendered-line render-line-count))
|
|
||||||
(:as-is
|
|
||||||
(incf render-line-count)
|
|
||||||
(render-line :as-is
|
|
||||||
rendered-line
|
|
||||||
render-line-count
|
|
||||||
:wrap :none))
|
|
||||||
(:text
|
|
||||||
(incf render-line-count)
|
|
||||||
(render-line :text rendered-line render-line-count)
|
|
||||||
(maybe-re-emphatize-lines main-window
|
|
||||||
`(:line ,render-line-count :char 0)
|
|
||||||
`(:line ,render-line-count :char :end)))
|
|
||||||
(:h1
|
(:h1
|
||||||
(incf render-line-count)
|
(gui-conf:gemini-h1-colors))
|
||||||
(render-line :h1 rendered-line render-line-count))
|
|
||||||
(:h2
|
(:h2
|
||||||
(incf render-line-count)
|
(gui-conf:gemini-h2-colors))
|
||||||
(render-line :h2 rendered-line render-line-count))
|
|
||||||
(:h3
|
(:h3
|
||||||
(incf render-line-count)
|
(gui-conf:gemini-h3-colors))
|
||||||
(render-line :h3 rendered-line render-line-count))
|
(:quote
|
||||||
(:li
|
(gui-conf:gemini-quote-colors))
|
||||||
(incf render-line-count)
|
((:pre :pre-end :as-is)
|
||||||
(render-line :li rendered-line render-line-count)
|
(gui-conf:gemini-preformatted-text-colors))
|
||||||
(maybe-re-emphatize-lines main-window
|
(:a
|
||||||
`(:line ,render-line-count :char 0)
|
(gui-conf:gemini-link-colors))))
|
||||||
`(:line ,render-line-count :char :end)))
|
(key->justification (key)
|
||||||
(:quote
|
(ecase key
|
||||||
(incf render-line-count)
|
((:vertical-space :text :li :a)
|
||||||
(render-line :quote rendered-line render-line-count))
|
:left)
|
||||||
(:pre
|
(:h1
|
||||||
(incf render-line-count)
|
(gui-conf:gemini-h1-justification))
|
||||||
(setf current-pre-block-alt-text (ir-pre-alt-text ir-line))
|
(:h2
|
||||||
(render-line :pre
|
(gui-conf:gemini-h2-justification))
|
||||||
rendered-line
|
(:h3
|
||||||
render-line-count
|
(gui-conf:gemini-h3-justification))
|
||||||
:wrap :none))
|
(:quote
|
||||||
(:pre-end
|
(gui-conf:gemini-quote-justification))
|
||||||
(incf render-line-count)
|
((:pre :pre-end :as-is)
|
||||||
(render-line :pre-end rendered-line render-line-count))
|
(gui-conf:gemini-preformatted-text-justification))))
|
||||||
(:a
|
(render-link (line link-rendered-label line-number)
|
||||||
(incf render-line-count)
|
(multiple-value-bind (link-bg link-fg)
|
||||||
(render-link ir-line rendered-line render-line-count))))))))
|
(gui-conf:gemini-link-colors)
|
||||||
|
(let ((link-font (key->font :a)))
|
||||||
|
(multiple-value-bind (x link-name link-value)
|
||||||
|
(linkify line)
|
||||||
|
(declare (ignore x))
|
||||||
|
(let ((target-iri (remove-standard-port (absolutize-link request-iri
|
||||||
|
link-value)))
|
||||||
|
(new-text-line-start `(:line ,line-number :char 0)))
|
||||||
|
(gui:append-text gemtext-widget link-rendered-label)
|
||||||
|
(let ((tag-link (gui:make-link-button gemtext-widget
|
||||||
|
new-text-line-start
|
||||||
|
`(- :end 1 :chars)
|
||||||
|
link-font
|
||||||
|
link-fg
|
||||||
|
link-bg
|
||||||
|
(link-click-mouse-1-callback-clsr target-iri
|
||||||
|
main-window)
|
||||||
|
:cursor-outside
|
||||||
|
(gui:find-cursor :xterm)
|
||||||
|
:button-3-callback
|
||||||
|
(contextual-menu-link-clrs link-name
|
||||||
|
target-iri
|
||||||
|
main-window)
|
||||||
|
:over-callback
|
||||||
|
(lambda () (print-info-message target-iri))
|
||||||
|
:leave-callback
|
||||||
|
(lambda () (print-info-message "")))))
|
||||||
|
(gui:tag-lower gemtext-widget tag-link)
|
||||||
|
(gui:append-line gemtext-widget "")))))))
|
||||||
|
(render-line (key text line-number &key (wrap :word))
|
||||||
|
(let ((font (key->font key))
|
||||||
|
(justification (key->justification key))
|
||||||
|
(start-index `(:line ,line-number :char 0)))
|
||||||
|
(gui:append-text gemtext-widget text)
|
||||||
|
(gui:append-line gemtext-widget "")
|
||||||
|
(when (not (member key '(:text :vertical-space)))
|
||||||
|
(multiple-value-bind (background foreground)
|
||||||
|
(key->colors key)
|
||||||
|
(let ((tag (gui:tag-create gemtext-widget
|
||||||
|
(gui::create-tag-name)
|
||||||
|
start-index
|
||||||
|
(gui:make-indices-end))))
|
||||||
|
(gui:tag-configure gemtext-widget
|
||||||
|
tag
|
||||||
|
:wrap wrap
|
||||||
|
:font font
|
||||||
|
:foreground foreground
|
||||||
|
:background background
|
||||||
|
:justify justification)
|
||||||
|
;; does not works because of a TK bug
|
||||||
|
;;(colorize-emoji main-window (1- line-number))
|
||||||
|
(gui:tag-lower gemtext-widget tag)))))))
|
||||||
|
(gui:configure gemtext-widget :font (key->font :text))
|
||||||
|
(loop with render-line-count = starting-index
|
||||||
|
with current-pre-block-alt-text = nil
|
||||||
|
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)
|
||||||
|
(:vertical-space
|
||||||
|
(incf render-line-count)
|
||||||
|
(render-line :vertical-space rendered-line render-line-count))
|
||||||
|
(:as-is
|
||||||
|
(incf render-line-count)
|
||||||
|
(render-line :as-is
|
||||||
|
rendered-line
|
||||||
|
render-line-count
|
||||||
|
:wrap :none))
|
||||||
|
(:text
|
||||||
|
(incf render-line-count)
|
||||||
|
(render-line :text rendered-line render-line-count)
|
||||||
|
(maybe-re-emphatize-lines main-window
|
||||||
|
`(:line ,render-line-count :char 0)
|
||||||
|
`(:line ,render-line-count :char :end)))
|
||||||
|
(:h1
|
||||||
|
(incf render-line-count)
|
||||||
|
(render-line :h1 rendered-line render-line-count))
|
||||||
|
(:h2
|
||||||
|
(incf render-line-count)
|
||||||
|
(render-line :h2 rendered-line render-line-count))
|
||||||
|
(:h3
|
||||||
|
(incf render-line-count)
|
||||||
|
(render-line :h3 rendered-line render-line-count))
|
||||||
|
(:li
|
||||||
|
(incf render-line-count)
|
||||||
|
(render-line :li rendered-line render-line-count)
|
||||||
|
(maybe-re-emphatize-lines main-window
|
||||||
|
`(:line ,render-line-count :char 0)
|
||||||
|
`(:line ,render-line-count :char :end)))
|
||||||
|
(:quote
|
||||||
|
(incf render-line-count)
|
||||||
|
(render-line :quote rendered-line render-line-count))
|
||||||
|
(:pre
|
||||||
|
(incf 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
|
||||||
|
(incf render-line-count)
|
||||||
|
(render-line :pre-end rendered-line render-line-count))
|
||||||
|
(:a
|
||||||
|
(incf render-line-count)
|
||||||
|
(render-link ir-line rendered-line render-line-count)))))))))
|
||||||
|
|
||||||
(defun collect-ir-lines (request-iri main-window lines)
|
(defun collect-ir-lines (request-iri main-window lines)
|
||||||
(with-accessors ((ir-lines ir-lines)
|
(with-accessors ((ir-lines ir-lines)
|
||||||
|
@ -1485,8 +1489,8 @@ local file paths."
|
||||||
(setf (gemtext-font-scaling main-window)
|
(setf (gemtext-font-scaling main-window)
|
||||||
(if offset
|
(if offset
|
||||||
(max 0.1 (+ (gemtext-font-scaling main-window) offset))
|
(max 0.1 (+ (gemtext-font-scaling main-window) offset))
|
||||||
1.0)))
|
1.0))
|
||||||
(render-ir-lines (get-address-bar-text main-window) main-window))
|
(render-ir-lines (get-address-bar-text main-window) main-window)))
|
||||||
|
|
||||||
(defun initialize-keybindings (main-window target)
|
(defun initialize-keybindings (main-window target)
|
||||||
(gui:bind target
|
(gui:bind target
|
||||||
|
|
Loading…
Reference in New Issue