diff --git a/data/icons/fmw_page-accept.png b/data/icons/fmw_page-accept.png new file mode 100644 index 0000000..2b39c63 Binary files /dev/null and b/data/icons/fmw_page-accept.png differ diff --git a/data/icons/fmw_page.png b/data/icons/fmw_page.png new file mode 100644 index 0000000..464caf2 Binary files /dev/null and b/data/icons/fmw_page.png differ diff --git a/src/gui/client/certificates-window.lisp b/src/gui/client/certificates-window.lisp index dd8e94b..0f51488 100644 --- a/src/gui/client/certificates-window.lisp +++ b/src/gui/client/certificates-window.lisp @@ -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 () diff --git a/src/gui/client/gui-goodies.lisp b/src/gui/client/gui-goodies.lisp index 46acaa5..aabb40c 100644 --- a/src/gui/client/gui-goodies.lisp +++ b/src/gui/client/gui-goodies.lisp @@ -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))) diff --git a/src/gui/client/json-rpc-communication.lisp b/src/gui/client/json-rpc-communication.lisp index 58299c5..e9f17b4 100644 --- a/src/gui/client/json-rpc-communication.lisp +++ b/src/gui/client/json-rpc-communication.lisp @@ -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+)) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index bfd70a9..9e02c03 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -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)))) diff --git a/src/gui/client/menu-command.lisp b/src/gui/client/menu-command.lisp index 3f315bb..f3ca46c 100644 --- a/src/gui/client/menu-command.lisp +++ b/src/gui/client/menu-command.lisp @@ -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))) diff --git a/src/gui/client/stream-window.lisp b/src/gui/client/stream-window.lisp new file mode 100644 index 0000000..e83ee71 --- /dev/null +++ b/src/gui/client/stream-window.lisp @@ -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)))) diff --git a/src/gui/server/public-api-gemini-stream.lisp b/src/gui/server/public-api-gemini-stream.lisp index 41132a1..77d2748 100644 --- a/src/gui/server/public-api-gemini-stream.lisp +++ b/src/gui/server/public-api-gemini-stream.lisp @@ -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*) diff --git a/src/gui/server/public-api.lisp b/src/gui/server/public-api.lisp index 1cd5675..9e03f0a 100644 --- a/src/gui/server/public-api.lisp +++ b/src/gui/server/public-api.lisp @@ -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) diff --git a/src/package.lisp b/src/package.lisp index 175107b..872d868 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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)) diff --git a/tinmop.asd b/tinmop.asd index 1b18b47..d054bd4 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -166,6 +166,7 @@ (:file "validation") (:file "icons") (:file "certificates-window") + (:file "stream-window") (:file "menu-command") (:file "main-window"))) (:file "main")