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:
parent
d5d7d65524
commit
8443f9ad3c
|
@ -103,7 +103,7 @@
|
||||||
(title (column-title fields))
|
(title (column-title fields))
|
||||||
(subtitle (column-subtitle fields)))
|
(subtitle (column-subtitle fields)))
|
||||||
(ev:with-enqueued-process-and-unblock ()
|
(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
|
1
|
||||||
url
|
url
|
||||||
title
|
title
|
||||||
|
@ -114,6 +114,51 @@
|
||||||
(client-main-window:set-address-bar-text main-window url)
|
(client-main-window:set-address-bar-text main-window url)
|
||||||
(client-main-window::set-gemlog-toolbar-button-appearance 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)
|
(defun init-window (master main-window)
|
||||||
(gui:with-toplevel (toplevel :master master :title (_ "Gemlogs"))
|
(gui:with-toplevel (toplevel :master master :title (_ "Gemlogs"))
|
||||||
(let* ((table (make-instance 'gemlog-frame :master toplevel))
|
(let* ((table (make-instance 'gemlog-frame :master toplevel))
|
||||||
|
@ -135,5 +180,8 @@
|
||||||
(gui:grid refresh-button 0 1 :sticky :s)
|
(gui:grid refresh-button 0 1 :sticky :s)
|
||||||
(gui:bind (gui:treeview (gui-goodies:tree table))
|
(gui:bind (gui:treeview (gui-goodies:tree table))
|
||||||
#$<<TreeviewSelect>>$
|
#$<<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)))
|
(gui:transient toplevel master)))
|
||||||
|
|
|
@ -40,13 +40,23 @@
|
||||||
(defun gemini-gemlog-unsubscribe (iri)
|
(defun gemini-gemlog-unsubscribe (iri)
|
||||||
(db:gemini-cancel-subscription 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))
|
(let* ((table (db:gemlog-entries iri))
|
||||||
(page (program-events::build-gemlog-page title
|
(page (program-events::build-gemlog-page title
|
||||||
subtitle
|
subtitle
|
||||||
table)))
|
table)))
|
||||||
(gemini-parse-string page)))
|
(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)
|
(defun gemini-gemlog-refresh-subscription (gemlog-url)
|
||||||
(list (cons "url" gemlog-url)
|
(list (cons "url" gemlog-url)
|
||||||
(cons "new-posts" (gemini-subscription:refresh-subscription-low-level gemlog-url))))
|
(cons "new-posts" (gemini-subscription:refresh-subscription-low-level gemlog-url))))
|
||||||
|
@ -71,3 +81,6 @@
|
||||||
(defun gemini-purge-gemlog-entries ()
|
(defun gemini-purge-gemlog-entries ()
|
||||||
(db:purge-seen-gemlog-entries)
|
(db:purge-seen-gemlog-entries)
|
||||||
t)
|
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"
|
(gen-rpc "gemini-gemlog-refresh-all-subscriptions"
|
||||||
'gemini-gemlog-refresh-all-subscriptions)
|
'gemini-gemlog-refresh-all-subscriptions)
|
||||||
(gen-rpc "gemini-gemlog-unsubscribe" 'gemini-gemlog-unsubscribe "iri" 0)
|
(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
|
"iri" 0
|
||||||
"title" 1
|
"title" 1
|
||||||
"subtitle" 2)
|
"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-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
|
(gen-rpc "titan-save-token" 'titan-save-token
|
||||||
"url" 0
|
"url" 0
|
||||||
"token" 1)
|
"token" 1)
|
||||||
|
|
Loading…
Reference in New Issue