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

- [GUI] ensured deadline conditions is respected by gemlog subscribing procedures.

This commit is contained in:
cage 2024-09-04 17:47:16 +02:00
parent 4947289eab
commit 165bb30688
4 changed files with 29 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -110,22 +110,28 @@
(let ((new-rows (all-rows))) (let ((new-rows (all-rows)))
(resync-rows gemlog-frame new-rows))))) (resync-rows gemlog-frame new-rows)))))
(defun subscribe-gemlog-or-notify-error (iri)
(handler-case
(progn
(comm:make-request :gemini-gemlog-subscribe 1 iri)
t)
(error (e)
(gui-goodies:notify-request-error e)
nil)))
(defun subscribe-gemlog-clsr (gemlog-frame) (defun subscribe-gemlog-clsr (gemlog-frame)
(lambda () (lambda ()
(handler-case (let* ((iri (trim-blanks (gui-mw:text-input-dialog gemlog-frame
(let* ((iri (trim-blanks (gui-mw:text-input-dialog gemlog-frame (_ "Info request")
(_ "Info request") (_ "Please, type the gemlog's address")
(_ "Please, type the gemlog's address") :text "gemini://")))
:text "gemini://"))) (subscription-ok (subscribe-gemlog-or-notify-error iri)))
(subscription-ok (comm:make-request :gemini-gemlog-subscribe 1 iri))) (if subscription-ok
(if subscription-ok (let ((new-rows (all-rows)))
(let ((new-rows (all-rows))) (resync-rows gemlog-frame new-rows))
(resync-rows gemlog-frame new-rows)) (gui-goodies:notify-request-error (format nil
(gui-goodies:notify-request-error (format nil (_ "Unable to subscribe to ~s")
(_ "Unable to subscribe to ~s") iri))))))
iri))))
(error (e)
(gui-goodies:notify-request-error e)))))
(defun open-gemlog-clsr (main-window treeview-gemlogs) (defun open-gemlog-clsr (main-window treeview-gemlogs)
(lambda (e) (lambda (e)

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

@ -676,10 +676,8 @@ local file paths."
(slurp-iri main-window link-value))))) (slurp-iri main-window link-value)))))
(fs:copy-a-file input-file output-file :overwrite t))) (fs:copy-a-file input-file output-file :overwrite t)))
(subscribe-as-gemlog () (subscribe-as-gemlog ()
(let ((subscription-ok (comm:make-request :gemini-gemlog-subscribe (let ((subscribed (client-gemlog-window:subscribe-gemlog-or-notify-error link-value)))
1 (if subscribed
link-value)))
(if subscription-ok
(gui-goodies:info-operation-completed main-window) (gui-goodies:info-operation-completed main-window)
(gui-goodies:notify-request-error (format nil (gui-goodies:notify-request-error (format nil
(_ "Unable to subscribe to ~s") (_ "Unable to subscribe to ~s")
@ -1495,8 +1493,8 @@ local file paths."
(progn (progn
(comm:make-request :gemini-gemlog-unsubscribe 1 iri) (comm:make-request :gemini-gemlog-unsubscribe 1 iri)
(set-subscribe-button-unsubscribed main-window)) (set-subscribe-button-unsubscribed main-window))
(let ((subscription-ok (comm:make-request :gemini-gemlog-subscribe 1 iri))) (let ((subscribed (client-gemlog-window:subscribe-gemlog-or-notify-error iri)))
(if subscription-ok (if subscribed
(set-subscribe-button-subscribed main-window) (set-subscribe-button-subscribed main-window)
(gui-goodies:notify-request-error (format nil (gui-goodies:notify-request-error (format nil
(_ "Unable to subscribe to ~s") (_ "Unable to subscribe to ~s")

5
src/json-rpc2.lisp
View File

@ -416,7 +416,7 @@
(defun maybe-log-message (m) (defun maybe-log-message (m)
(declare (ignorable m)) (declare (ignorable m))
#+debug-json-rpc #+debug-json-rpc
(misc:dbg m)) (misc:dbg "~a" m))
(defun elaborate-single-request (request) (defun elaborate-single-request (request)
(flet ((make-rpc-error (e id &optional (data nil)) (flet ((make-rpc-error (e id &optional (data nil))
@ -457,6 +457,9 @@
(make-response elaborated id :error-object nil))) (make-response elaborated id :error-object nil)))
(json-rpc-error (e) (json-rpc-error (e)
(make-rpc-error e id request)) (make-rpc-error e id request))
(condition (c)
(maybe-log-message (format nil "jsonrpc request signalled a condition: ~a" c))
(make-failed-function-error c id request))
(error (e) (error (e)
(maybe-log-message (format nil "jsonrpc request failed: ~a" e)) (maybe-log-message (format nil "jsonrpc request failed: ~a" e))
(make-failed-function-error e id request)))) (make-failed-function-error e id request))))

1
src/package.lisp
View File

@ -3728,6 +3728,7 @@
(:gui-shapes :nodgui.shapes) (:gui-shapes :nodgui.shapes)
(:menu :client-menu-command)) (:menu :client-menu-command))
(:export (:export
:subscribe-gemlog-or-notify-error
:init-window)) :init-window))
(defpackage :client-search-frame (defpackage :client-search-frame