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

src/gui/client/client-configuration.lisp

@@ -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+))
 
-
+(defun conf-justification (key)
-(swconf:gen-simple-access (gemini-fragment-as-regex-p
+  (let ((conf-value (access:accesses *client-configuration*
-                           :transform-value-fn (lambda (a) (not (swconf:false-value-p a))))
-                          swconf:+key-experimental+
                                      swconf:+key-gemini+
-                          swconf:+key-iri+
+                                     key
-                          swconf:+key-fragment+
+                                     +key-justification+)))
-                          swconf:+key-regex+)
+    (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+)

src/gui/client/gui-goodies.lisp

@@ -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

src/gui/client/main-window.lisp

@@ -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)))
+                   (vector-push-extend link-text ir-rendered-lines)
-             (render-line (text)
+                   (let ((new-text-line-start (gui:raw-coordinates gemtext-widget)))
-               (gui:append-line gemtext-widget text)))
+                     (gui:append-text gemtext-widget (a:last-elt ir-rendered-lines))
-      (let ((link-font (gui-conf:gemini-link-font-configuration)))
+                     (gui:make-link-button gemtext-widget
-        (multiple-value-bind (link-bg link-fg)
+                                           new-text-line-start
-            (gui-conf:gemini-link-colors)
+                                           (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)
+             (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 ""))))))))))
 
 (defun displace-gemini-response (response)
   (values (getf response :status)

src/package.lisp

@@ -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