mirror of https://codeberg.org/cage/tinmop/
140 lines
6.6 KiB
Common Lisp
140 lines
6.6 KiB
Common Lisp
(in-package :client-gemlog-window)
|
|
|
|
(named-readtables:in-readtable nodgui.syntax:nodgui-syntax)
|
|
|
|
(defclass gemlog-frame (gui-goodies:table-frame) ())
|
|
|
|
(defun build-column-values (unseen-count
|
|
seen-count
|
|
title
|
|
subtitle)
|
|
(list unseen-count
|
|
seen-count
|
|
title
|
|
subtitle))
|
|
|
|
(defmacro build-column-value-accessor (name index)
|
|
(assert (>= index 0))
|
|
(assert (symbolp name))
|
|
`(defun ,(format-fn-symbol t "column-~a" name) (fields)
|
|
(elt fields ,index)))
|
|
|
|
(build-column-value-accessor unseen-count 0)
|
|
|
|
(build-column-value-accessor seen-count 1)
|
|
|
|
(build-column-value-accessor title 2)
|
|
|
|
(build-column-value-accessor subtitle 3)
|
|
|
|
(defun resync-rows (gemlog-frame new-rows)
|
|
(with-accessors ((tree gui-goodies:tree)
|
|
(rows gui-goodies:rows)) gemlog-frame
|
|
(gui:treeview-delete-all tree)
|
|
(setf rows new-rows)
|
|
(loop for row in rows do
|
|
(let* ((iri (db:row-url row))
|
|
(seen-count (to-s (db:row-seen-count row)))
|
|
(unseen-count (to-s (db:row-unseen-count row)))
|
|
(title (db:row-title row))
|
|
(subtitle (db:row-subtitle row))
|
|
(tree-row (make-instance 'gui:tree-item
|
|
:id iri
|
|
:text iri
|
|
:column-values (build-column-values unseen-count
|
|
seen-count
|
|
title
|
|
subtitle)
|
|
:index gui:+treeview-last-index+)))
|
|
(gui:treeview-insert-item tree :item tree-row)))
|
|
(gui:treeview-refit-columns-width (gui-goodies:tree gemlog-frame))
|
|
gemlog-frame))
|
|
|
|
(defun all-rows ()
|
|
(cev:enqueue-request-and-wait-results :gemini-gemlog-all-subscription
|
|
1
|
|
ev:+standard-event-priority+))
|
|
|
|
(defmethod initialize-instance :after ((object gemlog-frame) &key &allow-other-keys)
|
|
(with-accessors ((tree gui-goodies:tree)
|
|
(rows gui-goodies:rows)) object
|
|
(let ((new-rows (all-rows))
|
|
(treeview (make-instance 'gui:scrolled-treeview
|
|
:master object
|
|
:pack '(:side :top :expand t :fill :both)
|
|
:columns (list (_ "Unread")
|
|
(_ "Read")
|
|
(_ "Title")
|
|
(_ "Subtitle")))))
|
|
(setf tree treeview)
|
|
(gui:treeview-heading tree gui:+treeview-first-column-id+
|
|
:text (_ "Address"))
|
|
(resync-rows object new-rows)
|
|
object)))
|
|
|
|
(defun unsubscribe-gemlog-clsr (gemlog-frame)
|
|
(lambda ()
|
|
(a:when-let* ((selections (gui:treeview-get-selection (gui-goodies:tree gemlog-frame))))
|
|
(loop for selection in selections do
|
|
(let ((url (gui:id selection)))
|
|
(ev:with-enqueued-process-and-unblock ()
|
|
(comm:make-request :gemini-gemlog-unsubscribe 1 url))
|
|
(let ((new-rows (all-rows)))
|
|
(resync-rows gemlog-frame new-rows)))))))
|
|
|
|
(defun refresh-gemlogs-clsr (window gemlog-frame)
|
|
(lambda ()
|
|
(when (gui:children (gui-goodies:tree gemlog-frame) gui:+treeview-root+)
|
|
(ev:with-enqueued-process-and-unblock ()
|
|
(gui-goodies::with-notify-errors
|
|
(gui-goodies:with-busy* (window)
|
|
(comm:make-request :gemini-gemlog-refresh-all-subscriptions 1)
|
|
(client-main-window::print-info-message (_ "All gemlog refreshed")))))
|
|
(let ((new-rows (all-rows)))
|
|
(resync-rows gemlog-frame new-rows)))))
|
|
|
|
(defun open-gemlog-clsr (main-window treeview-gemlogs)
|
|
(lambda (e)
|
|
(declare (ignore e))
|
|
(a:when-let* ((selections (gui:treeview-get-selection (gui-goodies:tree treeview-gemlogs)))
|
|
(selection (first selections)))
|
|
(let* ((url (gui:id selection))
|
|
(fields (gui:column-values selection))
|
|
(title (column-title fields))
|
|
(subtitle (column-subtitle fields)))
|
|
(ev:with-enqueued-process-and-unblock ()
|
|
(let ((parsed-gemlog-entries (comm:make-request :gemini-gemlog-entries
|
|
1
|
|
url
|
|
title
|
|
subtitle)))
|
|
(client-main-window:clear-gemtext main-window)
|
|
(client-main-window::initialize-ir-lines main-window)
|
|
(client-main-window::collect-ir-lines url main-window parsed-gemlog-entries)
|
|
(client-main-window:set-address-bar-text main-window url)
|
|
(client-main-window::set-gemlog-toolbar-button-appearance main-window url)))))))
|
|
|
|
(defun init-window (master main-window)
|
|
(gui:with-toplevel (toplevel :master master :title (_ "Gemlogs"))
|
|
(let* ((table (make-instance 'gemlog-frame :master toplevel))
|
|
(buttons-frame (make-instance 'gui:frame :master toplevel))
|
|
(unsubscribe-button (make-instance 'gui:button
|
|
:master buttons-frame
|
|
:image icons:*document-delete*
|
|
:command (unsubscribe-gemlog-clsr table)))
|
|
(refresh-button (make-instance 'gui:button
|
|
:master buttons-frame
|
|
:image icons:*refresh*
|
|
:command (refresh-gemlogs-clsr toplevel
|
|
table))))
|
|
(gui-goodies:attach-tooltips (unsubscribe-button (_ "unsubscribe from selected gemlog"))
|
|
(refresh-button (_ "refresh all subscription")))
|
|
(gui:grid table 0 0 :sticky :nwe)
|
|
(gui:grid buttons-frame 1 0 :sticky :s)
|
|
(gui:grid unsubscribe-button 0 0 :sticky :s)
|
|
(gui:grid refresh-button 0 1 :sticky :s)
|
|
(gui:bind (gui:treeview (gui-goodies:tree table))
|
|
#$<<TreeviewSelect>>$
|
|
(open-gemlog-clsr main-window table)))
|
|
(gui:transient toplevel master)))
|