mirror of https://codeberg.org/cage/tinmop/
- [GUI] ensured the rendering of the gemtext respects the directives in the configuration file (font, color, justification, etc).
This commit is contained in:
parent
744c85331e
commit
cc633fc29c
|
@ -29,7 +29,8 @@
|
|||
weight
|
||||
slant
|
||||
underline
|
||||
preformatted-text)
|
||||
preformatted-text
|
||||
justification)
|
||||
|
||||
(defun load-config-file (&optional (virtual-filepath +client-conf-filename+)
|
||||
(perform-missing-value-check nil))
|
||||
|
@ -183,11 +184,28 @@
|
|||
swconf:+key-bullet+
|
||||
swconf:+key-prefix+))
|
||||
|
||||
|
||||
(swconf:gen-simple-access (gemini-fragment-as-regex-p
|
||||
:transform-value-fn (lambda (a) (not (swconf:false-value-p a))))
|
||||
swconf:+key-experimental+
|
||||
(defun conf-justification (key)
|
||||
(let ((conf-value (access:accesses *client-configuration*
|
||||
swconf:+key-gemini+
|
||||
swconf:+key-iri+
|
||||
swconf:+key-fragment+
|
||||
swconf:+key-regex+)
|
||||
key
|
||||
+key-justification+)))
|
||||
(or conf-value
|
||||
:left)))
|
||||
|
||||
(defmacro gen-conf-justification (prefix key)
|
||||
(let* ((no-key (cl-ppcre:regex-replace-all "key-" (string-downcase (symbol-name key)) ""))
|
||||
(no-plus (text-utils:trim-blanks no-key '(#\+))))
|
||||
`(defun ,(misc:format-fn-symbol t "~a-~a-justification" prefix no-plus) ()
|
||||
(conf-justification ,key))))
|
||||
|
||||
(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+)
|
||||
|
|
|
@ -22,6 +22,9 @@
|
|||
(defmethod parse-color ((object string))
|
||||
(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)
|
||||
(gui:font-create (nodgui.utils:create-name)
|
||||
:family font-name
|
||||
|
|
|
@ -197,8 +197,63 @@
|
|||
(labels ((push-prefixed (prefix ir)
|
||||
(let ((raw-line (format nil "~a~a" prefix (ir-line ir))))
|
||||
(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)
|
||||
(let* ((link-value (ir-href line))
|
||||
(multiple-value-bind (link-bg link-fg)
|
||||
(gui-conf:gemini-link-colors)
|
||||
(let* ((link-font (gui-conf:gemini-link-font-configuration))
|
||||
(link-value (ir-href line))
|
||||
(link-name (or (ir-line line)
|
||||
link-value))
|
||||
(prefix-gemini (gui-conf:gemini-link-prefix-to-gemini))
|
||||
|
@ -216,58 +271,76 @@
|
|||
(format nil "~a~a" prefix-www link-name))
|
||||
(t
|
||||
(format nil "~a~a" prefix-other link-name))))))
|
||||
(vector-push-extend link-text ir-rendered-lines)))
|
||||
(render-line (text)
|
||||
(gui:append-line gemtext-widget text)))
|
||||
(let ((link-font (gui-conf:gemini-link-font-configuration)))
|
||||
(multiple-value-bind (link-bg link-fg)
|
||||
(gui-conf:gemini-link-colors)
|
||||
(vector-push-extend link-text ir-rendered-lines)
|
||||
(let ((new-text-line-start (gui:raw-coordinates gemtext-widget)))
|
||||
(gui:append-text gemtext-widget (a:last-elt ir-rendered-lines))
|
||||
(gui:make-link-button gemtext-widget
|
||||
new-text-line-start
|
||||
(gui:make-indices-end)
|
||||
link-font
|
||||
link-fg
|
||||
link-bg
|
||||
(lambda () t))
|
||||
(gui:append-line gemtext-widget "")))))
|
||||
(render-line (key text)
|
||||
(let ((font (key->font key))
|
||||
(justification (key->justification key))
|
||||
(new-text-line-start (gui:raw-coordinates gemtext-widget)))
|
||||
(gui:append-text gemtext-widget text)
|
||||
(if font
|
||||
(multiple-value-bind (background foreground)
|
||||
(key->colors key)
|
||||
(let ((tag (gui:tag-create gemtext-widget
|
||||
(gui::create-tag-name)
|
||||
new-text-line-start
|
||||
(gui:make-indices-end))))
|
||||
(gui:tag-configure gemtext-widget
|
||||
tag
|
||||
:font font
|
||||
:foreground foreground
|
||||
:background background
|
||||
:justify justification)
|
||||
(gui:append-line gemtext-widget "")
|
||||
tag))
|
||||
(progn
|
||||
(gui:append-line gemtext-widget "")
|
||||
nil)))))
|
||||
(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)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(render-line :vertical-space (a:last-elt ir-rendered-lines)))
|
||||
(:as-is
|
||||
(vector-push-extend (ir-line line) ir-rendered-lines)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(render-line :as-is (a:last-elt ir-rendered-lines)))
|
||||
(:text
|
||||
(vector-push-extend (ir-line line) ir-rendered-lines)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(render-line :text (a:last-elt ir-rendered-lines)))
|
||||
(:h1
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(render-line :h1 (a:last-elt ir-rendered-lines)))
|
||||
(:h2
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(render-line :h2 (a:last-elt ir-rendered-lines)))
|
||||
(:h3
|
||||
(push-prefixed (gui-conf:gemini-h1-prefix) line)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(render-line :h3 (a:last-elt ir-rendered-lines)))
|
||||
(:li
|
||||
(push-prefixed (gui-conf:gemini-bullet-prefix) line)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(render-line :li (a:last-elt ir-rendered-lines)))
|
||||
(:quote
|
||||
(push-prefixed (gui-conf:gemini-quote-prefix) line)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(render-line :quote (a:last-elt ir-rendered-lines)))
|
||||
(:pre
|
||||
(vector-push-extend (format nil "") ir-rendered-lines)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(render-line :pre (a:last-elt ir-rendered-lines)))
|
||||
(:pre-end
|
||||
(vector-push-extend (format nil "") ir-rendered-lines)
|
||||
(render-line (a:last-elt ir-rendered-lines)))
|
||||
(render-line :pre-end (a:last-elt ir-rendered-lines)))
|
||||
(:a
|
||||
(linkify line)
|
||||
(gui:append-text gemtext-widget (a:last-elt ir-rendered-lines))
|
||||
(gui:move-cursor-to-last-line gemtext-widget)
|
||||
(gui:make-link-button gemtext-widget
|
||||
(gui:raw-coordinates gemtext-widget)
|
||||
(gui:make-indices-end)
|
||||
link-font
|
||||
link-fg
|
||||
link-bg
|
||||
(lambda () t))
|
||||
(gui:append-line gemtext-widget ""))))))))))
|
||||
(linkify line))))))))
|
||||
|
||||
(defun displace-gemini-response (response)
|
||||
(values (getf response :status)
|
||||
|
|
|
@ -3255,7 +3255,12 @@
|
|||
:gemini-h1-colors
|
||||
:gemini-h2-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
|
||||
(:use
|
||||
|
|
Loading…
Reference in New Issue