diff --git a/src/gui/client/gui-goodies.lisp b/src/gui/client/gui-goodies.lisp index b6c3f09..665d90e 100644 --- a/src/gui/client/gui-goodies.lisp +++ b/src/gui/client/gui-goodies.lisp @@ -14,8 +14,13 @@ (a:define-constant +font-h3+ "bold" :test #'string=) -(defun parse-color (name) - (nodgui.utils:rgb->tk (cl-colors2:as-rgb name))) +(defgeneric parse-color (object)) + +(defmethod parse-color ((object symbol)) + (parse-color (string-downcase (symbol-name object)))) + +(defmethod parse-color ((object string)) + (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) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index a1ad1df..292933d 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -192,55 +192,82 @@ (defun collect-ir-lines (main-window lines) (with-accessors ((ir-lines ir-lines) - (ir-rendered-lines ir-rendered-lines)) main-window - (flet ((push-prefixed (prefix ir) - (let ((raw-line (format nil "~a~a" prefix (ir-line ir)))) - (vector-push-extend raw-line ir-rendered-lines))) - (linkify (line) - (let* ((link-name (ir-line line)) - (link-value (ir-href line)) - (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)))) - (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)) - (:as-is - (vector-push-extend (ir-line line) ir-rendered-lines)) - (:text - (vector-push-extend (ir-line line) ir-rendered-lines)) - (:h1 - (push-prefixed (gui-conf:gemini-h1-prefix) line)) - (:h2 - (push-prefixed (gui-conf:gemini-h1-prefix) line)) - (:h3 - (push-prefixed (gui-conf:gemini-h1-prefix) line)) - (:li - (push-prefixed (gui-conf:gemini-bullet-prefix) line)) - (:quote - (push-prefixed (gui-conf:gemini-quote-prefix) line)) - (:pre - (vector-push-extend (format nil "~%") ir-rendered-lines)) - (:pre-end - (vector-push-extend (format nil "~%") ir-rendered-lines)) - (:a - (linkify line)))))))) + (ir-rendered-lines ir-rendered-lines) + (gemtext-widget gemtext-widget)) main-window + (labels ((push-prefixed (prefix ir) + (let ((raw-line (format nil "~a~a" prefix (ir-line ir)))) + (vector-push-extend raw-line ir-rendered-lines))) + (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 "")))))))))) (defun displace-gemini-response (response) (values (getf response :status) @@ -383,7 +410,7 @@ (gemtext-widget gemtext-widget)) object (setf tool-bar (make-instance 'tool-bar :master object)) (setf toc-frame (make-instance 'toc-frame :master object)) - (setf gemtext-widget (make-instance 'gui:scrolled-text :master object)) + (setf gemtext-widget (make-instance 'gui:scrolled-text :master object :read-only t)) (setf info-frame (make-instance 'gui:frame :master object :relief :sunken :borderwidth 1)) (setf info-text (make-instance 'gui:text :height 1 :wrap :none :master info-frame)) (gui:configure info-text :font gui:+tk-small-caption-font+) @@ -396,6 +423,7 @@ (gui:grid-columnconfigure object 1 :weight 1) (gui:grid-rowconfigure object 1 :weight 1) (setup-main-window-events object) + (gui:focus (nodgui.mw:autocomplete-entry-widget (iri-entry (tool-bar object)))) object)) (defun print-info-message (message &key (color (gui-goodies:parse-color "gray")) (bold nil)) diff --git a/src/package.lisp b/src/package.lisp index 2f7f3dc..7548ae9 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3250,7 +3250,12 @@ :gemini-h3-prefix :gemini-bullet-prefix :gemini-preformatted-fg - :gemini-toc-padding-char)) + :gemini-link-colors + :gemini-quote-colors + :gemini-h1-colors + :gemini-h2-colors + :gemini-h3-colors + :gemini-preformatted-text-colors)) (defpackage :client-events (:use