mirror of https://codeberg.org/cage/tinmop/
- [GUI] added address autocomplete;
- added optional argument to specify pushing function in: 'program-events:push-function-and-wait-results'.
This commit is contained in:
parent
282b36d712
commit
7b415e485a
|
@ -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)
|
||||
|
|
|
@ -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,20 +90,17 @@
|
|||
(when (not (or (funcall aborting-function)
|
||||
(stream-exausted-p)))
|
||||
(ev:with-enqueued-process-and-unblock ()
|
||||
(handler-case
|
||||
(progn
|
||||
(let* ((last-lines-fetched (comm:make-request :gemini-stream-parsed-line-slice
|
||||
1
|
||||
iri
|
||||
last-lines-fetched-count
|
||||
nil))
|
||||
(next-start-fetching (length last-lines-fetched)))
|
||||
(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)))))))
|
||||
(with-notify-errors
|
||||
(let* ((last-lines-fetched (comm:make-request :gemini-stream-parsed-line-slice
|
||||
1
|
||||
iri
|
||||
last-lines-fetched-count
|
||||
nil))
|
||||
(next-start-fetching (length last-lines-fetched)))
|
||||
(when last-lines-fetched
|
||||
(funcall process-function last-lines-fetched))
|
||||
(loop-fetch (+ last-lines-fetched-count
|
||||
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)
|
||||
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))))))))
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue