diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp index a980f91..619d6b7 100644 --- a/src/gemini-viewer.lisp +++ b/src/gemini-viewer.lisp @@ -315,7 +315,11 @@ (return-from download-loop nil)))) (if (not (downloading-allowed-p wrapper-object)) (ui:notify (_ "Gemini document downloading aborted")) - (progn + (let ((compact-event (make-instance 'program-events:gemini-compact-lines-event + :download-uri (download-uri wrapper-object) + :priority + program-events:+maximum-event-priority+))) + (program-events:push-event compact-event) (ui:notify (_ "Gemini document downloading completed")) (setf (stream-status wrapper-object) :completed))) ;; (allow-downloading wrapper-object) diff --git a/src/package.lisp b/src/package.lisp index 3d5c71c..03ea4bd 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1251,6 +1251,7 @@ :gemini-abort-all-downloading-event :gemini-push-behind-downloading-event :gemini-abort-downloading-event + :gemini-compact-lines-event :gemini-enqueue-download-event :get-chat-messages-event :get-chats-event diff --git a/src/priority-queue.lisp b/src/priority-queue.lisp index f5e46d1..8dedfab 100644 --- a/src/priority-queue.lisp +++ b/src/priority-queue.lisp @@ -30,7 +30,7 @@ :initarg :compare-function :accessor compare-function) (equal-function - :initform (misc:make-array-frame 1 nil) + :initform #'= :initarg :equal-function :accessor equal-function))) @@ -213,9 +213,22 @@ :test (equal-function object)))) (remove-at-pos object pos)))) +(defun queue->list (queue) + (let ((res ())) + (loop for element = (pop-element queue) while element do + (push element res)) + (reverse res))) + (defmethod map-elements ((object priority-queue) (function function)) - (with-accessors ((heap heap)) object - (loop for index from 1 below (length heap) do - (let ((element (elt heap index))) - (setf (elt heap index) - (funcall function element)))))) + (let* ((ordered (queue->list object)) + (mapped (mapcar function ordered))) + (loop for element in mapped do + (push-element object element)) + object)) + +(defun tt () + (let ((queue (make-instance 'priority-queue))) + (loop for i from 10 downto 1 do + (push-element queue i)) + (format t "~a~%" (queue->list queue)) + (map-elements queue (lambda (a) (format t "->~a<-~%" a) a)))) diff --git a/src/program-events.lisp b/src/program-events.lisp index 1978bd7..fa6a886 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -1004,6 +1004,53 @@ (setf (gemini-viewer:gemini-metadata-links window-metadata) links))) (windows:draw win)))))) +(defclass gemini-compact-lines-event (program-event) + ((download-uri + :initform nil + :initarg :download-uri + :accessor download-uri))) + +(defmethod process-event ((object gemini-compact-lines-event)) + (with-accessors ((download-uri download-uri)) object + (let ((all-lines "") + (all-links ()) + (all-source "")) + (map-events (lambda (a) + (with-accessors ((response payload) + (wrapper-object wrapper-object)) a + (with-accessors ((parsed-file gemini-client:parsed-file) + (source gemini-client:source) + (links gemini-client:links) + (text-rendering-theme gemini-client:text-rendering-theme)) + response + (when (and (typep a 'gemini-got-line-event) + (string= download-uri + (gemini-viewer:download-uri wrapper-object)) + (gemini-viewer:downloading-allowed-p wrapper-object) + (not (skip-rendering-p a))) + (let ((rendered-text (gemini-parser:sexp->text parsed-file + text-rendering-theme))) + (appendf all-links links) + (setf all-source + (text-utils:strcat all-source source)) + (setf all-lines + (text-utils:strcat all-lines rendered-text)))))) + a)) + (when (text-utils:string-not-empty-p all-lines) + (remove-event-if (lambda (a) + (with-accessors ((wrapper-object wrapper-object)) a + (and (typep a 'gemini-got-line-event) + (string= download-uri + (gemini-viewer:download-uri wrapper-object)))))) + (let* ((win specials:*message-window*) + (window-metadata (message-window:metadata win))) + (message-window:append-source-text win all-lines :prepare-for-rendering t) + (gemini-viewer:append-metadata-link window-metadata all-links) + (gemini-viewer:append-metadata-source window-metadata all-source) + (setf (windows:keybindings win) + keybindings:*gemini-message-keymap*) + (windows:draw win)))))) + (defclass gemini-abort-downloading-event (program-event) ()) (defmethod process-event ((object gemini-abort-downloading-event))