From 0e7d9f9e0e115a58ac43690d401e1a65389a0e6a Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 20 May 2023 16:50:31 +0200 Subject: [PATCH] - [GUI] restored auto-adjust width of TOC widget. --- src/gui/client/main-window.lisp | 117 +++++++++++++++++++------------- 1 file changed, 68 insertions(+), 49 deletions(-) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index 9e6361b..4c0ff26 100644 --- a/src/gui/client/main-window.lisp +++ b/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 @@ -1200,6 +1200,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 +1214,52 @@ :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 + :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 +1272,22 @@ (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) + (gui:sash-place gemini-paned-frame 0 width-pixel)))) (defun print-info-message (message &key (color (gui-goodies:parse-color "black"))