- [GUI] optimized rendering of gemtext when scaling command is launched.

Previously a  new RPC call was  performed to get the  gemtext lines,
  now the version cached by the client is used.

etc/gui.conf

@@ -215,6 +215,12 @@ keybinding.bookmark.toggle          = "Control-d"
 
 keybinding.bookmark.show            = "Control-b"
 
+keybinding.gemtext.scaling.increase = "Control-plus"
+
+keybinding.gemtext.scaling.decrease = "Control-minus"
+
+keybinding.gemtext.scaling.reset    = "Control-0"
+
 # emphasize text
 
 emphasize.wrapped.asterisk           = yes

src/gui/client/client-configuration.lisp

@@ -48,7 +48,12 @@
                            emphasize
                            wrapped
                            asterisk
-                           autoresize)
+                           autoresize
+                           gemtext
+                           scaling
+                           increase
+                           decrease
+                           reset)
 
 (defun load-config-file (&optional (virtual-filepath +client-conf-filename+)
                            (perform-missing-value-check nil))
@@ -359,6 +364,30 @@
                           +key-bookmark+
                           +key-show+)
 
+(swconf:gen-simple-access (keybinding-gemtext-scaling-increase
+                           :transform-value-fn (lambda (a) (keybinding->tk-event a))
+                           :configuration-tree *client-configuration*)
+                          +key-keybinding+
+                          +key-gemtext+
+                          +key-scaling+
+                          +key-increase+)
+
+(swconf:gen-simple-access (keybinding-gemtext-scaling-decrease
+                           :transform-value-fn (lambda (a) (keybinding->tk-event a))
+                           :configuration-tree *client-configuration*)
+                          +key-keybinding+
+                          +key-gemtext+
+                          +key-scaling+
+                          +key-decrease+)
+
+(swconf:gen-simple-access (keybinding-gemtext-scaling-reset
+                           :transform-value-fn (lambda (a) (keybinding->tk-event a))
+                           :configuration-tree *client-configuration*)
+                          +key-keybinding+
+                          +key-gemtext+
+                          +key-scaling+
+                          +key-reset+)
+
 (defun main-window-select-colors ()
   (values (gui-goodies:parse-color (access:accesses *client-configuration*
                                                     swconf:+key-gemini+

src/gui/client/main-window.lisp

@@ -500,9 +500,8 @@
 
 (defun scale-font (font scaling)
   (when scaling
-    (let* ((font-size     (parse-integer (getf (gui:font-actual font) :size)))
-           (increment     (round (* font-size scaling)))
-           (new-font-size (+ font-size increment)))
+    (let* ((font-size      (parse-integer (getf (gui:font-actual font) :size)))
+           (new-font-size  (round (* font-size scaling))))
       (gui:font-configure font :size new-font-size)))
   font)
 
@@ -521,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))
@@ -577,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
@@ -621,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))
@@ -646,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)
@@ -1192,7 +1222,7 @@
     :initarg :gemtext-widget
     :accessor gemtext-widget)
    (gemtext-font-scaling
-    :initform 0.0
+    :initform 1.0
     :initarg :gemtext-font-scaling
     :accessor gemtext-font-scaling)
    (tool-bar
@@ -1345,6 +1375,15 @@
 (defun get-address-bar-text (main-window)
   (trim-blanks (gui:text (iri-entry (tool-bar main-window)))))
 
+(defun scale-gemtext (main-window offset)
+  (ev:with-enqueued-process-and-unblock ()
+    (clean-gemtext main-window)
+    (setf (gemtext-font-scaling main-window)
+          (if offset
+              (max 0.1 (+ (gemtext-font-scaling main-window) offset))
+              1.0)))
+  (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))))
     (gui:bind inner-gemtext-widget
@@ -1431,7 +1470,22 @@
               (client-configuration:config-keybinding-bookmark-show)
               (lambda (e)
                 (declare (ignore e))
-                (funcall (menu:show-bookmarks-clsr main-window))))))
+                (funcall (menu:show-bookmarks-clsr main-window))))
+    (gui:bind inner-gemtext-widget
+              (client-configuration:config-keybinding-gemtext-scaling-increase)
+              (lambda (e)
+                (declare (ignore e))
+                (scale-gemtext main-window 0.1)))
+    (gui:bind inner-gemtext-widget
+              (client-configuration:config-keybinding-gemtext-scaling-decrease)
+              (lambda (e)
+                (declare (ignore e))
+                (scale-gemtext main-window -0.1)))
+    (gui:bind inner-gemtext-widget
+              (client-configuration:config-keybinding-gemtext-scaling-reset)
+              (lambda (e)
+                (declare (ignore e))
+                (scale-gemtext main-window nil)))))
 
 (defun init-main-window (starting-iri)
   (setf gui:*debug-tk* nil)

src/package.lisp

@@ -3295,6 +3295,9 @@
    :config-keybinding-tour-shuffle
    :config-keybinding-tour-manage
    :config-keybinding-tour-next
+   :config-keybinding-gemtext-scaling-increase
+   :config-keybinding-gemtext-scaling-decrease
+   :config-keybinding-gemtext-scaling-reset
    :config-gemtext-padding
    :config-keybinding-bookmark-toggle
    :config-keybinding-bookmark-show