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

- [GUI] added button to subscribe (and unsubscribe) to a gemlog.

This commit is contained in:
cage 2023-05-07 12:21:29 +02:00
parent 71912a8c21
commit 4519aa756e
10 changed files with 172 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
data/icons/fmw_rss-add.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
data/icons/fmw_rss-delete.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.7 KiB

2
src/constants.lisp
View File

@ -170,3 +170,5 @@ General Public License for more details."
(define-constant +internal-scheme+ "about" :test #'string=)
(define-constant +internal-path-bookmark+ "bookmark" :test #'string=)
(define-constant +internal-path-gemlogs+ "gemlog" :test #'string=)

3
src/db.lisp
View File

@ -3106,6 +3106,9 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)'
(defun gemini-cancel-subscription (gemlog-url)
(query (delete-from +table-gemini-subscription+ (where (:= :url gemlog-url)))))
(defun gemini-gemlog-subscribed-p (gemlog-url)
(query (select :* (from +table-gemini-subscription+) (where (:= :url gemlog-url)))))
(defun find-gemlog-entry (post-url)
(when-let* ((query (select :*
(from +table-gemlog-entries+)

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

@ -2,77 +2,85 @@
(a:define-constant +icon-dir+ "/data/icons/" :test #'string=)
(a:define-constant +search+ "fmw_search" :test #'string=)
(a:define-constant +search+ "fmw_search" :test #'string=)
(a:define-constant +back+ "fmw_back" :test #'string=)
(a:define-constant +back+ "fmw_back" :test #'string=)
(a:define-constant +go+ "fmw_go" :test #'string=)
(a:define-constant +go+ "fmw_go" :test #'string=)
(a:define-constant +open-tour+ "fmw_open_tour" :test #'string=)
(a:define-constant +open-tour+ "fmw_open_tour" :test #'string=)
(a:define-constant +refresh+ "fmw_refresh" :test #'string=)
(a:define-constant +refresh+ "fmw_refresh" :test #'string=)
(a:define-constant +up+ "fmw_uparrow" :test #'string=)
(a:define-constant +up+ "fmw_uparrow" :test #'string=)
(a:define-constant +document-delete+ "fmw_document-delete" :test #'string=)
(a:define-constant +document-delete+ "fmw_document-delete" :test #'string=)
(a:define-constant +document-add+ "fmw_document-add" :test #'string=)
(a:define-constant +document-add+ "fmw_document-add" :test #'string=)
(a:define-constant +document-accept+ "fmw_document-accept" :test #'string=)
(a:define-constant +document-accept+ "fmw_document-accept" :test #'string=)
(a:define-constant +document-edit+ "fmw_document-edit" :test #'string=)
(a:define-constant +document-edit+ "fmw_document-edit" :test #'string=)
(a:define-constant +folder+ "fmw_folder" :test #'string=)
(a:define-constant +folder+ "fmw_folder" :test #'string=)
(a:define-constant +star-yellow+ "fmw_star-yellow.png" :test #'string=)
(a:define-constant +star-yellow+ "fmw_star-yellow.png" :test #'string=)
(a:define-constant +star-blue+ "fmw_star-blue.png" :test #'string=)
(a:define-constant +star-blue+ "fmw_star-blue.png" :test #'string=)
(a:define-constant +arrow-up+ "fmw_arrow-up" :test #'string=)
(a:define-constant +arrow-up+ "fmw_arrow-up" :test #'string=)
(a:define-constant +arrow-down+ "fmw_arrow-down" :test #'string=)
(a:define-constant +arrow-down+ "fmw_arrow-down" :test #'string=)
(a:define-constant +cross+ "fmw_cross" :test #'string=)
(a:define-constant +cross+ "fmw_cross" :test #'string=)
(a:define-constant +bus-go+ "fmw_bus-go" :test #'string=)
(a:define-constant +bus-go+ "fmw_bus-go" :test #'string=)
(a:define-constant +dice+ "fmw_dice" :test #'string=)
(a:define-constant +dice+ "fmw_dice" :test #'string=)
(defparameter *search* nil)
(a:define-constant +gemlog-subscribe+ "fmw_rss-add.png" :test #'string=)
(defparameter *back* nil)
(a:define-constant +gemlog-unsubscribe+ "fmw_rss-delete.png" :test #'string=)
(defparameter *open-iri* nil)
(defparameter *search* nil)
(defparameter *open-tour* nil)
(defparameter *back* nil)
(defparameter *refresh* nil)
(defparameter *open-iri* nil)
(defparameter *up* nil)
(defparameter *open-tour* nil)
(defparameter *document-delete* nil)
(defparameter *refresh* nil)
(defparameter *document-add* nil)
(defparameter *up* nil)
(defparameter *document-accept* nil)
(defparameter *document-delete* nil)
(defparameter *document-edit* nil)
(defparameter *document-add* nil)
(defparameter *folder* nil)
(defparameter *document-accept* nil)
(defparameter *star-yellow* nil)
(defparameter *document-edit* nil)
(defparameter *star-blue* nil)
(defparameter *folder* nil)
(defparameter *arrow-up* nil)
(defparameter *star-yellow* nil)
(defparameter *arrow-down* nil)
(defparameter *star-blue* nil)
(defparameter *cross* nil)
(defparameter *arrow-up* nil)
(defparameter *bus-go* nil)
(defparameter *arrow-down* nil)
(defparameter *dice* nil)
(defparameter *cross* nil)
(defparameter *bus-go* nil)
(defparameter *dice* nil)
(defparameter *gemlog-subscribe* nil)
(defparameter *gemlog-unsubscribe* nil)
(defun load-icon (filename)
(let ((path (if (not (re:scan "(?i)png$" filename))
@ -84,21 +92,23 @@
(gui:make-image data)))))
(defun load-icons ()
(setf *search* (load-icon +search+))
(setf *back* (load-icon +back+))
(setf *open-iri* (load-icon +go+))
(setf *open-tour* (load-icon +open-tour+))
(setf *refresh* (load-icon +refresh+))
(setf *up* (load-icon +up+))
(setf *document-delete* (load-icon +document-delete+))
(setf *document-add* (load-icon +document-add+))
(setf *document-accept* (load-icon +document-accept+))
(setf *document-edit* (load-icon +document-edit+))
(setf *folder* (load-icon +folder+))
(setf *star-yellow* (load-icon +star-yellow+))
(setf *star-blue* (load-icon +star-blue+))
(setf *arrow-up* (load-icon +arrow-up+))
(setf *arrow-down* (load-icon +arrow-down+))
(setf *cross* (load-icon +cross+))
(setf *bus-go* (load-icon +bus-go+))
(setf *dice* (load-icon +dice+)))
(setf *search* (load-icon +search+))
(setf *back* (load-icon +back+))
(setf *open-iri* (load-icon +go+))
(setf *open-tour* (load-icon +open-tour+))
(setf *refresh* (load-icon +refresh+))
(setf *up* (load-icon +up+))
(setf *document-delete* (load-icon +document-delete+))
(setf *document-add* (load-icon +document-add+))
(setf *document-accept* (load-icon +document-accept+))
(setf *document-edit* (load-icon +document-edit+))
(setf *folder* (load-icon +folder+))
(setf *star-yellow* (load-icon +star-yellow+))
(setf *star-blue* (load-icon +star-blue+))
(setf *arrow-up* (load-icon +arrow-up+))
(setf *arrow-down* (load-icon +arrow-down+))
(setf *cross* (load-icon +cross+))
(setf *bus-go* (load-icon +bus-go+))
(setf *dice* (load-icon +dice+))
(setf *gemlog-subscribe* (load-icon +gemlog-subscribe+))
(setf *gemlog-unsubscribe* (load-icon +gemlog-unsubscribe+)))

3
src/gui/client/internal-paths.lisp
View File

@ -6,6 +6,9 @@
(defun internal-iri-bookmark ()
(make-internal-iri +internal-path-bookmark+))
(defun internal-iri-gemlogs ()
(make-internal-iri +internal-path-gemlogs+))
(defun show-bookmarks-page (main-window)
(ev:with-enqueued-process-and-unblock ()
(let ((parsed-page (comm:make-request :gemini-generate-bookmark-page 1))

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

@ -157,13 +157,17 @@
(print-info-message (_ "Stream finished"))
(render-toc main-window iri))
(if (cev:enqueue-request-and-wait-results :gemini-bookmarked-p
1
ev:+standard-event-priority+
iri)
1
ev:+standard-event-priority+
iri)
(ev:with-enqueued-process-and-unblock ()
(set-bookmark-button-true main-window))
(ev:with-enqueued-process-and-unblock ()
(set-bookmark-button-false main-window)))))
(set-bookmark-button-false main-window)))
(ev:with-enqueued-process-and-unblock ()
(if (comm:make-request :gemini-gemlog-subscribed-p 1 iri)
(set-subscribe-button-subscribed main-window)
(set-subscribe-button-unsubscribed main-window)))))
(defun start-streaming-thread (main-window iri
&key
@ -252,7 +256,11 @@
(tour-button
:initform nil
:initarg :tour-button
:accessor tour-button)))
:accessor tour-button)
(subscribe-button
:initform nil
:initarg :subscribe-button
:accessor subscribe-button)))
(defun autocomplete-iri-clsr (toolbar)
(declare (ignore toolbar))
@ -797,7 +805,18 @@
(defun set-bookmark-button-true (main-window)
(set-bookmark-button-image main-window icons:*star-blue*))
(defun bookmark-iri-clsr (main-window)
(defun set-subscribe-button-image (main-window image)
(with-accessors ((tool-bar tool-bar)) main-window
(with-accessors ((subscribe-button subscribe-button)) tool-bar
(gui:configure subscribe-button :image image))))
(defun set-subscribe-button-unsubscribed (main-window)
(set-subscribe-button-image main-window icons:*gemlog-subscribe*))
(defun set-subscribe-button-subscribed (main-window)
(set-subscribe-button-image main-window icons:*gemlog-unsubscribe*))
(defun toggle-bookmark-iri-clsr (main-window)
(lambda ()
(with-accessors ((tool-bar tool-bar)) main-window
(with-accessors ((iri-entry iri-entry)) tool-bar
@ -812,6 +831,23 @@
(set-bookmark-button-false main-window))
(client-bookmark-window:init-window main-window (gui:text iri-entry))))))))
(defun toggle-subscribtion-iri-clsr (main-window)
(lambda ()
(with-accessors ((tool-bar tool-bar)) main-window
(with-accessors ((iri-entry iri-entry)) tool-bar
(ev:with-enqueued-process-and-unblock ()
(let* ((iri (gui:text iri-entry))
(subscribedp (comm:make-request :gemini-gemlog-subscribed-p
1
iri)))
(if subscribedp
(progn
(comm:make-request :gemini-gemlog-unsubscribe 1 iri)
(set-subscribe-button-unsubscribed main-window))
(progn
(comm:make-request :gemini-gemlog-subscribe 1 iri)
(set-subscribe-button-subscribed main-window)))))))))
(defun tour-visit-next-iri-clsr (main-window)
(lambda ()
(let ((next-link (cev:enqueue-request-and-wait-results :tour-pop-link
@ -827,13 +863,14 @@
(toc-frame toc-frame)
(gemtext-widget gemtext-widget)
(ir-lines ir-lines)) main-window
(with-accessors ((iri-entry iri-entry)
(back-button back-button)
(reload-button reload-button)
(up-button up-button)
(go-button go-button)
(bookmark-button bookmark-button)
(tour-button tour-button)) tool-bar
(with-accessors ((iri-entry iri-entry)
(back-button back-button)
(reload-button reload-button)
(up-button up-button)
(go-button go-button)
(bookmark-button bookmark-button)
(tour-button tour-button)
(subscribe-button subscribe-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
@ -845,44 +882,51 @@
(gui:bind toc-listbox
#$<<ListboxSelect>>$
(toc-callback-clsr main-window))
(setf (gui:command go-button) (open-iri-clsr main-window t))
(setf (gui:command reload-button) (reload-iri-clsr main-window))
(setf (gui:command back-button) (back-iri-clsr main-window))
(setf (gui:command up-button) (up-iri-clsr main-window))
(setf (gui:command bookmark-button) (bookmark-iri-clsr main-window))
(setf (gui:command tour-button) (tour-visit-next-iri-clsr main-window))))))
(setf (gui:command go-button) (open-iri-clsr main-window t))
(setf (gui:command reload-button) (reload-iri-clsr main-window))
(setf (gui:command back-button) (back-iri-clsr main-window))
(setf (gui:command up-button) (up-iri-clsr main-window))
(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))))))
(defmethod initialize-instance :after ((object tool-bar) &key &allow-other-keys)
(with-accessors ((iri-entry iri-entry)
(back-button back-button)
(reload-button reload-button)
(up-button up-button)
(go-button go-button)
(bookmark-button bookmark-button)
(tour-button tour-button)) object
(with-accessors ((iri-entry iri-entry)
(back-button back-button)
(reload-button reload-button)
(up-button up-button)
(go-button go-button)
(bookmark-button bookmark-button)
(tour-button tour-button)
(subscribe-button subscribe-button)) object
(gui:configure object :relief :raised)
(setf iri-entry (make-instance 'gui-mw:autocomplete-entry
:master object
:autocomplete-function (autocomplete-iri-clsr object)))
(setf back-button (make-instance 'gui:button :master object :image icons:*back*))
(setf reload-button (make-instance 'gui:button :master object :image icons:*refresh*))
(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 bookmark-button (make-instance 'gui:button :master object))
(setf tour-button (make-instance 'gui:button :master object :image icons:*bus-go*))
(gui-goodies:attach-tooltips (back-button (_ "go back"))
(reload-button (_ "reload address"))
(go-button (_ "go to address"))
(up-button (_ "one level up"))
(bookmark-button (_ "add or remove bookmark"))
(tour-button (_ "go to the next link in tour")))
(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 iri-entry 0 3 :sticky :nswe :padx +minimum-padding+)
(gui:grid go-button 0 4 :sticky :nsw)
(gui:grid bookmark-button 0 5 :sticky :nsw)
(gui:grid tour-button 0 6 :sticky :nsw)
(setf back-button (make-instance 'gui:button :master object :image icons:*back*))
(setf reload-button (make-instance 'gui:button :master object :image icons:*refresh*))
(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 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
:master object
:image icons:*gemlog-subscribe*))
(gui-goodies:attach-tooltips (back-button (_ "go back"))
(reload-button (_ "reload address"))
(go-button (_ "go to address"))
(up-button (_ "one level up"))
(bookmark-button (_ "add or remove bookmark"))
(tour-button (_ "go to the next link in tour"))
(subscribe-button (_ "subscribe/unsubscribe to this gemlog")))
(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 iri-entry 0 3 :sticky :nswe :padx +minimum-padding+)
(gui:grid go-button 0 4 :sticky :nsw)
(gui:grid bookmark-button 0 5 :sticky :nsw)
(gui:grid subscribe-button 0 6 :sticky :nsw)
(gui:grid tour-button 0 7 :sticky :nsw)
(gui:grid-columnconfigure object 3 :weight 2)
object))

5
src/gui/server/public-api-gemini-gemlog.lisp
View File

@ -22,6 +22,11 @@
(defun gemini-gemlog-subscribe (iri)
(gemini-subscription::subscribe iri))
(defun gemini-gemlog-subscribed-p (iri)
(if (db:gemini-gemlog-subscribed-p iri)
t
nil))
(defclass gemini-gemlog-subscriptions (box) ())
(defmethod yason:encode ((object gemini-gemlog-subscriptions) &optional (stream *standard-output*))

1
src/gui/server/public-api.lisp
View File

@ -116,6 +116,7 @@
(gen-rpc "gemini-bookmark-table" 'gemini-bookmark-table)
(gen-rpc "gemini-bookmarked-p" 'gemini-bookmarked-p "iri" 0)
(gen-rpc "gemini-gemlog-subscribe" 'gemini-gemlog-subscribe "iri" 0)
(gen-rpc "gemini-gemlog-subscribed-p" 'gemini-gemlog-subscribed-p "iri" 0)
(gen-rpc "gemini-gemlog-all-subscription" 'gemini-gemlog-all-subscription)
(gen-rpc "gemini-gemlog-unsubscribe" 'gemini-gemlog-unsubscribe "iri" 0)
(gen-rpc "gemini-gemlog-entries" 'gemini-gemlog-entries

6
src/package.lisp
View File

@ -72,6 +72,7 @@
:+file-scheme+
:+internal-scheme+
:+internal-path-bookmark+
:+internal-path-gemlogs+
;; GUI
:+minimum-padding+
:+ps-file-dialog-filter+
@ -1101,6 +1102,7 @@
:find-gemlog-entry
:gemini-all-unread-posts
:gemini-cancel-subscription
:gemini-gemlog-subscribed-p
:add-gemlog-entries
:gemlog-mark-as-seen
:gemlog-url
@ -3342,7 +3344,9 @@
:*arrow-down*
:*cross*
:*bus-go*
:*dice*))
:*dice*
:*gemlog-subscribe*
:*gemlog-unsubscribe*))
(defpackage :validation
(:use