- [gemini] added the possibility to abort current page download.

etc/init.lisp

@@ -303,6 +303,8 @@
 
 (define-key "U"         #'gemini-view-source                         *gemini-message-keymap*)
 
+(define-key "a"         #'gemini-abort-download                      *gemini-message-keymap*)
+
 ;; tags keymap
 
 (define-key "up"        #'tag-go-up                                   *tags-keymap*)

src/gemini-viewer.lisp

@@ -51,6 +51,21 @@
           (make-gemini-metadata)))
   (message-window:metadata window))
 
+(defparameter *download-thread-lock* (bt:make-recursive-lock "download-gemini"))
+
+(defparameter *download-thread-blocked* nil)
+
+(misc:defun-w-lock abort-downloading ()
+    *download-thread-lock*
+  (setf *download-thread-blocked* t))
+
+(misc:defun-w-lock allow-downloading ()
+    *download-thread-lock*
+  (setf *download-thread-blocked* nil))
+
+(misc:defun-w-lock downloading-allowed-p ()
+    *download-thread-lock*
+  (not *download-thread-blocked*))
 
 (defun request-stream-gemini-document-thread (socket stream host
                               port path query
@@ -70,9 +85,11 @@
                                         :append-text nil)))
       (program-events:push-event url-event)
       (loop
+         named download-loop
          for line-as-array = (read-line-into-array stream)
          while line-as-array do
-           (let* ((line     (babel:octets-to-string line-as-array :errorp nil))
+           (if (downloading-allowed-p)
+               (let* ((line     (babel:octets-to-string line-as-array :errorp nil))
                   (parsed   (gemini-parser:parse-gemini-file line))
                   (links    (gemini-parser:sexp->links parsed host port path))
                   (response (gemini-client:make-gemini-file-response status-code
@@ -84,8 +101,13 @@
                                                                      links))
                   (event    (make-instance 'program-events:gemini-got-line-event
                                            :payload response)))
-             (program-events:push-event event)))
-      (ui:notify (_ "Gemini document downloading completed"))
+                 (program-events:push-event event))
+               (progn
+                 (return-from download-loop nil))))
+      (if (not (downloading-allowed-p))
+          (ui:notify (_ "Gemini document downloading aborted"))
+          (ui:notify (_ "Gemini document downloading completed")))
+      (allow-downloading)
       (gemini-client:close-ssl-socket socket))))
 
 (defun request-stream-other-document-thread (socket stream host

src/package.lisp

@@ -1214,6 +1214,7 @@
    :gemini-back-event
    :function-event
    :gemini-got-line-event
+   :gemini-abort-downloading-event
    :dispatch-program-events
    :add-pagination-status-event
    :status-id
@@ -1918,6 +1919,8 @@
    :add-url-to-history
    :history-back
    :view-source
+   :abort-downloading
+   :downloading-allowed-p
    :request))
 
 (defpackage :main-window
@@ -2074,7 +2077,8 @@
    :poll-vote
    :open-gemini-address
    :gemini-history-back
-   :gemini-view-source))
+   :gemini-view-source
+   :gemini-abort-download))
 
 (defpackage :modules
   (:use

src/program-events.lisp

@@ -934,22 +934,28 @@
                      (source               gemini-client:source)
                      (links                gemini-client:links)
                      (text-rendering-theme gemini-client:text-rendering-theme)) response
-      (let* ((win specials:*message-window*)
-             (rendered-line   (gemini-parser:sexp->text parsed-file
-                                                        text-rendering-theme))
-             (window-metadata (message-window:metadata win)))
-        (if append-text
-            (progn
-              (message-window:append-source-text win rendered-line :prepare-for-rendering t)
-              (gemini-viewer:append-metadata-link window-metadata links)
-              (gemini-viewer:append-metadata-source window-metadata source)
-              (setf (windows:keybindings win)
-                    keybindings:*gemini-message-keymap*))
-            (progn
-              (setf (message-window:source-text win) rendered-line)
-              (setf (gemini-viewer:gemini-metadata-source-file window-metadata) rendered-line)
-              (setf (gemini-viewer:gemini-metadata-links window-metadata) links)))
-        (windows:draw win)))))
+      (when (gemini-viewer:downloading-allowed-p)
+        (let* ((win specials:*message-window*)
+               (rendered-line   (gemini-parser:sexp->text parsed-file
+                                                          text-rendering-theme))
+               (window-metadata (message-window:metadata win)))
+          (if append-text
+              (progn
+                (message-window:append-source-text win rendered-line :prepare-for-rendering t)
+                (gemini-viewer:append-metadata-link window-metadata links)
+                (gemini-viewer:append-metadata-source window-metadata source)
+                (setf (windows:keybindings win)
+                      keybindings:*gemini-message-keymap*))
+              (progn
+                (setf (message-window:source-text win) rendered-line)
+                (setf (gemini-viewer:gemini-metadata-source-file window-metadata) rendered-line)
+                (setf (gemini-viewer:gemini-metadata-links window-metadata) links)))
+          (windows:draw win))))))
+
+(defclass gemini-abort-downloading-event (program-event) ())
+
+(defmethod process-event ((object gemini-abort-downloading-event))
+  (gemini-viewer:abort-downloading))
 
 (defclass function-event (program-event) ())
 

src/ui-goodies.lisp

@@ -1371,3 +1371,9 @@ This command will remove those limits so that we can just jump to the last messa
 (defun gemini-view-source ()
   "Shows the source of current gemini page"
   (gemini-viewer:view-source specials:*message-window*))
+
+(defun gemini-abort-download ()
+  "Stop a transferring data from a gemini server"
+  (let ((event (make-instance 'gemini-abort-downloading-event
+                              :priority program-events:+maximum-event-priority+)))
+    (push-event event)))