mirror of https://codeberg.org/cage/tinmop/
- [GUI] added contextual menu to copy gemlogs links or mark all their
posts as already read.
This commit is contained in:
cage
parent
d5d7d65524
commit
8443f9ad3c
|
|
@ -103,7 +103,7 @@
|
|||
(title (column-title fields))
|
||||
(subtitle (column-subtitle fields)))
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(let ((parsed-gemlog-entries (comm:make-request :gemini-gemlog-entries
|
||||
(let ((parsed-gemlog-entries (comm:make-request :gemini-gemlog-entries-page
|
||||
1
|
||||
url
|
||||
title
|
||||
|
|
@ -114,6 +114,51 @@
|
|||
(client-main-window:set-address-bar-text main-window url)
|
||||
(client-main-window::set-gemlog-toolbar-button-appearance main-window url)))))))
|
||||
|
||||
(defun all-gemlog-posts (gemlog-url)
|
||||
(cev:enqueue-request-and-wait-results :gemini-gemlog-entries
|
||||
1
|
||||
ev:+standard-event-priority+
|
||||
gemlog-url))
|
||||
|
||||
(defun contextual-menu-clrs (treeview-widget)
|
||||
(labels ((copy-uri ()
|
||||
(a:when-let* ((selections (gui:treeview-get-selection treeview-widget))
|
||||
(links (with-output-to-string (stream)
|
||||
(if (= (length selections) 1)
|
||||
(format stream
|
||||
"~a"
|
||||
(gui:id (first selections)))
|
||||
(format stream
|
||||
"~{~a~^~%~}"
|
||||
(mapcar #'gui:id selections))))))
|
||||
(os-utils:copy-to-clipboard links)
|
||||
(client-main-window:print-info-message (n_ "Link copied"
|
||||
"Links copied"
|
||||
(length selections)))))
|
||||
(mark-all-read ()
|
||||
(a:when-let* ((selections (gui:treeview-get-selection treeview-widget)))
|
||||
(loop for selection in selections do
|
||||
(let ((url (gui:id selection)))
|
||||
(mapcar (lambda (post)
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(let ((post-url (db:row-post-link post)))
|
||||
(gui-goodies:with-busy* ((gui:root-toplevel))
|
||||
(comm:make-request :gemini-mark-gemlog-post-read
|
||||
1
|
||||
post-url)))))
|
||||
(all-gemlog-posts url)))))))
|
||||
|
||||
(lambda (z)
|
||||
(declare (ignore z))
|
||||
(let* ((popup-menu (gui:make-menu nil (_"gemlog menu")))
|
||||
(x (gui:screen-mouse-x))
|
||||
(y (gui:screen-mouse-y)))
|
||||
(gui:make-menubutton popup-menu (_ "Mark all posts of selected gemlogs as read") #'mark-all-read)
|
||||
(gui:make-menubutton popup-menu
|
||||
(_ "Copy selected gemlog links to the clipboard")
|
||||
#'copy-uri)
|
||||
(gui:popup popup-menu x y)))))
|
||||
|
||||
(defun init-window (master main-window)
|
||||
(gui:with-toplevel (toplevel :master master :title (_ "Gemlogs"))
|
||||
(let* ((table (make-instance 'gemlog-frame :master toplevel))
|
||||
|
|
@ -135,5 +180,8 @@
|
|||
(gui:grid refresh-button 0 1 :sticky :s)
|
||||
(gui:bind (gui:treeview (gui-goodies:tree table))
|
||||
#$<<TreeviewSelect>>$
|
||||
(open-gemlog-clsr main-window table)))
|
||||
(open-gemlog-clsr main-window table))
|
||||
(gui:bind (gui:treeview (gui-goodies:tree table))
|
||||
#$<3>$
|
||||
(contextual-menu-clrs (gui:treeview (gui-goodies:tree table)))))
|
||||
(gui:transient toplevel master)))
|
||||
|
|
|
|||
|
|
@ -40,13 +40,23 @@
|
|||
(defun gemini-gemlog-unsubscribe (iri)
|
||||
(db:gemini-cancel-subscription iri))
|
||||
|
||||
(defun gemini-gemlog-entries (iri title subtitle)
|
||||
(defun gemini-gemlog-entries-page (iri title subtitle)
|
||||
(let* ((table (db:gemlog-entries iri))
|
||||
(page (program-events::build-gemlog-page title
|
||||
subtitle
|
||||
table)))
|
||||
(gemini-parse-string page)))
|
||||
|
||||
(defclass gemini-gemlog-entries (box) ())
|
||||
|
||||
(defmethod yason:encode ((object gemini-gemlog-entries) &optional (stream *standard-output*))
|
||||
(encode-flat-array-of-plists (unbox object) stream))
|
||||
|
||||
(defun gemini-gemlog-entries (iri)
|
||||
(let ((table (db:gemlog-entries iri)))
|
||||
(make-instance 'gemini-gemlog-entries
|
||||
:contents table)))
|
||||
|
||||
(defun gemini-gemlog-refresh-subscription (gemlog-url)
|
||||
(list (cons "url" gemlog-url)
|
||||
(cons "new-posts" (gemini-subscription:refresh-subscription-low-level gemlog-url))))
|
||||
|
|
@ -71,3 +81,6 @@
|
|||
(defun gemini-purge-gemlog-entries ()
|
||||
(db:purge-seen-gemlog-entries)
|
||||
t)
|
||||
|
||||
(defun gemini-mark-gemlog-post-read (iri)
|
||||
(db:gemlog-mark-as-seen iri))
|
||||
|
|
|
|||
|
|
@ -126,11 +126,15 @@
|
|||
(gen-rpc "gemini-gemlog-refresh-all-subscriptions"
|
||||
'gemini-gemlog-refresh-all-subscriptions)
|
||||
(gen-rpc "gemini-gemlog-unsubscribe" 'gemini-gemlog-unsubscribe "iri" 0)
|
||||
(gen-rpc "gemini-gemlog-entries" 'gemini-gemlog-entries
|
||||
(gen-rpc "gemini-gemlog-entries-page" 'gemini-gemlog-entries-page
|
||||
"iri" 0
|
||||
"title" 1
|
||||
"subtitle" 2)
|
||||
(gen-rpc "gemini-gemlog-entries"'gemini-gemlog-entries
|
||||
"iri" 0)
|
||||
(gen-rpc "gemini-purge-gemlog-entries" 'gemini-purge-gemlog-entries)
|
||||
(gen-rpc "gemini-mark-gemlog-post-read" 'gemini-mark-gemlog-post-read
|
||||
"iri" 0)
|
||||
(gen-rpc "titan-save-token" 'titan-save-token
|
||||
"url" 0
|
||||
"token" 1)
|
||||
|
|
|
|||
Loading…
Reference in New Issue