- [GUI] prevented gemtext widget to take the focus (tanks op!).

etc/gui.conf

@@ -181,6 +181,8 @@ toc.slant                           = roman
 
 toc.underline                       = no
 
+toc.autoresize                      = yes
+
 # Keybinding
 
 # see: https://www.tcl.tk/man/tcl8.7/TkCmd/bind.html#M7

src/gui/client/client-configuration.lisp

@@ -47,7 +47,8 @@
                            select
                            emphasize
                            wrapped
-                           asterisk)
+                           asterisk
+                           autoresize)
 
 (defun load-config-file (&optional (virtual-filepath +client-conf-filename+)
                            (perform-missing-value-check nil))
@@ -284,6 +285,12 @@
                           swconf:+key-minimum+
                           swconf:+key-width+)
 
+(swconf:gen-simple-access (toc-autoresize-p
+                           :transform-value-fn (lambda (a) (not (swconf:false-value-p a)))
+                           :configuration-tree *client-configuration*)
+                          swconf:+key-toc+
+                          +key-autoresize+)
+
 (swconf:gen-simple-access (gemtext-padding
                            :transform-value-fn (lambda (a) (parse-integer a))
                            :configuration-tree *client-configuration*)

src/gui/client/main-window.lisp

@@ -117,13 +117,13 @@
                                              toc-max-width)))
       (when toc
         (let ((toc-widget-width (length (getf (first toc) :text))))
-          (setf (toc-char-width main-window) toc-widget-width)
           (loop for ct from 0
                 for toc-item in toc do
                   (gui:listbox-append (toc-listbox (toc-frame main-window))
                                       (getf toc-item :text)))
           (setf (toc-data (toc-frame main-window))
-                (loop for toc-item in toc collect (getf toc-item :header-group-id)))))
+                (loop for toc-item in toc collect (getf toc-item :header-group-id)))
+          (fit-toc-char-width main-window toc-widget-width)))
       main-window)))
 
 (defun slurp-gemini-stream (main-window iri stream-wrapper &key
@@ -1075,7 +1075,8 @@
                   #$<Enter>$
                   (lambda (e)
                     (declare (ignore e))
-                    (gui:configure-mouse-pointer gemtext-widget (gui:find-cursor :xterm))))
+                    (gui:configure-mouse-pointer gemtext-widget (gui:find-cursor :xterm))
+                    (gui:force-focus (gui:root-toplevel))))
         (setf (gui:command go-button)            (open-iri-clsr main-window t))
         (setf (gui:command reload-button)        (reload-iri-clsr main-window))
         (setf (gui:command back-button)          (back-iri-clsr main-window))
@@ -1200,6 +1201,10 @@
     :initform nil
     :initarg  :search-frame
     :accessor search-frame)
