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

- [GUI] added method "stream-url" specialized on 'gemini-stream'; 

- [GUI] fixed setting status of stream on completion;
- [GUI] removed freezing when scaling text on rendering of an active stream;
- [GUI] prevented crash when ask the program to shows an already shown stream frame.
This commit is contained in:
cage 2023-09-16 19:05:33 +02:00
parent d647465c1e
commit 409e8c5cb9
5 changed files with 64 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/gui/client/constants.lisp
View File

@ -9,3 +9,5 @@
(define-constant +stream-status-canceled+ :canceled :test #'eq)
(define-constant +stream-status-downloading+ :downloading :test #'eq)
(define-constant +stream-status-completed+ :completed :test #'eq)

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

@ -21,6 +21,8 @@
(defgeneric status (object))
(defgeneric streaming-url (object))
(defmethod status ((object gemini-stream))
(misc:with-lock ((status-lock object))
(slot-value object 'status)))
@ -30,33 +32,42 @@
(setf (slot-value object 'status) val)
val))
(defmethod streaming-url ((object gemini-stream))
(server-stream-handle object))
(defparameter *gemini-streams-db* ())
(defparameter *gemini-streams-db-lock* (bt:make-lock "gemini-streams-db-lock"))
(defun push-db-stream (stream-object)
(misc:with-lock (*gemini-streams-db-lock*)
(pushnew stream-object
*gemini-streams-db*
:test (lambda (a b)
(string= (server-stream-handle a)
(server-stream-handle b))))
*gemini-streams-db*)
*gemini-streams-db*))
(defun remove-db-stream (stream-object)
(misc:with-lock (*gemini-streams-db-lock*)
(setf *gemini-streams-db*
(remove stream-object *gemini-streams-db*))
*gemini-streams-db*)
*gemini-streams-db*))
(defmethod abort-downloading ((object gemini-stream))
(setf (status object) +stream-status-canceled+))
(defun remove-all-db-stream ()
(misc:with-lock (*gemini-streams-db-lock*)
(map nil
(lambda (a) (abort-downloading a))
*gemini-streams-db*)
(setf *gemini-streams-db* ())
*gemini-streams-db*)
*gemini-streams-db*))
(defun find-db-stream-if (predicate)
(find-if predicate *gemini-streams-db*))
(misc:with-lock (*gemini-streams-db-lock*)
(find-if predicate *gemini-streams-db*)))
(defun find-db-stream-url (url)
(find-db-stream-if (lambda (a) (string= (server-stream-handle a) url))))
@ -124,6 +135,8 @@
iri)))
status-completed))
(perform-after-stream-exausted-actions ()
(a:when-let ((current-streaming-stream (find-streaming-stream-url)))
(setf (status current-streaming-stream) +stream-status-completed+))
(print-info-message (_ "Stream finished"))
(gui:configure-mouse-pointer (gemtext-widget main-window) :xterm)
(render-toc main-window iri)
@ -162,7 +175,11 @@
(ev:with-enqueued-process-and-unblock ()
(set-bookmark-button-false main-window)))
(ev:with-enqueued-process-and-unblock ()
(set-gemlog-toolbar-button-appearance main-window iri))))
(set-gemlog-toolbar-button-appearance main-window iri))
(ev:with-enqueued-process-and-unblock (program-events:+minimum-event-priority+)
(client-stream-frame::refresh-all-streams
(client-stream-frame::table (stream-frame main-window))
#'client-stream-frame::all-rows-non-blocking))))
(defun set-gemlog-toolbar-button-appearance (main-window iri)
(if (comm:make-request :gemini-gemlog-subscribed-p 1 iri)
@ -1083,8 +1100,8 @@ local file paths."
;; collecting events left on
;; the queue won't be actually
;; processed, just discarded
(when (not (eq (status stream-wrapper)
+stream-status-canceled+))
(when (eq (status stream-wrapper)
+stream-status-streaming+)
(collect-ir-lines iri main-window lines)))))
((gemini-client:text-file-stream-p meta)
(slurp-text-data main-window iri))
@ -1563,13 +1580,19 @@ local file paths."
,@body)))
(defun scale-gemtext (main-window offset)
(with-interrupt-rendering-enqueue-restart-rendering (main-window ())
(let ((saved-active-stream (find-streaming-stream-url)))
(interrupt-rendering main-window)
(maybe-stop-streaming-stream-thread)
(when saved-active-stream
(open-iri (streaming-url saved-active-stream) main-window t))
(ev:with-enqueued-process-and-unblock (program-events:+minimum-event-priority+)
(restart-rendering main-window)
(clear-gemtext main-window)
(setf (gemtext-font-scaling main-window)
(if offset
(max 0.1 (+ (gemtext-font-scaling main-window) offset))
1.0))
(render-ir-lines (get-address-bar-text main-window) main-window)))
(render-ir-lines (get-address-bar-text main-window) main-window))))
(defun initialize-keybindings (main-window target)
(gui:bind target

3
src/gui/client/menu-command.lisp
View File

@ -58,7 +58,8 @@
(let* ((master gui-goodies:*main-frame*)
(stream-frame (client-main-window::stream-frame master))
(main-frame (client-main-window::main-paned-frame master)))
(gui:add-pane main-frame stream-frame)))
(when (not (gui:paned-widget-p main-frame stream-frame))
(gui:add-pane main-frame stream-frame))))
(defun show-bookmarks-clsr (main-window)
(lambda ()

12
src/gui/client/stream-frame.lisp
View File

@ -40,13 +40,20 @@
(getf b :download-iri)))))
rows))
(defun refresh-all-streams (stream-table)
(defun refresh-all-streams (stream-table &optional (all-rows-fn #'all-rows))
(with-accessors ((tree gui-goodies:tree)
(rows gui-goodies:rows)) stream-table
(let ((new-rows (all-rows)))
(let ((new-rows (funcall all-rows-fn)))
(resync-rows stream-table new-rows)
stream-table)))
(defun all-rows-non-blocking ()
(let ((rows (comm:make-request :gemini-all-stream-info 1)))
(setf rows (sort rows
(lambda (a b) (string< (getf a :download-iri)
(getf b :download-iri)))))
rows))
(defmethod initialize-instance :after ((object stream-table) &key &allow-other-keys)
(with-accessors ((tree gui-goodies:tree)) object
(let ((treeview (make-instance 'gui:scrolled-treeview
@ -83,6 +90,7 @@
(with-accessors ((tree gui-goodies:tree)) stream-table
(lambda ()
(client-main-window::interrupt-rendering main-window)
(client-main-window::maybe-stop-streaming-stream-thread)
(a:when-let* ((selections (gui:treeview-get-selection tree))
(selection (first selections)))
(let* ((url (gui:id selection))

3
src/package.lisp
View File

@ -81,7 +81,8 @@
:+ps-file-dialog-filter+
:+stream-status-streaming+
:+stream-status-canceled+
:+stream-status-downloading+))
:+stream-status-downloading+
:+stream-status-completed+))
(defpackage :conditions
(:use :cl