1
0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-01 04:26:47 +01:00

- [GUI] added font scaling for gemtext.

This commit is contained in:
cage 2023-05-31 15:05:21 +02:00
parent 2e0b1a6086
commit 5a399987c8

View File

@ -498,7 +498,17 @@
#'download-background-callback) #'download-background-callback)
(gui:popup popup-menu x y))))) (gui:popup popup-menu x y)))))
(defmethod maybe-re-emphatize-lines (gemtext-widget from to) (defun scale-font (font scaling)
(when scaling
(let* ((font-size (parse-integer (getf (gui:font-actual font) :size)))
(increment (round (* font-size scaling)))
(new-font-size (+ font-size increment)))
(gui:font-configure font :size new-font-size)))
font)
(defun maybe-re-emphatize-lines (main-window from to)
(with-accessors ((gemtext-font-scaling gemtext-font-scaling)
(gemtext-widget gemtext-widget)) main-window
(when (client-configuration:emphasize-wrapped-asterisk-p) (when (client-configuration:emphasize-wrapped-asterisk-p)
(let ((matches (gui:search-all-text gemtext-widget (let ((matches (gui:search-all-text gemtext-widget
"\\*[^*]+\\*" "\\*[^*]+\\*"
@ -507,18 +517,20 @@
(loop for match in matches do (loop for match in matches do
(gui:tag-configure gemtext-widget (gui:tag-configure gemtext-widget
(gui:match-tag-name match) (gui:match-tag-name match)
:font (client-configuration:font-text-bold)) :font (scale-font (client-configuration:font-text-bold)
(gui:tag-raise gemtext-widget (gui:match-tag-name match)))))) gemtext-font-scaling))
(gui:tag-raise gemtext-widget (gui:match-tag-name match)))))))
(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)
(ir-rendered-lines ir-rendered-lines) (ir-rendered-lines ir-rendered-lines)
(gemtext-font-scaling gemtext-font-scaling)
(gemtext-widget gemtext-widget)) main-window (gemtext-widget gemtext-widget)) main-window
(labels ((push-prefixed (prefix ir) (labels ((push-prefixed (prefix ir)
(let ((raw-line (format nil "~a~a" prefix (ir-line ir)))) (let ((raw-line (format nil "~a~a" prefix (ir-line ir))))
(vector-push-extend raw-line ir-rendered-lines))) (vector-push-extend raw-line ir-rendered-lines)))
(key->font (key) (key->font (key)
(ecase key (let ((font (ecase key
((:vertical-space :text :li) ((:vertical-space :text :li)
(gui-conf:gemini-text-font-configuration)) (gui-conf:gemini-text-font-configuration))
(:h1 (:h1
@ -532,7 +544,9 @@
((:pre :pre-end :as-is) ((:pre :pre-end :as-is)
(gui-conf:gemini-preformatted-text-font-configuration)) (gui-conf:gemini-preformatted-text-font-configuration))
(:a (:a
(gui-conf:gemini-link-font-configuration)))) (gui-conf:gemini-link-font-configuration)))))
(scale-font font gemtext-font-scaling)
font))
(key->colors (key) (key->colors (key)
(ecase key (ecase key
((:vertical-space :text :li) ((:vertical-space :text :li)
@ -566,7 +580,8 @@
(linkify (line line-number) (linkify (line line-number)
(multiple-value-bind (link-bg link-fg) (multiple-value-bind (link-bg link-fg)
(gui-conf:gemini-link-colors) (gui-conf:gemini-link-colors)
(let* ((link-font (gui-conf:gemini-link-font-configuration)) (let* ((link-font (scale-font (gui-conf:gemini-link-font-configuration)
gemtext-font-scaling))
(link-value (ir-href line)) (link-value (ir-href line))
(target-iri (absolutize-link request-iri link-value)) (target-iri (absolutize-link request-iri link-value))
(link-name (or (ir-line line) (link-name (or (ir-line line)
@ -650,7 +665,7 @@
(vector-push-extend (ir-line line) ir-rendered-lines) (vector-push-extend (ir-line line) ir-rendered-lines)
(incf render-line-count) (incf render-line-count)
(render-line :text (a:last-elt ir-rendered-lines) render-line-count) (render-line :text (a:last-elt ir-rendered-lines) render-line-count)
(maybe-re-emphatize-lines gemtext-widget (maybe-re-emphatize-lines main-window
`(:line ,render-line-count :char 0) `(:line ,render-line-count :char 0)
`(:line ,render-line-count :char :end))) `(:line ,render-line-count :char :end)))
(:h1 (:h1
@ -669,7 +684,7 @@
(push-prefixed (gui-conf:gemini-bullet-prefix) line) (push-prefixed (gui-conf:gemini-bullet-prefix) line)
(incf render-line-count) (incf render-line-count)
(render-line :li (a:last-elt ir-rendered-lines) render-line-count) (render-line :li (a:last-elt ir-rendered-lines) render-line-count)
(maybe-re-emphatize-lines gemtext-widget (maybe-re-emphatize-lines main-window
`(:line ,render-line-count :char 0) `(:line ,render-line-count :char 0)
`(:line ,render-line-count :char :end))) `(:line ,render-line-count :char :end)))
(:quote (:quote
@ -1176,6 +1191,10 @@
:initform nil :initform nil
:initarg :gemtext-widget :initarg :gemtext-widget
:accessor gemtext-widget) :accessor gemtext-widget)
(gemtext-font-scaling
:initform 0.0
:initarg :gemtext-font-scaling
:accessor gemtext-font-scaling)
(tool-bar (tool-bar
:initform nil :initform nil
:initarg :tool-bar :initarg :tool-bar