mirror of https://codeberg.org/cage/tinmop/
- [GUI] restored auto-adjust width of TOC widget.
This commit is contained in:
cage
parent
d3defee0ed
commit
0e7d9f9e0e
|
|
@ -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"))
|
||||
|
|
|
|||
Loading…
Reference in New Issue