cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [GUI] added a button thet acs as a shortcut to open the TOC of the last opened gempub.

This commit is contained in:
cage 2024-09-29 11:38:12 +02:00
parent 8ffd321218
commit 4904b3939a
7 changed files with 95 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.am
View File

@ -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 \

1
Makefile.in
View File

@ -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 \

BIN
data/icons/fmw_toc.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

17
src/gui/client/gempub-window.lisp
View File

@ -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)

10
src/gui/client/icons.lisp
View File

@ -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+))))

57
src/gui/client/main-window.lisp
View File

@ -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
@ -1691,6 +1722,7 @@ local file paths."
(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,7 +1771,11 @@ local file paths."
main-window)
(defclass main-frame (gui:frame)
((gemtext-widget
((gempub-metadata
:initform nil
:initarg :gempub-metadata
:accessor gempub-metadata)
(gemtext-widget
:initform nil
:initarg :gemtext-widget
:accessor gemtext-widget)
@ -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))

10
src/package.lisp
View File

@ -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