From 4904b3939affcdce487ee690202f8468cd78be30 Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 29 Sep 2024 11:38:12 +0200 Subject: [PATCH] - [GUI] added a button thet acs as a shortcut to open the TOC of the last opened gempub. --- Makefile.am | 1 + Makefile.in | 1 + data/icons/fmw_toc.png | Bin 0 -> 1410 bytes src/gui/client/gempub-window.lisp | 17 +++++-- src/gui/client/icons.lisp | 10 +++- src/gui/client/main-window.lisp | 79 ++++++++++++++++++++++++------ src/package.lisp | 10 +++- 7 files changed, 95 insertions(+), 23 deletions(-) create mode 100644 data/icons/fmw_toc.png diff --git a/Makefile.am b/Makefile.am index 83d77d1..08d1d9c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -75,6 +75,7 @@ data/icons/fmw_search.png \ data/icons/fmw_star-blue.png \ data/icons/fmw_star-yellow.png \ data/icons/fmw_text.png \ +data/icons/fmw_toc.png \ data/icons/fmw_two-pictures.png \ data/icons/fmw_uparrow.png \ data/modules/delete-by-regex.lisp \ diff --git a/Makefile.in b/Makefile.in index 089d98c..70772f9 100644 --- a/Makefile.in +++ b/Makefile.in @@ -442,6 +442,7 @@ data/icons/fmw_search.png \ data/icons/fmw_star-blue.png \ data/icons/fmw_star-yellow.png \ data/icons/fmw_text.png \ +data/icons/fmw_toc.png \ data/icons/fmw_two-pictures.png \ data/icons/fmw_uparrow.png \ data/modules/delete-by-regex.lisp \ diff --git a/data/icons/fmw_toc.png b/data/icons/fmw_toc.png new file mode 100644 index 0000000000000000000000000000000000000000..870380d880ee67be539aaa954d83b33266a45cb6 GIT binary patch literal 1410 zcmV-|1%3L7P)`7+A3Z#T`OBA<1VGcWX7oRMq>n!tK;HAT9r&dAySqZ z7(;JErv24xZ&-uCW}X3va8somq9zMRI*=BGu!}Sq_Oy$#F4JGHG53w}o$*`3iKELo zc^v!VC?=*pCjbhJf#+-Ep{rvPp6YrAC3lhf^wk3pCSro07ywF)jDztX&R}%UTR2zz zntCMrk9F<0;=#j@VyI^ywOj(^Gm{pNuq%q9i2~?5kA!_B7*JA?=Mulq7V+u%cP$I- z{fgFA1VveZP&t~bEel51=0un$Qc4>@1Z@tZ>-lSVeF^~Dn`tLgGo@)1S_;;vhG*M? zfMrz%cMk3beWJVPUTCe80Bo)py!3b%HV*8?<}LU6K&^3u{SVzvKy)1jXp)eA;?0>q z(Av^$6~Sn^&5PLF_{hNu113gmi~*Mtb>h@PpMik-kOA^CF+afod&wJ@oj=jm)*PvT z+l*Y3cjdBcH>wYg!K-+BO;KKj?QZVO&H@fpRxGNg@b`&}B>p@_tlD85Pn zl$q5fCc%J5%ZB>)W8bzHDTylm6l%ESd8srTZFJQt6!lcVBbhvk@AYE#+cDq6a5BBE z>w9p`10O&V8)%>oSnx8f4sd)(Vl$It*mU4Kpg6|5u)LtX2jkD(j8*+P2(>_Sy{Hb< z(|w{Qgnm$%ZH3io3`ho`{O?Os!1<$op=6H>?TinZoPwkBlt`XUR!&CNHA`D58D)J~ zaoJ!v#`DUq7vztqqk=H*<)1(@pbq7GOKo1lb!dIxlW>Ga*XFI1>7JF=t9!QMroLTP z_qOl^#m5WAZoFp~x@rEQr+cYR=#(ThVIc~U6bZm`>L)~GjN8^D`aJvLaRL)CpnYR5 zd3N@r*DDN|3gtZZJ&o}YWTtJu7pNi10aVI?XT0=- zFBmfcC>fVm^;sabz>3bhF)@5PsdHMnlKLgl=h;$fVnUIGRLgY6WkAWSI>Ppjrl! z5p$~Ut5ylqvn9NL?xOu>W7igPzCvUc`KC-I!|aLZ8{)r;?*O85EOXXZ%Py6Hco=wt z-~Mt*h1uXfBy3v-YdX3I$O}pL0jdMqi_ZEJ!-H6T$9CM+d%wLWu< z;g1&0v{qm4q8u=Zq|nB{V^rTcQYvAEqn(`{IPm5O#k_))4esn*6J0KAL?21pB>H5^ zv8_S|Ok9SsiLdS0Xy1C*46bCdfu98;1Q6J?033CtTZ+mC4L+ew3n1&Lx$V1OUT!aq z=70WyN}jWEwi%Y|0==v0ZNtCb^!~Gly_})b%707*qoM6N<$f>M5|)Bpeg literal 0 HcmV?d00001 diff --git a/src/gui/client/gempub-window.lisp b/src/gui/client/gempub-window.lisp index b582b8c..4ecfacb 100644 --- a/src/gui/client/gempub-window.lisp +++ b/src/gui/client/gempub-window.lisp @@ -129,6 +129,15 @@ gempub-content-directory)) (fs:cat-parent-dir gempub-content-directory "/")))) +(defun open-gemini-toc (main-window gempub-metadata) + (client-main-window::set-address-bar-text main-window + (getf gempub-metadata :book-directory)) + (client-main-window::open-iri (getf gempub-metadata :index-file) + main-window + nil) + (ev:with-enqueued-process-and-unblock () + (client-main-window::inline-all-images main-window))) + (defun open-gempub-clsr (main-window gempub-frame) (lambda (e) (declare (ignore e)) @@ -142,10 +151,10 @@ id))) (multiple-value-bind (path book-directory) (make-gempub-index row) - (client-main-window::set-address-bar-text main-window book-directory) - (client-main-window::open-iri path main-window nil) - (ev:with-enqueued-process-and-unblock () - (client-main-window::inline-all-images main-window))))))) + (setf (getf row :index-file) path) + (setf (getf row :book-directory) book-directory) + (client-main-window:set-gempub-mode main-window row) + (open-gemini-toc main-window row)))))) (defun init-window (master main-window query-results) (client-main-window:hide-autocomplete-candidates main-window) diff --git a/src/gui/client/icons.lisp b/src/gui/client/icons.lisp index b5e08bb..cdcd708 100644 --- a/src/gui/client/icons.lisp +++ b/src/gui/client/icons.lisp @@ -48,6 +48,8 @@ (a:define-constant +profile+ "fmw_profile.png" :test #'string=) +(a:define-constant +toc+ "fmw_toc.png" :test #'string=) + (defparameter *search* nil) (defparameter *back* nil) @@ -96,6 +98,10 @@ (defparameter *profile-disabled* nil) +(defparameter *toc* nil) + +(defparameter *toc-disabled* nil) + (defun icon-filename->filepath (filename) (if (not (re:scan "(?i)png$" filename)) (res:get-data-file (fs:cat-parent-dir +icon-dir+ @@ -141,4 +147,6 @@ (setf *inline-images* (load-icon +inline-images+)) (setf *text* (load-icon +text+)) (setf *profile* (load-icon +profile+)) - (setf *profile-disabled* (disable-icon +profile+)))) + (setf *profile-disabled* (disable-icon +profile+)) + (setf *toc* (load-icon +toc+)) + (setf *toc-disabled* (disable-icon +toc+)))) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index c927a0b..737a456 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -364,7 +364,11 @@ (inline-images-button :initform nil :initarg :inline-images-button - :accessor inline-images-button))) + :accessor inline-images-button) + (toc-button + :initform nil + :initarg :toc-button + :accessor toc-button))) (defun autocomplete-iri-clsr (toolbar) (declare (ignore toolbar)) @@ -1524,6 +1528,17 @@ local file paths." (gui:configure (certificate-button (tool-bar main-window)) :state :disabled) (set-certificate-button-image main-window icons:*profile-disabled*)) +(defun set-toc-button-image (main-window image) + (set-toolbar-button-image main-window 'toc-button image)) + +(defun set-toc-button-active (main-window) + (gui:configure (toc-button (tool-bar main-window)) :state :normal) + (set-toc-button-image main-window icons:*toc*)) + +(defun set-toc-button-inactive (main-window) + (gui:configure (toc-button (tool-bar main-window)) :state :disabled) + (set-toc-button-image main-window icons:*toc-disabled*)) + (defun toggle-bookmark-iri-clsr (main-window) (lambda () (with-accessors ((tool-bar tool-bar)) main-window @@ -1604,6 +1619,16 @@ local file paths." (get-address-bar-text main-window)))) (change-client-certificate-key-passphrase main-window key-path)))) +(defun open-index-gempub-clsr (main-window) + (lambda () + (with-accessors ((gempub-metadata gempub-metadata)) main-window + (when (gempub-mode-p main-window) + (let ((iri (getf gempub-metadata :index-file))) + (if (string-not-empty-p iri) + (ev:with-enqueued-process-and-unblock () + (client-gempub-window::open-gemini-toc main-window gempub-metadata)) + (gui-goodies:notify-request-error (_ "Index file not found")))))))) + (defun setup-main-window-events (main-window) (with-accessors ((tool-bar tool-bar) (toc-frame toc-frame) @@ -1618,7 +1643,8 @@ local file paths." (bookmark-button bookmark-button) (tour-button tour-button) (subscribe-button subscribe-button) - (inline-images-button inline-images-button)) tool-bar + (inline-images-button inline-images-button) + (toc-button toc-button)) tool-bar (let ((entry-autocomplete (gui-mw:autocomplete-entry-widget iri-entry)) (toc-listbox (gui:listbox (toc-listbox toc-frame)))) (gui:bind entry-autocomplete @@ -1643,7 +1669,8 @@ local file paths." (setf (gui:command bookmark-button) (toggle-bookmark-iri-clsr main-window)) (setf (gui:command tour-button) (tour-visit-next-iri-clsr main-window)) (setf (gui:command subscribe-button) (toggle-subscribtion-iri-clsr main-window)) - (setf (gui:command inline-images-button) (inline-all-images-clsr main-window)))))) + (setf (gui:command inline-images-button) (inline-all-images-clsr main-window)) + (setf (gui:command toc-button) (open-index-gempub-clsr main-window)))))) (defmethod initialize-instance :after ((object tool-bar) &key &allow-other-keys) (with-accessors ((iri-entry iri-entry) @@ -1655,7 +1682,8 @@ local file paths." (bookmark-button bookmark-button) (tour-button tour-button) (subscribe-button subscribe-button) - (inline-images-button inline-images-button)) object + (inline-images-button inline-images-button) + (toc-button toc-button)) object (gui:configure object :relief :raised) (setf iri-entry (make-instance 'gui-mw:autocomplete-entry :master object @@ -1665,6 +1693,9 @@ local file paths." (setf go-button (make-instance 'gui:button :master object :image icons:*open-iri*)) (setf up-button (make-instance 'gui:button :master object :image icons:*up*)) (setf certificate-button (make-instance 'gui:button :master object :image icons:*profile-disabled*)) + (setf toc-button (make-instance 'gui:button + :master object + :image icons:*toc-disabled*)) (setf bookmark-button (make-instance 'gui:button :master object)) (setf tour-button (make-instance 'gui:button :master object :image icons:*bus-go*)) (setf subscribe-button (make-instance 'gui:button @@ -1681,16 +1712,17 @@ local file paths." (tour-button (_ "go to the next link in tour")) (subscribe-button (_ "subscribe/unsubscribe to this gemlog")) (inline-images-button (_ "inline images"))) - (gui:grid back-button 0 0 :sticky :nsw) - (gui:grid reload-button 0 1 :sticky :nsw) - (gui:grid up-button 0 2 :sticky :nsw) - (gui:grid certificate-button 0 3 :sticky :nsw) - (gui:grid iri-entry 0 4 :sticky :nswe :padx +minimum-padding+) - (gui:grid go-button 0 5 :sticky :nsw) - (gui:grid bookmark-button 0 6 :sticky :nsw) - (gui:grid subscribe-button 0 7 :sticky :nsw) - (gui:grid tour-button 0 8 :sticky :nsw) - (gui:grid inline-images-button 0 9 :sticky :nsw) + (gui:grid back-button 0 0 :sticky :nsw) + (gui:grid reload-button 0 1 :sticky :nsw) + (gui:grid up-button 0 2 :sticky :nsw) + (gui:grid certificate-button 0 3 :sticky :nsw) + (gui:grid iri-entry 0 4 :sticky :nswe :padx +minimum-padding+) + (gui:grid go-button 0 5 :sticky :nsw) + (gui:grid bookmark-button 0 6 :sticky :nsw) + (gui:grid subscribe-button 0 7 :sticky :nsw) + (gui:grid tour-button 0 8 :sticky :nsw) + (gui:grid inline-images-button 0 9 :sticky :nsw) + (gui:grid toc-button 0 10 :sticky :nsw) (gui:grid-columnconfigure object 4 :weight 2) object)) @@ -1739,9 +1771,13 @@ local file paths." main-window) (defclass main-frame (gui:frame) - ((gemtext-widget + ((gempub-metadata :initform nil - :initarg :gemtext-widget + :initarg :gempub-metadata + :accessor gempub-metadata) + (gemtext-widget + :initform nil + :initarg :gemtext-widget :accessor gemtext-widget) (gemtext-font-scaling :initform 1.0 @@ -2155,3 +2191,14 @@ local file paths." (defun hide-autocomplete-candidates (main-window) (gui-mw:hide-candidates (iri-entry (tool-bar main-window)))) + +(defun gempub-mode-p (main-window) + (gempub-metadata main-window)) + +(defun unset-gempub-mode (main-window) + (setf (gempub-metadata main-window) nil) + (set-toc-button-inactive main-window)) + +(defun set-gempub-mode (main-window metadata) + (setf (gempub-metadata main-window) metadata) + (set-toc-button-active main-window)) diff --git a/src/package.lisp b/src/package.lisp index 9f87bcf..18ffe5a 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3536,7 +3536,9 @@ :*inline-images* :*text* :*profile* - :*profile-disabled*)) + :*profile-disabled* + :*toc* + :*toc-disabled*)) (defpackage :validation (:use @@ -3835,7 +3837,11 @@ :make-internal-iri :internal-iri-bookmark :show-bookmarks-page - :hide-autocomplete-candidates)) + :hide-autocomplete-candidates + :gempub-metadata + :gempub-mode-p + :unset-gempub-mode + :set-gempub-mode)) (defpackage :main (:use