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

- [GUI] added stream window (list the streams and delete them).

This commit is contained in:
cage 2023-03-29 18:13:46 +02:00
parent 6a771507c5
commit d7f36cc33d
12 changed files with 145 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
data/icons/fmw_page-accept.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 5.3 KiB

BIN
data/icons/fmw_page.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 738 B

23
src/gui/client/certificates-window.lisp
View File

@ -2,19 +2,11 @@
(named-readtables:in-readtable nodgui.syntax:nodgui-syntax)
(defclass certificate-frame (gui:frame)
((tree
:accessor tree
:initform nil
:initarg :tree)
(rows
:accessor rows
:initform '()
:initarg :rows)))
(defclass certificate-frame (gui-goodies:table-frame) ())
(defun resync-rows (certificate-frame new-rows)
(with-accessors ((tree tree)
(rows rows)) certificate-frame
(with-accessors ((tree gui-goodies:tree)
(rows gui-goodies:rows)) certificate-frame
(gui:treeview-delete-all tree)
(setf rows new-rows)
(loop for row in rows do
@ -25,6 +17,7 @@
(getf row :hash))
:index gui:+treeview-last-index+)))
(gui:treeview-insert-item tree :item tree-row))))
(gui:treeview-refit-columns-width (gui-goodies:tree certificate-frame))
certificate-frame)
(defun all-rows ()
@ -32,9 +25,9 @@
1
ev:+standard-event-priority+))
(defmethod initialize-instance :after ((object certificate-frame) &key)
(with-accessors ((tree tree)
(rows rows)) object
(defmethod initialize-instance :after ((object certificate-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
@ -49,7 +42,7 @@
(defun delete-certificates-clsr (certificate-frame)
(lambda ()
(a:when-let* ((selections (gui:treeview-get-selection (tree certificate-frame))))
(a:when-let* ((selections (gui:treeview-get-selection (gui-goodies:tree certificate-frame))))
(loop for selection in selections do
(let ((url (gui:id selection)))
(ev:with-enqueued-process-and-unblock ()

10
src/gui/client/gui-goodies.lisp
View File

@ -117,3 +117,13 @@
(gui:grid widget 1 0 :sticky :news)
(gui:grid ok-button 1 1 :sticky :news)))
res))
(defclass table-frame (gui:frame)
((tree
:accessor tree
:initform nil
:initarg :tree)
(rows
:accessor rows
:initform '()
:initarg :rows)))

2
src/gui/client/json-rpc-communication.lisp
View File

@ -95,7 +95,7 @@
(defun start-client ()
(with-output-to-string (stream)
(let ((process (os-utils:run-external-program "/home/cage/lisp/tinmop/tinmop" ;+program-name+
(let ((process (os-utils:run-external-program +program-name+
(list (format nil
"-~a"
command-line:+start-server-command-line+))

1
src/gui/client/main-window.lisp
View File

@ -198,6 +198,7 @@
(tools (gui:make-menu bar (_ "Tools") :underline 0))
(help (gui:make-menu bar (_ "Help") :underline 0)))
(gui:make-menubutton tools (_ "Certificates") #'menu:show-certificates :underline 0)
(gui:make-menubutton tools (_ "Streams") #'menu:show-streams :underline 0)
(gui:make-menubutton file (_ "Quit") #'menu:quit :underline 0)
(gui:make-menubutton help (_ "About") #'menu:help-about :underline 0))))

4
src/gui/client/menu-command.lisp
View File

@ -20,3 +20,7 @@
(defun show-certificates ()
(let ((master gui-goodies:*toplevel*))
(client-certificates-window:init-window master)))
(defun show-streams ()
(let ((master gui-goodies:*toplevel*))
(client-stream-window:init-window master)))

75
src/gui/client/stream-window.lisp Normal file
View File

@ -0,0 +1,75 @@
(in-package :client-stream-window)
(named-readtables:in-readtable nodgui.syntax:nodgui-syntax)
(defclass stream-frame (gui-goodies:table-frame) ())
(defun resync-rows (stream-frame new-rows)
(with-accessors ((tree gui-goodies:tree)
(rows gui-goodies:rows)) stream-frame
(gui:treeview-delete-all tree)
(setf rows new-rows)
(loop for row in rows do
(let* ((iri (getf row :download-iri))
(stream-client-wrapper (client-main-window:find-db-stream-url iri))
(stream-status (to-s (client-main-window::status stream-client-wrapper)))
(tree-row (make-instance 'gui:tree-item
:id iri
:text iri
:column-values
(list stream-status
(to-s (getf row :octet-count)))
:index gui:+treeview-last-index+)))
(gui:treeview-insert-item tree :item tree-row)))
(gui:treeview-refit-columns-width (gui-goodies:tree stream-frame))
stream-frame))
(defun all-rows ()
(cev:enqueue-request-and-wait-results :gemini-all-stream-info
1
ev:+standard-event-priority+))
(defmethod initialize-instance :after ((object stream-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 (_ "Status")
(_ "Number of octets downloaded")))))
(setf tree treeview)
(gui:treeview-heading tree gui:+treeview-first-column-id+
:text (_ "Address"))
(resync-rows object new-rows)
object)))
(defun delete-stream-clsr (stream-frame)
(lambda ()
(a:when-let* ((selections (gui:treeview-get-selection (gui-goodies:tree stream-frame))))
(loop for selection in selections do
(let* ((url (gui:id selection))
(stream-client-wrapper (client-main-window::find-db-stream-url url)))
(when (eq (client-main-window:status stream-client-wrapper)
client-main-window:+stream-status-streaming+)
(ev:with-enqueued-process-and-unblock ()
(client-main-window:stop-steaming-stream-thread)))
(ev:with-enqueued-process-and-unblock ()
(client-main-window:remove-db-stream stream-client-wrapper)
(comm:make-request :gemini-remove-stream 1 url))
(let ((new-rows (all-rows)))
(resync-rows stream-frame new-rows)))))))
(defun init-window (master)
(gui:with-modal-toplevel (toplevel :master master :title (_ "Streams"))
(gui:transient toplevel master)
(let* ((table (make-instance 'stream-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-stream-clsr table))))
(gui-goodies:attach-tooltips (delete-button (_ "delete selected stream")))
(gui:grid table 0 0 :sticky :nwe)
(gui:grid buttons-frame 1 0 :sticky :s)
(gui:grid delete-button 0 0 :sticky :s))))

8
src/gui/server/public-api-gemini-stream.lisp
View File

@ -312,7 +312,7 @@
(cons "download-iri" download-iri)
(cons "start-time" actual-start-time)
(cons "support-file" support-file)
(cons "octect-count" octect-count)
(cons "octet-count" octect-count)
(cons "port" port)
(cons "status-code" status-code)
(cons "status-code-description" status-code-description)
@ -397,6 +397,12 @@
stream-wrapper
(make-no-such-stream-error iri))))
(defun gemini-remove-stream (iri)
(let ((stream-wrapper (gw:find-db-stream-url iri)))
(if stream-wrapper
(gw:remove-db-stream stream-wrapper)
(make-no-such-stream-error iri))))
(defun gemini-all-stream-info ()
gw:*gemini-streams-db*)

3
src/gui/server/public-api.lisp
View File

@ -60,6 +60,9 @@
(gen-rpc "gemini-stream-status"
'gemini-stream-status
"iri" 0)
(gen-rpc "gemini-remove-stream"
'gemini-remove-stream
"iri" 0)
(gen-rpc "gemini-stream-completed-p"
'gemini-stream-completed-p
"iri" 0)

37
src/package.lisp
View File

@ -3368,7 +3368,10 @@
:attach-tooltip
:attach-tooltips
:with-busy*
:password-dialog))
:password-dialog
:table-frame
:tree
:rows))
(defpackage :client-menu-command
(:use
@ -3389,7 +3392,8 @@
(:export
:help-about
:quit
:show-certificates))
:show-certificates
:show-streams))
(defpackage :client-certificates-window
(:use
@ -3407,6 +3411,29 @@
(:gui-mw :nodgui.mw)
(:gui-shapes :nodgui.shapes)
(:menu :client-menu-command))
(:export
:certificate-frame
:tree
:rows
:init-window))
(defpackage :client-stream-window
(:use
:cl
:config
:constants
:text-utils
:misc-utils)
(:local-nicknames (:cert-win :client-certificates-window)
(:comm :json-rpc-communication)
(:re :cl-ppcre)
(:a :alexandria)
(:ev :program-events)
(:cev :client-events)
(:gui :nodgui)
(:gui-mw :nodgui.mw)
(:gui-shapes :nodgui.shapes)
(:menu :client-menu-command))
(:export
:init-window))
@ -3427,6 +3454,12 @@
(:gui-shapes :nodgui.shapes)
(:menu :client-menu-command))
(:export
:status
:+stream-status-streaming+
:stop-stream-thread
:stop-steaming-stream-thread
:remove-db-stream
:find-db-stream-url
:open-local-path
:init-main-window))

1
tinmop.asd
View File

@ -166,6 +166,7 @@
(:file "validation")
(:file "icons")
(:file "certificates-window")
(:file "stream-window")
(:file "menu-command")
(:file "main-window")))
(:file "main")