mirror of https://codeberg.org/cage/tinmop/
- [GUI] added index column to gemlog window.
This commit is contained in:
cage
parent
02a0225773
commit
c4da2c78b3
|
|
@ -4,11 +4,13 @@
|
|||
|
||||
(defclass gemlog-frame (gui-goodies:table-frame) ())
|
||||
|
||||
(defun build-column-values (unseen-count
|
||||
(defun build-column-values (url
|
||||
unseen-count
|
||||
seen-count
|
||||
title
|
||||
subtitle)
|
||||
(list unseen-count
|
||||
(list url
|
||||
unseen-count
|
||||
seen-count
|
||||
title
|
||||
subtitle))
|
||||
|
|
@ -19,29 +21,40 @@
|
|||
`(defun ,(format-fn-symbol t "column-~a" name) (fields)
|
||||
(elt fields ,index)))
|
||||
|
||||
(build-column-value-accessor unseen-count 0)
|
||||
(build-column-value-accessor url 0)
|
||||
|
||||
(build-column-value-accessor seen-count 1)
|
||||
(build-column-value-accessor unseen-count 1)
|
||||
|
||||
(build-column-value-accessor title 2)
|
||||
(build-column-value-accessor seen-count 2)
|
||||
|
||||
(build-column-value-accessor subtitle 3)
|
||||
(build-column-value-accessor title 3)
|
||||
|
||||
(build-column-value-accessor subtitle 4)
|
||||
|
||||
(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))
|
||||
(loop for row in rows
|
||||
for index-count from 0 do
|
||||
(let* ((index (cond
|
||||
((< index-count 9)
|
||||
(format nil "~a" index-count))
|
||||
((< 10 index-count 116)
|
||||
(string (code-char (+ 85 index-count))))
|
||||
(t
|
||||
(format nil "~a" index-count))))
|
||||
(url (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
|
||||
:id index
|
||||
:text index
|
||||
:column-values (build-column-values url
|
||||
unseen-count
|
||||
seen-count
|
||||
title
|
||||
subtitle)
|
||||
|
|
@ -62,21 +75,25 @@
|
|||
(treeview (make-instance 'gui:scrolled-treeview
|
||||
:master object
|
||||
:pack '(:side :top :expand t :fill :both)
|
||||
:columns (list (_ "Unread")
|
||||
:columns (list (_ "Address")
|
||||
(_ "Unread")
|
||||
(_ "Read")
|
||||
(_ "Title")
|
||||
(_ "Subtitle")))))
|
||||
(setf tree treeview)
|
||||
(gui:treeview-heading tree gui:+treeview-first-column-id+
|
||||
:text (_ "Address"))
|
||||
:text (_ "Index"))
|
||||
(resync-rows object new-rows)
|
||||
object)))
|
||||
|
||||
(defun url-column-value (row)
|
||||
(column-url (gui:column-values row)))
|
||||
|
||||
(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)))
|
||||
(let ((url (url-column-value selection)))
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(comm:make-request :gemini-gemlog-unsubscribe 1 url))
|
||||
(let ((new-rows (all-rows)))
|
||||
|
|
@ -98,7 +115,7 @@
|
|||
(declare (ignore e))
|
||||
(a:when-let* ((selections (gui:treeview-get-selection (gui-goodies:tree treeview-gemlogs)))
|
||||
(selection (first selections)))
|
||||
(let* ((url (gui:id selection))
|
||||
(let* ((url (url-column-value selection))
|
||||
(fields (gui:column-values selection))
|
||||
(title (column-title fields))
|
||||
(subtitle (column-subtitle fields)))
|
||||
|
|
@ -127,10 +144,10 @@
|
|||
(if (= (length selections) 1)
|
||||
(format stream
|
||||
"~a"
|
||||
(gui:id (first selections)))
|
||||
(url-column-value (first selections)))
|
||||
(format stream
|
||||
"~{~a~^~%~}"
|
||||
(mapcar #'gui:id selections))))))
|
||||
(mapcar #'url-column-value selections))))))
|
||||
(os-utils:copy-to-clipboard links)
|
||||
(client-main-window:print-info-message (n_ "Link copied"
|
||||
"Links copied"
|
||||
|
|
@ -138,7 +155,7 @@
|
|||
(mark-all-read ()
|
||||
(a:when-let* ((selections (gui:treeview-get-selection treeview-widget)))
|
||||
(loop for selection in selections do
|
||||
(let ((url (gui:id selection)))
|
||||
(let ((url (url-column-value selection)))
|
||||
(mapcar (lambda (post)
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(let ((post-url (db:row-post-link post)))
|
||||
|
|
@ -201,7 +218,7 @@
|
|||
(pressed-char-code (gui:event-char-code e)))
|
||||
(when (cl-ppcre:scan "(?i)^[a-z0-9]$" pressed-char)
|
||||
(if (ignore-errors (parse-integer pressed-char))
|
||||
(let ((index (clamp-index items (parse-integer (gui:event-char e)))))
|
||||
(let ((index (clamp-index items (parse-integer pressed-char))))
|
||||
(gui:treeview-set-selection treeview index))
|
||||
(let ((index (clamp-index items (+ 10 (- pressed-char-code
|
||||
97)))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue