mirror of https://codeberg.org/cage/tinmop/
91 lines
4.1 KiB
Common Lisp
91 lines
4.1 KiB
Common Lisp
(in-package :client-tour-window)
|
|
|
|
(named-readtables:in-readtable nodgui.syntax:nodgui-syntax)
|
|
|
|
(defclass tour-frame (gui-goodies:table-frame) ())
|
|
|
|
(defun resync-rows (tour-frame new-rows)
|
|
(with-accessors ((tree gui-goodies:tree)
|
|
(rows gui-goodies:rows)) tour-frame
|
|
(gui:treeview-delete-all tree)
|
|
(setf rows new-rows)
|
|
(loop for row in rows do
|
|
(let* ((tree-row (make-instance 'gui:tree-item
|
|
:id (getf row :target)
|
|
:text (getf row :target)
|
|
:column-values (list (getf row :name))
|
|
:index gui:+treeview-last-index+)))
|
|
(gui:treeview-insert-item tree :item tree-row))))
|
|
(gui:treeview-refit-columns-width (gui-goodies:tree tour-frame))
|
|
tour-frame)
|
|
|
|
(defun all-rows ()
|
|
(cev:enqueue-request-and-wait-results :tour-all-links
|
|
1
|
|
ev:+standard-event-priority+))
|
|
|
|
(defmethod initialize-instance :after ((object tour-frame) &key &allow-other-keys)
|
|
(with-accessors ((tree gui-goodies:tree)
|
|
(rows gui-goodies:rows)) object
|
|
(let ((new-rows (all-rows))
|
|
(treeview (make-instance 'gui:scrolled-treeview
|
|
:master object
|
|
:pack '(:side :top :expand t :fill :both)
|
|
:columns (list (_ "Description"))
|
|
:columns-min-width
|
|
(make-list 2
|
|
:initial-element
|
|
(/ (gui-goodies:quite-good-dialog-width nil)
|
|
2)))))
|
|
(setf tree treeview)
|
|
(gui:treeview-heading tree gui:+treeview-first-column-id+ :text (_ "Address"))
|
|
(resync-rows object new-rows)
|
|
object)))
|
|
|
|
(defun delete-tour-clsr (tour-frame)
|
|
(lambda ()
|
|
(a:when-let* ((selections (gui:treeview-get-selection (gui-goodies:tree tour-frame))))
|
|
(loop for selection in selections do
|
|
(let ((url (gui:id selection)))
|
|
(ev:with-enqueued-process-and-unblock ()
|
|
(comm:make-request :tour-delete-link
|
|
1
|
|
url))
|
|
(let ((new-rows (all-rows)))
|
|
(resync-rows tour-frame new-rows)))))))
|
|
|
|
(defun enqueue-shuffle-tour ()
|
|
(ev:with-enqueued-process-and-unblock ()
|
|
(comm:make-request :tour-shuffle 1)))
|
|
|
|
(defun shuffle-tour-clsr (tour-frame)
|
|
(lambda ()
|
|
(enqueue-shuffle-tour)
|
|
(let ((new-rows (all-rows)))
|
|
(resync-rows tour-frame new-rows))))
|
|
|
|
(defun init-window (master)
|
|
(gui:with-toplevel (toplevel :master master :title (_ "Tour"))
|
|
(gui:transient toplevel master)
|
|
(let* ((table (make-instance 'tour-frame :master toplevel))
|
|
(buttons-frame (make-instance 'gui:frame :master toplevel))
|
|
(delete-button (make-instance 'gui:button
|
|
:master buttons-frame
|
|
:image icons:*document-delete*
|
|
:command (delete-tour-clsr table)))
|
|
(shuffle-button (make-instance 'gui:button
|
|
:master buttons-frame
|
|
:image icons:*dice*
|
|
:command (shuffle-tour-clsr table))))
|
|
(gui-goodies:attach-tooltips (delete-button (_ "delete selected links"))
|
|
(shuffle-button (_ "shuffle links")))
|
|
(gui:set-geometry-wh toplevel
|
|
(truncate (/ (gui:screen-width) 2))
|
|
(truncate (/ (gui:screen-height) 2)))
|
|
(gui:place table 0 0
|
|
:width (truncate (/ (gui:screen-width) 2))
|
|
:height (truncate (* 3/8 (gui:screen-height))))
|
|
(gui:place buttons-frame 0 (truncate (* 4/10 (gui:screen-height))))
|
|
(gui:grid delete-button 0 0 :sticky :s)
|
|
(gui:grid shuffle-button 0 1 :sticky :s))))
|