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

- [gemini] remove from the event queue all the lines got from a gemtext download 

when aborting a download.
This commit is contained in:
cage 2020-09-30 16:36:34 +02:00
parent 4bbb0184e1
commit f1a0715c2b
3 changed files with 53 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/package.lisp
View File

@ -561,6 +561,7 @@
:find-element
:remove-element
:count-elements-if
:remove-element-if
:emptyp
:with-min-queue))
@ -1183,6 +1184,7 @@
:event-available-p
:pop-event
:remove-event
:remove-event-if
:find-event
:ask-user-input-string-event
:user-input-string-event

58
src/priority-queue.lisp
View File

@ -54,6 +54,8 @@
(defgeneric remove-element (object element))
(defgeneric remove-element-if (object predicate))
(defgeneric count-elements-if (object predicate &key key-fn))
(defun get-parent-pos (pos)
@ -157,6 +159,46 @@
:key key-fn
:start 1))
(defun remove-at-pos (queue pos)
(with-accessors ((heap heap)
(key-function key-function)
(equal-function equal-function)
(compare-function compare-function)) queue
(let ((old-length (length heap)))
(cond
((null pos)
nil)
((= pos 1)
(pop-element queue)
pos)
(t
(misc:swap (elt heap pos)
(elt heap (1- (length heap))))
(setf (fill-pointer heap) (1- (fill-pointer heap)))
(when (not (= pos (1- old-length)))
(let ((parent-pos (get-parent-pos pos)))
(if (funcall compare-function (elt heap pos) (elt heap parent-pos))
(rearrange-bottom-up queue pos)
(rearrange-top-bottom queue pos))))
pos)))))
(defmethod remove-element-if ((object priority-queue) predicate)
(with-accessors ((heap heap)
(key-function key-function)
(equal-function equal-function)
(compare-function compare-function)) object
(labels ((%remove ()
(let* ((actual-predicate (or predicate compare-function))
(pos (position-if actual-predicate
heap
:start 1
:key (key-function object))))
(when pos
(progn
(remove-at-pos object pos)
(%remove))))))
(%remove))))
(defmethod remove-element ((object priority-queue) element)
(with-accessors ((heap heap)
(key-function key-function)
@ -166,17 +208,5 @@
heap
:start 1
:key (key-function object)
:test (equal-function object)))
(old-length (length heap)))
(if (and pos
(= pos 1))
(pop-element object)
(when pos
(misc:swap (elt heap pos)
(elt heap (1- (length heap))))
(setf (fill-pointer heap) (1- (fill-pointer heap)))
(when (not (= pos (1- old-length)))
(let ((parent-pos (get-parent-pos pos)))
(if (funcall compare-function (elt heap pos) (elt heap parent-pos))
(rearrange-bottom-up object pos)
(rearrange-top-bottom object pos)))))))))
:test (equal-function object))))
(remove-at-pos object pos))))

7
src/program-events.lisp
View File

@ -154,6 +154,10 @@
(wrapped-in-lock (*events-queue*)
(count-elements-if *events-queue* predicate :key-fn #'identity)))
(defun remove-event-if (predicate)
(wrapped-in-lock (*events-queue*)
(remove-element-if *events-queue* predicate)))
(defclass event-on-own-thread (program-event)
((lock
:initform (bt:make-recursive-lock)
@ -998,6 +1002,9 @@
(when-let ((stream-object (gemini-viewer:find-db-stream-url uri)))
(gemini-viewer:abort-downloading stream-object)
(gemini-viewer:remove-db-stream stream-object)
(remove-event-if (lambda (a)
(and (typep a 'gemini-got-line-event)
(string= uri (gemini-viewer:download-uri stream-object)))))
(line-oriented-window:resync-rows-db specials:*gemini-streams-window*))))
(defclass gemini-enqueue-download-event (program-event) ())