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

- [gemini] improved format control for protocol error messages; 

- [GUI] logged RPC request error instead of opening a dialog message when in debug mode;
- [GUI] added a draft of callback for opening a gemini address.

- [RPC] learnt that (error "string" arg1 arg2 ... argn), is similar to
  (error (format nil  "string" arg1 arg2 ... argn))  so (error (format
  nil "~a" "~c"))  is equal to (error "~c"); =>  format error (missing
  argument for format string)!
This commit is contained in:
cage 2023-02-19 14:52:53 +01:00
parent 377f42fa5c
commit d040aec005
5 changed files with 36 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/gemini/client.lisp
View File

@ -169,7 +169,7 @@
:reader error-description))
(:report (lambda (condition stream)
(format stream
(_ "The server responded with the error ~a: ~a")
(_ "The server responded with the error ~a: ~s")
(error-code condition)
(error-description condition))))
(:documentation "The condition signalled for error codes (i.e. 4x and 5x)"))

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

@ -63,8 +63,9 @@
(find-db-stream-if (lambda (a) (string= (server-stream-handle a) url))))
(defun notify-request-error (e)
(gui-goodies:error-dialog gui:*tk*
(format nil (_ "Comunication with backend failed: ~a") e)))
(let ((message (format nil (_ "Comunication with backend failed: ~a") e)))
#+debug-mode (misc:dbg "request error ~a" message)
#-debug-mode (gui-goodies:error-dialog gui:*tk* message)))
(defmacro with-notify-errors (&body body)
`(handler-case
@ -76,10 +77,11 @@
(use-cache t)
(process-function #'identity)
(aborting-function (constantly nil)))
(with-enqueue-request (:gemini-request 1 iri use-cache)
(cev:with-enqueue-request (:gemini-request 1 the-error iri use-cache)
(notify-request-error the-error))
(labels ((stream-exausted-p ()
(let ((status-completed (with-enqueue-request (:gemini-stream-completed-p 1 iri)
(let ((status-completed (cev:with-enqueue-request
(:gemini-stream-completed-p 1 the-error iri)
(notify-request-error the-error))))
status-completed))
(loop-fetch (&optional (last-lines-fetched-count 0))
@ -154,14 +156,23 @@
(lambda (hint)
(if (> (length hint) 2)
(with-notify-errors
(let ((match-results (enqueue-request-and-wait-results :complete-net-address
1
ev:+maximum-event-priority+
hint)))
(let ((match-results (cev:enqueue-request-and-wait-results :complete-net-address
1
ev:+maximum-event-priority+
hint)))
(values (getf match-results :matches)
(getf match-results :indices))))
hint)))
(defun start-stream-iri-clsr (widget use-cache)
(lambda ()
(with-accessors ((iri-entry iri-entry)) widget
(let ((iri (gui:text iri-entry)))
(slurp-gemini-stream iri
:use-cache use-cache
:process-function (lambda (lines)
(misc:dbg "lines ~a" lines)))))))
(defun setup-main-window-events (main-window)
(with-accessors ((iri-entry iri-entry)
(back-button back-button)
@ -173,8 +184,9 @@
#$<KeyPress-Return>$
(lambda (e)
(declare (ignore e))
(gui-goodies:info-dialog main-window (gui:text iri-entry)))
:append nil))))
(funcall (start-stream-iri-clsr main-window t)))
:append nil))
(setf (gui:command go-button) (start-stream-iri-clsr main-window t))))
(defmethod initialize-instance :after ((object tool-bar) &key &allow-other-keys)
(with-accessors ((iri-entry iri-entry)
@ -265,7 +277,3 @@
(let ((main-frame (make-instance 'main-frame)))
(gui:grid main-frame 0 0 :sticky :nswe)
(gui-goodies:gui-resize-grid-all gui:*tk*))))
;; (let ((test-iri "gemini://omg.pebcak.club/"))
;; (slurp-gemini-stream test-iri
;; :process-function (lambda (lines) (misc:dbg "lines ~a" lines))))))))

12
src/gui/client/program-events.lisp
View File

@ -24,18 +24,14 @@
(setf *events-loop-thread*
(bt:make-thread (lambda ()
(loop while (events-loop-running-p) do
(misc:dbg "event loop!")
(ev:dispatch-program-events-or-wait)
(misc:dbg "dipacth event loop! ~a run
~a " *stop-events-loop* (events-loop-running-p)))
(misc:dbg "event loop fine! ~a" *stop-events-loop*)))))
(ev:dispatch-program-events-or-wait))))))
(defmacro with-enqueue-request ((method-name id &rest args) &body on-error)
(defmacro with-enqueue-request ((method-name id the-error &rest args) &body on-error)
`(ev:with-enqueued-process-and-unblock ()
(handler-case
(comm:make-request ,method-name ,id ,@args)
(error (the-error) ; anaphora
(declare (ignorable the-error))
(error (,the-error)
(declare (ignorable ,the-error))
,@on-error))))
(defun enqueue-request-and-wait-results (method-name id priority &rest args)

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

@ -191,15 +191,15 @@
:certificate certificate
:certificate-key certificate-key))))
(gemini-client:gemini-tofu-error (e)
(error (format nil "TOFU error: ~a" e)))
(error "TOFU error: ~a" e))
(conditions:not-implemented-error (e)
(error (format nil (_ "Error: ~a") e)))
(error (_ "Error: ~a") e))
(gemini-client:gemini-protocol-error (e)
(error (format nil "~a" e)))
(error "~a" e))
(error (e)
(error (format nil (_ "Error getting ~s: ~a") url e)))
(error (_ "Error getting ~s: ~a") url e))
(condition (c)
(error (format nil (_ "Error getting ~s: ~a") url c))))))
(error (_ "Error getting ~s: ~a") url c)))))
(defun gemini-request (iri use-cache)
(%gemini-request iri :use-cached-file-if-exists use-cache))

5
src/package.lisp
View File

@ -3260,7 +3260,9 @@
(:export
:events-loop-running-p
:stop-events-loop
:start-events-loop))
:start-events-loop
:with-enqueue-request
:enqueue-request-and-wait-results))
(defpackage :icons
(:use :cl
@ -3355,6 +3357,7 @@
(:re :cl-ppcre)
(:a :alexandria)
(:ev :program-events)
(:cev :client-events)
(:gui :nodgui)
(:gui-mw :nodgui.mw)
(:gui-shapes :nodgui.shapes)