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 0000000..870380d Binary files /dev/null and b/data/icons/fmw_toc.png differ 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