cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- [GUI] added index column to gemlog window.

This commit is contained in:
cage 2024-08-04 09:58:20 +02:00
parent 02a0225773
commit c4da2c78b3
1 changed files with 47 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
src/gui/client/gemlog-window.lisp
View File

@ -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,29 +21,40 @@
`(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
(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))) (seen-count (to-s (db:row-seen-count row)))
(unseen-count (to-s (db:row-unseen-count row))) (unseen-count (to-s (db:row-unseen-count row)))
(title (db:row-title row)) (title (db:row-title row))
(subtitle (db:row-subtitle row)) (subtitle (db:row-subtitle row))
(tree-row (make-instance 'gui:tree-item (tree-row (make-instance 'gui:tree-item
:id iri :id index
:text iri :text index
:column-values (build-column-values unseen-count :column-values (build-column-values url
unseen-count
seen-count seen-count
title title
subtitle) subtitle)
@ -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)))))