1
0
Fork 0

- [GUI] added address autocomplete;

- added optional argument to specify pushing function in: 'program-events:push-function-and-wait-results'.
This commit is contained in:
cage 2023-02-09 17:04:29 +01:00
parent 282b36d712
commit 7b415e485a
4 changed files with 48 additions and 25 deletions

View File

@ -456,7 +456,6 @@
for line-as-array = (with-print-error-message
(read-line-into-array download-stream))
while line-as-array do
(sleep 3)
(gemini-client:debug-gemini "[stream] gemini file stream raw data line : ~a"
line-as-array)
(if (downloading-allowed-p wrapper-object)

View File

@ -70,8 +70,11 @@
(declare (ignorable the-error))
,@on-error))))
(defun notify-request-error (e)
(misc:dbg "got error ~a" e))
(defun enqueue-request-and-wait-results (method-name id priority &rest args)
(ev:push-function-and-wait-results (lambda () (apply #'comm:make-request method-name id args))
:push-event-fn #'ev:push-event-unblock
:priority priority))
(defun slurp-gemini-stream (iri &key
(use-cache t)
@ -87,8 +90,7 @@
(when (not (or (funcall aborting-function)
(stream-exausted-p)))
(ev:with-enqueued-process-and-unblock ()
(handler-case
(progn
(with-notify-errors
(let* ((last-lines-fetched (comm:make-request :gemini-stream-parsed-line-slice
1
iri
@ -98,9 +100,7 @@
(when last-lines-fetched
(funcall process-function last-lines-fetched))
(loop-fetch (+ last-lines-fetched-count
next-start-fetching))))
(error (e)
(notify-request-error e)))))))
next-start-fetching))))))))
(loop-fetch)))
(defun start-streaming-thread (iri &key
@ -123,6 +123,16 @@
(setf (fetching-thread stream-wrapper) stream-thread)
(push-db-stream stream-wrapper))))))
(defun notify-request-error (e)
(gui-goodies:error-dialog gui:*tk*
(format nil (_ "Comunication with backend failed: ~a") e)))
(defmacro with-notify-errors (&body body)
`(handler-case
(progn ,@body)
(error (e)
(notify-request-error e))))
(defun initialize-menu (parent)
(with-accessors ((main-window main-window)) parent
(let* ((bar (gui:make-menubar))
@ -152,7 +162,13 @@
(defun autocomplete-iri-clsr (toolbar)
(declare (ignore toolbar))
(lambda (hint)
(if (> (length hint) 2)
(with-notify-errors
(enqueue-request-and-wait-results :complete-net-address
1
ev:+maximum-event-priority+
hint))
hint)))
(defmethod initialize-instance :after ((object tool-bar) &key &allow-other-keys)
(with-accessors ((iri-entry iri-entry)
@ -246,6 +262,8 @@
(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))))))))
;; (let ((test-iri "gemini://omg.pebcak.club/"))
;; (slurp-gemini-stream test-iri
;; :process-function (lambda (lines) (misc:dbg "lines ~a" lines))))))))

View File

@ -248,11 +248,15 @@
(with-lock (lock)
(bt:condition-notify condition-variable))))
(defun push-function-and-wait-results (fn)
(let* ((event (make-instance 'blocking-caller-event :payload fn))
(defun push-function-and-wait-results (fn &key
(priority +standard-event-priority+)
(push-event-fn #'push-event))
(let* ((event (make-instance 'blocking-caller-event
:payload fn
:priority priority))
(lock (lock event))
(condition-variable (condition-variable event)))
(push-event event)
(funcall push-event-fn event)
(with-lock (lock)
(loop
while (null (box:unbox (results event)))

View File

@ -84,7 +84,9 @@
(bt:make-thread (lambda ()
(sleep 3)
(format t "push!~%")
(setf res (push-function-and-wait-results #'callback))))
(setf res
(push-function-and-wait-results #'callback))
(format t "pop!~%")))
(map 'nil
(lambda (a)
(sleep 1)