diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index e417b88..18037f0 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -520,15 +520,33 @@ gemtext-font-scaling)) (gui:tag-raise gemtext-widget (gui:match-tag-name match))))))) -(defun collect-ir-lines (request-iri main-window lines) +(defun 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-rendered-label (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)))))) + (values link-rendered-label link-name link-value))) + +(defun render-ir-lines (request-iri main-window) (with-accessors ((ir-lines ir-lines) (ir-rendered-lines ir-rendered-lines) (gemtext-font-scaling gemtext-font-scaling) (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))) - (key->font (key) + (labels ((key->font (key) (let ((font (ecase key ((:vertical-space :text :li) (gui-conf:gemini-text-font-configuration)) @@ -576,34 +594,18 @@ (gui-conf:gemini-quote-justification)) ((:pre :pre-end :as-is) (gui-conf:gemini-preformatted-text-justification)))) - (linkify (line line-number) + (render-link (line line-number) (multiple-value-bind (link-bg link-fg) (gui-conf:gemini-link-colors) - (let* ((link-font (scale-font (gui-conf:gemini-link-font-configuration) - gemtext-font-scaling)) - (link-value (ir-href line)) - (target-iri (absolutize-link request-iri link-value)) - (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 `(:line ,line-number :char 0))) - (gui:append-text gemtext-widget (a:last-elt ir-rendered-lines)) - (gui:make-link-button gemtext-widget + (let ((link-font (scale-font (gui-conf:gemini-link-font-configuration) + gemtext-font-scaling))) + (multiple-value-bind (link-rendered-label link-name link-value) + (linkify line) + (let ((target-iri (absolutize-link request-iri link-value)) + (new-text-line-start `(:line ,line-number :char 0))) + (vector-push-extend link-rendered-label ir-rendered-lines) + (gui:append-text gemtext-widget (a:last-elt ir-rendered-lines)) + (gui:make-link-button gemtext-widget new-text-line-start `(- :end 1 :chars) link-font @@ -620,7 +622,7 @@ (lambda () (print-info-message target-iri)) :leave-callback (lambda () (print-info-message ""))) - (gui:append-line gemtext-widget ""))))) + (gui:append-line gemtext-widget "")))))) (render-line (key text line-number &key (wrap :word)) (let ((font (key->font key)) (justification (key->justification key)) @@ -645,68 +647,97 @@ with starting-pre-block-line = -1 with ending-pre-block-line = -1 with current-pre-block-alt-text = nil - 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) - (incf render-line-count) - (render-line :vertical-space (a:last-elt ir-rendered-lines) render-line-count)) - (:as-is - (vector-push-extend (ir-line line) ir-rendered-lines) - (incf render-line-count) - (render-line :as-is - (a:last-elt ir-rendered-lines) - render-line-count - :wrap :none)) - (:text - (vector-push-extend (ir-line line) ir-rendered-lines) - (incf render-line-count) - (render-line :text (a:last-elt ir-rendered-lines) render-line-count) - (maybe-re-emphatize-lines main-window - `(:line ,render-line-count :char 0) - `(:line ,render-line-count :char :end))) - (:h1 - (push-prefixed (gui-conf:gemini-h1-prefix) line) - (incf render-line-count) - (render-line :h1 (a:last-elt ir-rendered-lines) render-line-count)) - (:h2 - (push-prefixed (gui-conf:gemini-h1-prefix) line) - (incf render-line-count) - (render-line :h2 (a:last-elt ir-rendered-lines) render-line-count)) - (:h3 - (push-prefixed (gui-conf:gemini-h1-prefix) line) - (incf render-line-count) - (render-line :h3 (a:last-elt ir-rendered-lines) render-line-count)) + for rendered-line across ir-rendered-lines + for ir-line across ir-lines + do + (let ((type (ir-type ir-line))) + (ecase (format-keyword type) + (:vertical-space + (incf render-line-count) + (render-line :vertical-space rendered-line render-line-count)) + (:as-is + (incf render-line-count) + (render-line :as-is + rendered-line + render-line-count + :wrap :none)) + (:text + (incf render-line-count) + (render-line :text rendered-line render-line-count) + (maybe-re-emphatize-lines main-window + `(:line ,render-line-count :char 0) + `(:line ,render-line-count :char :end))) + (:h1 + (incf render-line-count) + (render-line :h1 rendered-line render-line-count)) + (:h2 + (incf render-line-count) + (render-line :h2 rendered-line render-line-count)) + (:h3 + (incf render-line-count) + (render-line :h3 rendered-line render-line-count)) (:li - (push-prefixed (gui-conf:gemini-bullet-prefix) line) (incf render-line-count) - (render-line :li (a:last-elt ir-rendered-lines) render-line-count) + (render-line :li rendered-line render-line-count) (maybe-re-emphatize-lines main-window `(:line ,render-line-count :char 0) `(:line ,render-line-count :char :end))) (:quote - (push-prefixed (gui-conf:gemini-quote-prefix) line) (incf render-line-count) - (render-line :quote (a:last-elt ir-rendered-lines) render-line-count)) + (render-line :quote rendered-line render-line-count)) (:pre - (vector-push-extend (format nil "") ir-rendered-lines) (incf render-line-count) (setf starting-pre-block-line (1+ render-line-count)) - (setf current-pre-block-alt-text (ir-pre-alt-text line)) + (setf current-pre-block-alt-text (ir-pre-alt-text ir-line)) (render-line :pre - (a:last-elt ir-rendered-lines) + rendered-line render-line-count :wrap :none)) (:pre-end - (vector-push-extend (format nil "") ir-rendered-lines) (setf ending-pre-block-line (1+ render-line-count)) (incf render-line-count) - (render-line :pre-end (a:last-elt ir-rendered-lines) render-line-count)) + (render-line :pre-end rendered-line render-line-count)) (:a (incf render-line-count) - (linkify line render-line-count)))))))) + (render-link ir-line render-line-count)))))))) + +(defun collect-ir-lines (request-iri main-window lines) + (with-accessors ((ir-lines ir-lines) + (ir-rendered-lines ir-rendered-lines) + (gemtext-font-scaling gemtext-font-scaling) + (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))) + (collect-link (line) + (vector-push-extend (linkify line) 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 + (collect-link line))))) + (render-ir-lines request-iri main-window)))) (defun displace-gemini-response (response) (values (getf response :status) @@ -1351,7 +1382,7 @@ (if offset (max 0.1 (+ (gemtext-font-scaling main-window) offset)) 1.0))) - (open-iri (get-address-bar-text main-window) main-window t)) + (render-ir-lines (get-address-bar-text main-window) main-window)) (defun initialize-keybindings (main-window) (let ((inner-gemtext-widget (gui:inner-text (gemtext-widget main-window))))