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

- [GUI] ensured the rendering of the gemtext respects the directives in the configuration file (font, color, justification, etc).

This commit is contained in:
cage 2023-02-26 15:03:03 +01:00
parent 744c85331e
commit cc633fc29c
4 changed files with 178 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
src/gui/client/client-configuration.lisp
View File

@ -29,7 +29,8 @@
weight weight
slant slant
underline underline
preformatted-text) preformatted-text
justification)
(defun load-config-file (&optional (virtual-filepath +client-conf-filename+) (defun load-config-file (&optional (virtual-filepath +client-conf-filename+)
(perform-missing-value-check nil)) (perform-missing-value-check nil))
@ -183,11 +184,28 @@
swconf:+key-bullet+ swconf:+key-bullet+
swconf:+key-prefix+)) swconf:+key-prefix+))
(defun conf-justification (key)
(let ((conf-value (access:accesses *client-configuration*
swconf:+key-gemini+
key
+key-justification+)))
(or conf-value
:left)))
(swconf:gen-simple-access (gemini-fragment-as-regex-p (defmacro gen-conf-justification (prefix key)
:transform-value-fn (lambda (a) (not (swconf:false-value-p a)))) (let* ((no-key (cl-ppcre:regex-replace-all "key-" (string-downcase (symbol-name key)) ""))
swconf:+key-experimental+ (no-plus (text-utils:trim-blanks no-key '(#\+))))
swconf:+key-gemini+ `(defun ,(misc:format-fn-symbol t "~a-~a-justification" prefix no-plus) ()
swconf:+key-iri+ (conf-justification ,key))))
swconf:+key-fragment+
swconf:+key-regex+) (gen-conf-justification gemini swconf:+key-link+)
(gen-conf-justification gemini swconf:+key-quote+)
(gen-conf-justification gemini swconf:+key-h1+)
(gen-conf-justification gemini swconf:+key-h2+)
(gen-conf-justification gemini swconf:+key-h3+)
(gen-conf-justification gemini swconf:+key-preformatted-text+)

3
src/gui/client/gui-goodies.lisp
View File

@ -22,6 +22,9 @@
(defmethod parse-color ((object string)) (defmethod parse-color ((object string))
(nodgui.utils:rgb->tk (cl-colors2:as-rgb object))) (nodgui.utils:rgb->tk (cl-colors2:as-rgb object)))
(defmethod parse-color ((object number))
(nodgui.utils:rgb->tk (cl-colors2:as-rgb object)))
(defun make-font (font-name font-size font-weight font-slant underline) (defun make-font (font-name font-size font-weight font-slant underline)
(gui:font-create (nodgui.utils:create-name) (gui:font-create (nodgui.utils:create-name)
:family font-name :family font-name

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

@ -197,77 +197,150 @@
(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)
(ecase key
((:vertical-space :pre-end :text :li)
nil)
(:as-is
(gui-conf:gemini-preformatted-text-font-configuration))
(:h1
(gui-conf:gemini-h1-font-configuration))
(:h2
(gui-conf:gemini-h2-font-configuration))
(:h3
(gui-conf:gemini-h3-font-configuration))
(:quote
(gui-conf:gemini-quote-font-configuration))
(:pre
(gui-conf:gemini-preformatted-text-font-configuration))
(:a
(gui-conf:gemini-link-font-configuration))))
(key->colors (key)
(ecase key
((:vertical-space :pre-end :text :li)
nil)
(:as-is
(gui-conf:gemini-preformatted-text-colors))
(:h1
(gui-conf:gemini-h1-colors))
(:h2
(gui-conf:gemini-h2-colors))
(:h3
(gui-conf:gemini-h3-colors))
(:quote
(gui-conf:gemini-quote-colors))
(:pre
(gui-conf:gemini-preformatted-text-colors))
(:a
(gui-conf:gemini-link-colors))))
(key->justification (key)
(ecase key
((:vertical-space :text :pre-end :li :a)
nil)
(:as-is
(gui-conf:gemini-preformatted-text-justification))
(: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
(gui-conf:gemini-preformatted-text-justification))))
(linkify (line) (linkify (line)
(let* ((link-value (ir-href line)) (multiple-value-bind (link-bg link-fg)
(link-name (or (ir-line line) (gui-conf:gemini-link-colors)
link-value)) (let* ((link-font (gui-conf:gemini-link-font-configuration))
(prefix-gemini (gui-conf:gemini-link-prefix-to-gemini)) (link-value (ir-href line))
(prefix-www (gui-conf:gemini-link-prefix-to-http)) (link-name (or (ir-line line)
(prefix-other (gui-conf:gemini-link-prefix-to-other)) link-value))
(link-text (if (text-utils:starting-emoji link-name) (prefix-gemini (gui-conf:gemini-link-prefix-to-gemini))
(format nil (prefix-www (gui-conf:gemini-link-prefix-to-http))
"~a~a" (prefix-other (gui-conf:gemini-link-prefix-to-other))
(trim-blanks prefix-other) (link-text (if (text-utils:starting-emoji link-name)
link-name) (format nil
(cond "~a~a"
((gemini-parser::gemini-link-iri-p link-value) (trim-blanks prefix-other)
(format nil "~a~a" prefix-gemini link-name)) link-name)
((html-utils::http-link-iri-p link-value) (cond
(format nil "~a~a" prefix-www link-name)) ((gemini-parser::gemini-link-iri-p link-value)
(t (format nil "~a~a" prefix-gemini link-name))
(format nil "~a~a" prefix-other link-name)))))) ((html-utils::http-link-iri-p link-value)
(vector-push-extend link-text ir-rendered-lines))) (format nil "~a~a" prefix-www link-name))
(render-line (text) (t
(gui:append-line gemtext-widget text))) (format nil "~a~a" prefix-other link-name))))))
(let ((link-font (gui-conf:gemini-link-font-configuration))) (vector-push-extend link-text ir-rendered-lines)
(multiple-value-bind (link-bg link-fg) (let ((new-text-line-start (gui:raw-coordinates gemtext-widget)))
(gui-conf:gemini-link-colors) (gui:append-text gemtext-widget (a:last-elt ir-rendered-lines))
(loop for line in lines do (gui:make-link-button gemtext-widget
(vector-push-extend line ir-lines) new-text-line-start
(let ((type (ir-type line))) (gui:make-indices-end)
(ecase (format-keyword type) link-font
(:vertical-space link-fg
(vector-push-extend (format nil "") ir-rendered-lines) link-bg
(render-line (a:last-elt ir-rendered-lines))) (lambda () t))
(:as-is (gui:append-line gemtext-widget "")))))
(vector-push-extend (ir-line line) ir-rendered-lines) (render-line (key text)
(render-line (a:last-elt ir-rendered-lines))) (let ((font (key->font key))
(:text (justification (key->justification key))
(vector-push-extend (ir-line line) ir-rendered-lines) (new-text-line-start (gui:raw-coordinates gemtext-widget)))
(render-line (a:last-elt ir-rendered-lines))) (gui:append-text gemtext-widget text)
(:h1 (if font
(push-prefixed (gui-conf:gemini-h1-prefix) line) (multiple-value-bind (background foreground)
(render-line (a:last-elt ir-rendered-lines))) (key->colors key)
(:h2 (let ((tag (gui:tag-create gemtext-widget
(push-prefixed (gui-conf:gemini-h1-prefix) line) (gui::create-tag-name)
(render-line (a:last-elt ir-rendered-lines))) new-text-line-start
(:h3 (gui:make-indices-end))))
(push-prefixed (gui-conf:gemini-h1-prefix) line) (gui:tag-configure gemtext-widget
(render-line (a:last-elt ir-rendered-lines))) tag
(:li :font font
(push-prefixed (gui-conf:gemini-bullet-prefix) line) :foreground foreground
(render-line (a:last-elt ir-rendered-lines))) :background background
(:quote :justify justification)
(push-prefixed (gui-conf:gemini-quote-prefix) line) (gui:append-line gemtext-widget "")
(render-line (a:last-elt ir-rendered-lines))) tag))
(:pre (progn
(vector-push-extend (format nil "") ir-rendered-lines) (gui:append-line gemtext-widget "")
(render-line (a:last-elt ir-rendered-lines))) nil)))))
(:pre-end (loop for line in lines do
(vector-push-extend (format nil "") ir-rendered-lines) (vector-push-extend line ir-lines)
(render-line (a:last-elt ir-rendered-lines))) (let ((type (ir-type line)))
(:a (ecase (format-keyword type)
(linkify line) (:vertical-space
(gui:append-text gemtext-widget (a:last-elt ir-rendered-lines)) (vector-push-extend (format nil "") ir-rendered-lines)
(gui:move-cursor-to-last-line gemtext-widget) (render-line :vertical-space (a:last-elt ir-rendered-lines)))
(gui:make-link-button gemtext-widget (:as-is
(gui:raw-coordinates gemtext-widget) (vector-push-extend (ir-line line) ir-rendered-lines)
(gui:make-indices-end) (render-line :as-is (a:last-elt ir-rendered-lines)))
link-font (:text
link-fg (vector-push-extend (ir-line line) ir-rendered-lines)
link-bg (render-line :text (a:last-elt ir-rendered-lines)))
(lambda () t)) (:h1
(gui:append-line gemtext-widget "")))))))))) (push-prefixed (gui-conf:gemini-h1-prefix) line)
(render-line :h1 (a:last-elt ir-rendered-lines)))
(:h2
(push-prefixed (gui-conf:gemini-h1-prefix) line)
(render-line :h2 (a:last-elt ir-rendered-lines)))
(:h3
(push-prefixed (gui-conf:gemini-h1-prefix) line)
(render-line :h3 (a:last-elt ir-rendered-lines)))
(:li
(push-prefixed (gui-conf:gemini-bullet-prefix) line)
(render-line :li (a:last-elt ir-rendered-lines)))
(:quote
(push-prefixed (gui-conf:gemini-quote-prefix) line)
(render-line :quote (a:last-elt ir-rendered-lines)))
(:pre
(vector-push-extend (format nil "") ir-rendered-lines)
(render-line :pre (a:last-elt ir-rendered-lines)))
(:pre-end
(vector-push-extend (format nil "") ir-rendered-lines)
(render-line :pre-end (a:last-elt ir-rendered-lines)))
(:a
(linkify line))))))))
(defun displace-gemini-response (response) (defun displace-gemini-response (response)
(values (getf response :status) (values (getf response :status)

7
src/package.lisp
View File

@ -3255,7 +3255,12 @@
:gemini-h1-colors :gemini-h1-colors
:gemini-h2-colors :gemini-h2-colors
:gemini-h3-colors :gemini-h3-colors
:gemini-preformatted-text-colors)) :gemini-preformatted-text-colors
:gemini-quote-justification
:gemini-h1-justification
:gemini-h2-justification
:gemini-h3-justification
:gemini-preformatted-text-justification))
(defpackage :client-events (defpackage :client-events
(:use (:use