+   (gemini-paned-frame
+    :initform nil
+    :initarg  :gemini-paned-frame
+    :accessor gemini-paned-frame)
    (ir-rendered-lines
     :initform (misc:make-fresh-array 0)
     :initarg  :ir-rendered-lines
@@ -1210,51 +1215,53 @@
     :accessor ir-lines)))
 
 (defmethod initialize-instance :after ((object main-frame) &key &allow-other-keys)
-  (with-accessors ((main-window    main-window)
-                   (tool-bar       tool-bar)
-                   (toc-frame      toc-frame)
-                   (info-frame     info-frame)
-                   (search-frame   search-frame)
-                   (info-text      info-text)
-                   (gemtext-widget gemtext-widget)) object
-    (let ((paned-frame (make-instance 'gui:paned-window
-                                      :orientation :horizontal
-                                      :master      object)))
-      (setf tool-bar (make-instance 'tool-bar :master object))
-      (set-bookmark-button-false object)
-      (setf toc-frame (make-instance 'toc-frame :master paned-frame))
-      (let* ((gemtext-font  (gui-conf:gemini-text-font-configuration))
-             (padding       (client-configuration:config-gemtext-padding))
-             (padding-pixel (* padding (gui:font-measure gemtext-font "0"))))
-        (multiple-value-bind (select-bg select-fg)
-            (gui-conf:main-window-select-colors)
-          (setf gemtext-widget (make-instance 'gui:scrolled-text
-                                              :background (gui-conf:gemini-window-colors)
-                                              :selectbackground select-bg
-                                              :selectforeground select-fg
-                                              :padx       padding-pixel
-                                              :master     paned-frame
-                                              :read-only  t
-                                              :font       gemtext-font)))
-        (gui:configure gemtext-widget :wrap :word))
-      (setf info-frame (make-instance 'gui:frame :master object :relief :sunken :borderwidth 1))
-      (setf info-text (make-instance 'gui:text :height 2 :wrap :none :master info-frame))
-      (gui:configure info-text :font gui:+tk-small-caption-font+)
-      (setf search-frame (client-search-frame:init-window object))
-      (gui:grid info-text 0 0 :sticky :news)
-      (gui-goodies:gui-resize-grid-all info-frame)
-      (gui:grid tool-bar  0 0 :sticky :news)
-      (gui:add-pane paned-frame toc-frame)
-      (gui:add-pane paned-frame gemtext-widget)
-      (gui:grid paned-frame 1 0 :sticky :news)
-      (gui:grid search-frame   2 0 :sticky :news)
-      (gui:grid-forget search-frame)
-      (gui:grid info-frame     3 0 :sticky :ews)
-      (gui:grid-columnconfigure object 0 :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)))
+  (with-accessors ((main-window        main-window)
+                   (tool-bar           tool-bar)
+                   (toc-frame          toc-frame)
+                   (info-frame         info-frame)
+                   (search-frame       search-frame)
+                   (info-text          info-text)
+                   (gemtext-widget     gemtext-widget)
+                   (gemini-paned-frame gemini-paned-frame)) object
+    (setf gemini-paned-frame (make-instance 'gui:paned-window
+                                            :orientation :horizontal
+                                            :master      object))
+    (setf tool-bar (make-instance 'tool-bar :master object))
+    (set-bookmark-button-false object)
+    (setf toc-frame (make-instance 'toc-frame :master gemini-paned-frame))
+    (let* ((gemtext-font  (gui-conf:gemini-text-font-configuration))
+           (padding       (client-configuration:config-gemtext-padding))
+           (padding-pixel (* padding (gui:font-measure gemtext-font "0"))))
+      (multiple-value-bind (select-bg select-fg)
+          (gui-conf:main-window-select-colors)
+        (setf gemtext-widget (make-instance 'gui:scrolled-text
+                                            :background (gui-conf:gemini-window-colors)
+                                            :selectbackground select-bg
+                                            :selectforeground select-fg
+                                            :takefocus  (nodgui.utils:lisp-bool->tcl nil)
+                                            :padx       padding-pixel
+                                            :master     gemini-paned-frame
+                                            :read-only  t
+                                            :font       gemtext-font)))
+      (gui:configure gemtext-widget :wrap :word))
+    (setf info-frame (make-instance 'gui:frame :master object :relief :sunken :borderwidth 1))
+    (setf info-text (make-instance 'gui:text :height 2 :wrap :none :master info-frame))
+    (gui:configure info-text :font gui:+tk-small-caption-font+)
+    (setf search-frame (client-search-frame:init-window object))
+    (gui:grid info-text 0 0 :sticky :news)
+    (gui-goodies:gui-resize-grid-all info-frame)
+    (gui:grid tool-bar  0 0 :sticky :news)
+    (gui:add-pane gemini-paned-frame toc-frame)
+    (gui:add-pane gemini-paned-frame gemtext-widget)
+    (gui:grid gemini-paned-frame 1 0 :sticky :news)
+    (gui:grid search-frame   2 0 :sticky :news)
+    (gui:grid-forget search-frame)
+    (gui:grid info-frame     3 0 :sticky :ews)
+    (gui:grid-columnconfigure object 0 :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))
 
 (defgeneric toc-char-width (object))
 
@@ -1267,8 +1274,23 @@
 (defmethod toc-clear ((object main-frame))
   (gui:listbox-delete (toc-listbox (toc-frame object))))
 
-(defmethod (setf toc-char-width) (new-width (object main-frame))
-  (gui:configure (gui:listbox (toc-listbox (toc-frame object))) :width new-width))
+(defgeneric fit-toc-char-width (object new-width))
+
+(defmethod fit-toc-char-width ((object main-frame) new-width)
+  (with-accessors ((toc-frame          toc-frame)
+                   (gemini-paned-frame gemini-paned-frame)) object
+    (a:when-let* ((inner-listbox (gui:listbox (toc-listbox (toc-frame object))))
+                  (listbox-items (gui:listbox-all-values inner-listbox))
+                  (font          (gui:cget inner-listbox :font))
+                  (longest-value (reduce (lambda (a b)
+                                           (if (> (length a) (length b))
+                                               a
+                                               b))
+                                         listbox-items))
+                  (width-pixel (gui:font-measure font (strcat longest-value "MM"))))
+      (gui:configure inner-listbox :width new-width)
+      (when (client-configuration:config-toc-autoresize-p)
+        (gui:sash-place gemini-paned-frame 0 width-pixel)))))
 
 (defun print-info-message (message &key
                                      (color (gui-goodies:parse-color "black"))

src/gui/server/public-api-gemini-stream.lisp

@@ -453,18 +453,15 @@
                     (longest-number    (find-longest-string toc-numbers))
                     (max-number-length (length longest-number))
                     (max-non-padded-text-size (+ max-text-length max-number-length))
-                    (toc-entries-text (loop for text in toc-text
-                                            for number in toc-numbers
-                                            collect
-                                            (let* ((text-length  (+ (length text)
-                                                                    (length number)))
-                                                   (padding-size (- max-non-padded-text-size
-                                                                    text-length))
-                                                   (padding (make-string padding-size
-                                                                         :initial-element (swconf:gemini-toc-padding-char))))
-                                              (strcat number
-                                                      padding
-                                                      text)))))
+                    (toc-entries-text
+                     (loop for text in toc-text
+                           for number in toc-numbers
+                           collect
+                           (let* ((prefix (right-padding number
+                                                         max-number-length
+                                                         :padding-char
+                                                         (swconf:gemini-toc-padding-char))))
+                             (strcat prefix text)))))
         (values
          (loop for toc-entry in toc
                for text in toc-entries-text

src/package.lisp

@@ -3289,6 +3289,7 @@
    :gemini-preformatted-text-justification
    :config-toc-maximum-width
    :config-toc-minimum-width
+   :config-toc-autoresize-p
    :toc-font-configuration
    :get-keybinding
    :config-keybinding-tour-shuffle