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