From cc633fc29c4dfd69eb47c35313ce3f5102aa3166 Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 26 Feb 2023 15:03:03 +0100 Subject: [PATCH] - [GUI] ensured the rendering of the gemtext respects the directives in the configuration file (font, color, justification, etc). --- src/gui/client/client-configuration.lisp | 34 +++- src/gui/client/gui-goodies.lisp | 3 + src/gui/client/main-window.lisp | 213 +++++++++++++++-------- src/package.lisp | 7 +- 4 files changed, 178 insertions(+), 79 deletions(-) diff --git a/src/gui/client/client-configuration.lisp b/src/gui/client/client-configuration.lisp index 3a8323c..edd3001 100644 --- a/src/gui/client/client-configuration.lisp +++ b/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) + (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 - :transform-value-fn (lambda (a) (not (swconf:false-value-p a)))) - swconf:+key-experimental+ - swconf:+key-gemini+ - swconf:+key-iri+ - swconf:+key-fragment+ - swconf:+key-regex+) +(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+) diff --git a/src/gui/client/gui-goodies.lisp b/src/gui/client/gui-goodies.lisp index 665d90e..9313b80 100644 --- a/src/gui/client/gui-goodies.lisp +++ b/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 diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index a9713aa..b5b6ea3 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -197,77 +197,150 @@ (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)) - (link-name (or (ir-line line) - link-value)) - (prefix-gemini (gui-conf:gemini-link-prefix-to-gemini)) - (prefix-www (gui-conf:gemini-link-prefix-to-http)) - (prefix-other (gui-conf:gemini-link-prefix-to-other)) - (link-text (if (text-utils:starting-emoji link-name) - (format nil - "~a~a" - (trim-blanks prefix-other) - link-name) - (cond - ((gemini-parser::gemini-link-iri-p link-value) - (format nil "~a~a" prefix-gemini link-name)) - ((html-utils::http-link-iri-p link-value) - (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) - (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))) - (:as-is - (vector-push-extend (ir-line line) ir-rendered-lines) - (render-line (a:last-elt ir-rendered-lines))) - (:text - (vector-push-extend (ir-line line) ir-rendered-lines) - (render-line (a:last-elt ir-rendered-lines))) - (:h1 - (push-prefixed (gui-conf:gemini-h1-prefix) line) - (render-line (a:last-elt ir-rendered-lines))) - (:h2 - (push-prefixed (gui-conf:gemini-h1-prefix) line) - (render-line (a:last-elt ir-rendered-lines))) - (:h3 - (push-prefixed (gui-conf:gemini-h1-prefix) line) - (render-line (a:last-elt ir-rendered-lines))) - (:li - (push-prefixed (gui-conf:gemini-bullet-prefix) line) - (render-line (a:last-elt ir-rendered-lines))) - (:quote - (push-prefixed (gui-conf:gemini-quote-prefix) line) - (render-line (a:last-elt ir-rendered-lines))) - (:pre - (vector-push-extend (format nil "") ir-rendered-lines) - (render-line (a:last-elt ir-rendered-lines))) - (:pre-end - (vector-push-extend (format nil "") ir-rendered-lines) - (render-line (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 "")))))))))) + (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)) + (prefix-www (gui-conf:gemini-link-prefix-to-http)) + (prefix-other (gui-conf:gemini-link-prefix-to-other)) + (link-text (if (text-utils:starting-emoji link-name) + (format nil + "~a~a" + (trim-blanks prefix-other) + link-name) + (cond + ((gemini-parser::gemini-link-iri-p link-value) + (format nil "~a~a" prefix-gemini link-name)) + ((html-utils::http-link-iri-p link-value) + (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) + (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 :vertical-space (a:last-elt ir-rendered-lines))) + (:as-is + (vector-push-extend (ir-line line) 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 :text (a:last-elt ir-rendered-lines))) + (:h1 + (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) (values (getf response :status) diff --git a/src/package.lisp b/src/package.lisp index 7548ae9..061c61d 100644 --- a/src/package.lisp +++ b/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