mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-16 08:00:35 +01:00
- [gemini] added a window to manage all the gemini streams opened.
This commit is contained in:
parent
1c3a3d9bff
commit
f7d025ea2a
@ -473,3 +473,15 @@ gemini.h1.prefix = "🞓 "
|
||||
gemini.h2.prefix = "🞐 "
|
||||
|
||||
gemini.h3.prefix = "🞎 "
|
||||
|
||||
# this is the window that allow to browse the gemini streams
|
||||
|
||||
open-gemini-stream-window.background = black
|
||||
|
||||
open-gemini-stream-window.foreground = #FEB200
|
||||
|
||||
# the colors of selected stream
|
||||
|
||||
open-gemini-stream-window.input.selected.background = black
|
||||
|
||||
open-gemini-stream-window.input.selected.foreground = #FFB200
|
||||
|
@ -303,7 +303,19 @@
|
||||
|
||||
(define-key "U" #'gemini-view-source *gemini-message-keymap*)
|
||||
|
||||
(define-key "a" #'gemini-abort-download *gemini-message-keymap*)
|
||||
(define-key "d" #'gemini-open-streams-window *gemini-message-keymap*)
|
||||
|
||||
;; gemini stream window keymap
|
||||
|
||||
(define-key "a" #'gemini-abort-download *gemini-downloads-keymap*)
|
||||
|
||||
(define-key "up" #'gemini-streams-window-up *gemini-downloads-keymap*)
|
||||
|
||||
(define-key "down" #'gemini-streams-window-down *gemini-downloads-keymap*)
|
||||
|
||||
(define-key "q" #'gemini-streams-window-close *gemini-downloads-keymap*)
|
||||
|
||||
(define-key "C-J" #'gemini-streams-window-open-stream *gemini-downloads-keymap*)
|
||||
|
||||
;; tags keymap
|
||||
|
||||
|
@ -97,6 +97,12 @@ color-regexp = "🞎 " yellow
|
||||
|
||||
color-regexp = "• " blue bold
|
||||
|
||||
color-regexp = ":completed" green bold
|
||||
|
||||
color-regexp = ":aborted" red
|
||||
|
||||
color-regexp = ":rendering" cyan
|
||||
|
||||
# the signature file path relative to $HOME
|
||||
|
||||
# signature-file = ".signature"
|
||||
|
@ -35,3 +35,18 @@
|
||||
(setf (gemini-metadata-source-file object)
|
||||
(strcat (gemini-metadata-source-file object)
|
||||
source-file)))
|
||||
|
||||
(defun add-url-to-history (window url)
|
||||
(let* ((metadata (message-window:metadata window))
|
||||
(history (reverse (gemini-metadata-history metadata)))
|
||||
(last-entry (safe-last-elt (gemini-metadata-history metadata))))
|
||||
(when (string/= last-entry
|
||||
url)
|
||||
(setf (gemini-metadata-history metadata)
|
||||
(reverse (push url history))))))
|
||||
|
||||
(defun maybe-initialize-metadata (window)
|
||||
(when (not (gemini-metadata-p (message-window:metadata window)))
|
||||
(setf (message-window:metadata window)
|
||||
(make-gemini-metadata)))
|
||||
(message-window:metadata window))
|
||||
|
@ -17,24 +17,37 @@
|
||||
|
||||
(in-package :gemini-viewer)
|
||||
|
||||
(defun add-url-to-history (window url)
|
||||
(let* ((metadata (message-window:metadata window))
|
||||
(history (reverse (gemini-metadata-history metadata)))
|
||||
(last-entry (safe-last-elt (gemini-metadata-history metadata))))
|
||||
(when (string/= last-entry
|
||||
url)
|
||||
(setf (gemini-metadata-history metadata)
|
||||
(reverse (push url history))))))
|
||||
(define-constant +read-buffer-size+ 1024
|
||||
:documentation "Chunk's size of the buffer when reading non gemini contents from stream")
|
||||
|
||||
(defun maybe-initialize-metadata (window)
|
||||
(when (not (gemini-metadata-p (message-window:metadata window)))
|
||||
(setf (message-window:metadata window)
|
||||
(make-gemini-metadata)))
|
||||
(message-window:metadata window))
|
||||
(defparameter *gemini-streams-db* ())
|
||||
|
||||
(defparameter *download-thread-lock* (bt:make-recursive-lock "download-gemini"))
|
||||
(defun push-db-stream (stream-object)
|
||||
(pushnew stream-object
|
||||
*gemini-streams-db*
|
||||
:test (lambda (a b)
|
||||
(string= (download-uri a)
|
||||
(download-uri b))))
|
||||
*gemini-streams-db*)
|
||||
|
||||
(defparameter *download-thread-blocked* nil)
|
||||
(defun remove-db-stream (stream-object)
|
||||
(setf *gemini-streams-db*
|
||||
(remove stream-object *gemini-streams-db*))
|
||||
*gemini-streams-db*)
|
||||
|
||||
(defun find-db-stream-if (predicate)
|
||||
(find-if predicate *gemini-streams-db*))
|
||||
|
||||
(defun find-db-stream-url (url)
|
||||
(find-db-stream-if (lambda (a) (string= (download-uri a) url))))
|
||||
|
||||
(defun db-entry-to-foreground (uri)
|
||||
(when-let* ((stream-object (find-db-stream-url uri)))
|
||||
(with-accessors ((support-file support-file)
|
||||
(meta meta)) stream-object
|
||||
(if (gemini-client:mime-gemini-p meta)
|
||||
(setf (stream-status stream-object) :rendering)
|
||||
(os-utils:xdg-open support-file)))))
|
||||
|
||||
(defclass gemini-stream ()
|
||||
((download-thread-lock
|
||||
@ -73,11 +86,67 @@
|
||||
:initform 0
|
||||
:initarg :octect-count
|
||||
:accessor octect-count)
|
||||
(port
|
||||
:initform nil
|
||||
:initarg :port
|
||||
:accessor port)
|
||||
(status-code
|
||||
:initform nil
|
||||
:initarg :status-code
|
||||
:accessor status-code)
|
||||
(status-code-description
|
||||
:initform nil
|
||||
:initarg :status-code-description
|
||||
:accessor status-code-description)
|
||||
(meta
|
||||
:initform nil
|
||||
:initarg :meta
|
||||
:accessor meta)
|
||||
(path
|
||||
:initform nil
|
||||
:initarg :path
|
||||
:accessor path)
|
||||
(host
|
||||
:initform nil
|
||||
:initarg :host
|
||||
:accessor host)
|
||||
(thread
|
||||
:initform nil
|
||||
:initarg :thread
|
||||
:accessor thread)))
|
||||
|
||||
(defmethod print-object ((object gemini-stream) stream)
|
||||
(print-unreadable-object (object stream :type t :identity t)
|
||||
(format stream
|
||||
"~a ~d ~a ~a"
|
||||
(download-uri object)
|
||||
(octect-count object)
|
||||
(meta object)
|
||||
(stream-status object))))
|
||||
|
||||
(defmethod to-tui-string ((object gemini-stream) &key (window nil))
|
||||
(flet ((pad (string width)
|
||||
(right-padding (ellipsize string width) width)))
|
||||
(let* ((window-width (win-width window))
|
||||
(url-w (truncate (* window-width 2/3)))
|
||||
(octect-count-w (truncate (* window-width 1/9)))
|
||||
(meta-w (truncate (* window-width 1/9)))
|
||||
(status-w (truncate (* window-width 1/9)))
|
||||
(color-re (swconf:color-regexps))
|
||||
(fitted-line (format nil
|
||||
"~a ~d ~a ~a"
|
||||
(pad (download-uri object) url-w)
|
||||
(pad (to-s (octect-count object))
|
||||
octect-count-w)
|
||||
(pad (meta object) meta-w)
|
||||
(ellipsize (string-downcase (format nil
|
||||
"~s"
|
||||
(stream-status object)))
|
||||
status-w))))
|
||||
(loop for re in color-re do
|
||||
(setf fitted-line (colorize-line fitted-line re)))
|
||||
(colorized-line->tui-string fitted-line))))
|
||||
|
||||
(defgeneric abort-downloading (object))
|
||||
|
||||
(defgeneric allow-downloading (object))
|
||||
@ -88,6 +157,7 @@
|
||||
|
||||
(defmethod abort-downloading ((object gemini-stream))
|
||||
(with-accessors ((download-thread-lock download-thread-lock)) object
|
||||
(setf (stream-status object) :aborted)
|
||||
(with-lock (download-thread-lock)
|
||||
(setf (download-thread-blocked object) t))))
|
||||
|
||||
@ -105,7 +175,7 @@
|
||||
(with-accessors ((download-thread-lock download-thread-lock)
|
||||
(stream-status stream-status)) object
|
||||
(with-lock (download-thread-lock)
|
||||
(setf stream-status val))))
|
||||
(setf (slot-value object 'stream-status) val))))
|
||||
|
||||
(defmethod stream-status ((object gemini-stream))
|
||||
(with-accessors ((download-thread-lock download-thread-lock)) object
|
||||
@ -127,6 +197,15 @@
|
||||
|
||||
(defclass gemini-file-stream (gemini-stream) ())
|
||||
|
||||
(defmethod (setf stream-status) :after ((val (eql :rendering)) (object gemini-file-stream))
|
||||
(with-accessors ((download-thread-lock download-thread-lock)
|
||||
(support-file support-file)) object
|
||||
(with-lock (download-thread-lock)
|
||||
(let ((event (make-gemini-download-event (fs:slurp-file support-file)
|
||||
object
|
||||
nil)))
|
||||
(program-events:push-event event)))))
|
||||
|
||||
(defclass gemini-others-data-stream (gemini-stream) ())
|
||||
|
||||
(defmacro with-open-support-file ((stream file &optional (element-type '(unsigned-byte 8)))
|
||||
@ -154,9 +233,30 @@
|
||||
(with-accessors ((octect-count octect-count)) object
|
||||
(incf octect-count data)))
|
||||
|
||||
(defun make-gemini-download-event (src-data stream-object append-text)
|
||||
(with-accessors ((download-uri download-uri)
|
||||
(host host)
|
||||
(port port)
|
||||
(path path)
|
||||
(meta meta)
|
||||
(status-code status-code)
|
||||
(status-code-description status-code-description)) stream-object
|
||||
(let* ((parsed (gemini-parser:parse-gemini-file src-data))
|
||||
(links (gemini-parser:sexp->links parsed host port path))
|
||||
(response (gemini-client:make-gemini-file-response status-code
|
||||
status-code-description
|
||||
meta
|
||||
parsed
|
||||
download-uri
|
||||
src-data
|
||||
links)))
|
||||
(make-instance 'program-events:gemini-got-line-event
|
||||
:wrapper-object stream-object
|
||||
:payload response
|
||||
:append-text append-text))))
|
||||
|
||||
(defun request-stream-gemini-document-thread (wrapper-object host
|
||||
port path query
|
||||
status-code status-code-description meta)
|
||||
port path query)
|
||||
(with-accessors ((download-socket download-socket)
|
||||
(download-stream download-stream)
|
||||
(octect-count octect-count)
|
||||
@ -167,7 +267,8 @@
|
||||
(lambda ()
|
||||
(with-open-support-file (file-stream support-file character)
|
||||
(let* ((url (gemini-parser:make-gemini-uri host path query port))
|
||||
(parsed-url (gemini-parser:parse-gemini-file (format nil "-> ~a~%" url)))
|
||||
(url-header (format nil "-> ~a~%" url))
|
||||
(parsed-url (gemini-parser:parse-gemini-file url-header))
|
||||
(url-response (gemini-client:make-gemini-file-response nil
|
||||
nil
|
||||
nil
|
||||
@ -179,6 +280,8 @@
|
||||
:wrapper-object wrapper-object
|
||||
:payload url-response
|
||||
:append-text nil)))
|
||||
(write-sequence url-header file-stream)
|
||||
(increment-bytes-count wrapper-object url-header :convert-to-octects t)
|
||||
(maybe-render-line url-event)
|
||||
(loop
|
||||
named download-loop
|
||||
@ -186,18 +289,7 @@
|
||||
while line-as-array do
|
||||
(if (downloading-allowed-p wrapper-object)
|
||||
(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
|
||||
status-code-description
|
||||
meta
|
||||
parsed
|
||||
url
|
||||
line
|
||||
links))
|
||||
(event (make-instance 'program-events:gemini-got-line-event
|
||||
:wrapper-object wrapper-object
|
||||
:payload response)))
|
||||
(event (make-gemini-download-event line wrapper-object t)))
|
||||
(write-sequence line file-stream)
|
||||
(increment-bytes-count wrapper-object line :convert-to-octects t)
|
||||
(maybe-render-line event))
|
||||
@ -205,10 +297,12 @@
|
||||
(return-from download-loop nil))))
|
||||
(if (not (downloading-allowed-p wrapper-object))
|
||||
(ui:notify (_ "Gemini document downloading aborted"))
|
||||
(ui:notify (_ "Gemini document downloading completed")))
|
||||
(allow-downloading wrapper-object)
|
||||
(gemini-client:close-ssl-socket download-socket)))
|
||||
(fs:delete-file-if-exists support-file)))))
|
||||
(progn
|
||||
(ui:notify (_ "Gemini document downloading completed"))
|
||||
(setf (stream-status wrapper-object) :completed)))
|
||||
;; (allow-downloading wrapper-object)
|
||||
(gemini-client:close-ssl-socket download-socket)))))))
|
||||
;; (fs:delete-file-if-exists support-file)))))
|
||||
|
||||
(defun request-stream-other-document-thread (wrapper-object
|
||||
socket
|
||||
@ -228,18 +322,20 @@
|
||||
(lambda ()
|
||||
(with-open-support-file (file-stream support-file)
|
||||
(labels ((%fill-buffer ()
|
||||
(when (downloading-allowed-p wrapper-object)
|
||||
(multiple-value-bind (buffer read-so-far)
|
||||
(read-array download-stream 1024)
|
||||
(read-array download-stream +read-buffer-size+)
|
||||
(increment-bytes-count wrapper-object read-so-far)
|
||||
(if (< read-so-far (length buffer))
|
||||
(progn
|
||||
(write-sequence buffer file-stream :start 0 :end read-so-far)
|
||||
(force-output file-stream)
|
||||
(setf (stream-status wrapper-object) :completed)
|
||||
(gemini-client:close-ssl-socket socket)
|
||||
(os-utils:xdg-open support-file))
|
||||
(progn
|
||||
(write-sequence buffer file-stream)
|
||||
(%fill-buffer))))))
|
||||
(%fill-buffer)))))))
|
||||
(%fill-buffer))))))
|
||||
|
||||
(defun request (url &key (enqueue nil))
|
||||
@ -264,7 +360,7 @@
|
||||
:rendering)
|
||||
(if enqueue
|
||||
nil
|
||||
nil)))
|
||||
:running)))
|
||||
(get-user-input (hide-input host prompt)
|
||||
(flet ((on-input-complete (input)
|
||||
(when (string-not-empty-p input)
|
||||
@ -309,6 +405,13 @@
|
||||
(if (gemini-file-stream-p meta)
|
||||
(let* ((starting-status (starting-status meta))
|
||||
(gemini-stream (make-instance 'gemini-file-stream
|
||||
:host host
|
||||
:port port
|
||||
:path path
|
||||
:meta meta
|
||||
:status-code status
|
||||
:status-code-description
|
||||
code-description
|
||||
:stream-status starting-status
|
||||
:download-stream response
|
||||
:download-socket socket))
|
||||
@ -317,17 +420,19 @@
|
||||
host
|
||||
port
|
||||
path
|
||||
query
|
||||
status
|
||||
code-description
|
||||
meta)))
|
||||
query))
|
||||
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
|
||||
:payload gemini-stream)))
|
||||
(program-events:push-event enqueue-event)
|
||||
(downloading-start-thread gemini-stream
|
||||
thread-fn
|
||||
host
|
||||
port
|
||||
path
|
||||
query))
|
||||
(let* ((gemini-stream (make-instance 'gemini-others-data-stream
|
||||
(let* ((starting-status (starting-status meta))
|
||||
(gemini-stream (make-instance 'gemini-others-data-stream
|
||||
:stream-status starting-status
|
||||
:download-stream response
|
||||
:download-socket socket))
|
||||
(thread-fn
|
||||
@ -339,7 +444,10 @@
|
||||
query
|
||||
status
|
||||
code-description
|
||||
meta)))
|
||||
meta))
|
||||
(enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
|
||||
:payload gemini-stream)))
|
||||
(program-events:push-event enqueue-event)
|
||||
(downloading-start-thread gemini-stream
|
||||
thread-fn
|
||||
host
|
||||
@ -388,3 +496,90 @@
|
||||
(setf (message-window:source-text window) source)
|
||||
(draw window)
|
||||
(ui:info-message (format nil (_ "Viewing source of: ~a") last))))
|
||||
|
||||
(defclass gemini-streams-window (focus-marked-window
|
||||
simple-line-navigation-window
|
||||
title-window
|
||||
border-window)
|
||||
())
|
||||
|
||||
(defmethod refresh-config :after ((object gemini-streams-window))
|
||||
(open-attach-window:refresh-view-links-window-config object
|
||||
swconf:+key-open-gemini-stream-window+)
|
||||
(let* ((win-w (truncate (* (win-width specials:*main-window*) 3/4)))
|
||||
(win-h (truncate (* (win-height specials:*main-window*) 3/4)))
|
||||
(x (truncate (- (/ (win-width specials:*main-window*) 2)
|
||||
(/ win-w 2))))
|
||||
(y (truncate (- (/ (win-height specials:*main-window*) 2)
|
||||
(/ win-h 2)))))
|
||||
(win-resize object win-w win-h)
|
||||
(win-move object x y)
|
||||
object))
|
||||
|
||||
(defmethod resync-rows-db ((object gemini-streams-window)
|
||||
&key
|
||||
(redraw t)
|
||||
(suggested-message-index nil))
|
||||
(with-accessors ((rows rows)
|
||||
(selected-line-bg selected-line-bg)
|
||||
(selected-line-fg selected-line-fg)) object
|
||||
(flet ((make-rows (streams bg fg)
|
||||
(mapcar (lambda (stream-object)
|
||||
(let ((unselected-line (to-tui-string stream-object :window object)))
|
||||
(make-instance 'line
|
||||
:normal-text unselected-line
|
||||
:selected-text (tui-string->chars-string unselected-line)
|
||||
:fields stream-object
|
||||
:normal-bg bg
|
||||
:normal-fg fg
|
||||
:selected-bg fg
|
||||
:selected-fg bg)))
|
||||
streams)))
|
||||
(with-croatoan-window (croatoan-window object)
|
||||
(setf rows (make-rows *gemini-streams-db*
|
||||
selected-line-bg
|
||||
selected-line-fg))
|
||||
(when suggested-message-index
|
||||
(select-row object suggested-message-index))
|
||||
(when redraw
|
||||
(draw object))))))
|
||||
|
||||
(defmethod draw :before ((object gemini-streams-window))
|
||||
(with-accessors ((rows rows)
|
||||
(uses-border-p uses-border-p)
|
||||
(single-row-height single-row-height)
|
||||
(top-row-padding top-row-padding)
|
||||
(new-messages-mark new-messages-mark)
|
||||
(top-rows-slice top-rows-slice)
|
||||
(bottom-rows-slice bottom-rows-slice)) object
|
||||
(let ((y-start (if uses-border-p
|
||||
1
|
||||
0)))
|
||||
(renderizable-rows-data object) ; set top and bottom slice
|
||||
(win-clear object)
|
||||
(with-croatoan-window (croatoan-window object)
|
||||
(loop
|
||||
for gemini-stream in (safe-subseq rows top-rows-slice bottom-rows-slice)
|
||||
for y from (+ y-start top-row-padding) by single-row-height do
|
||||
(print-text object
|
||||
gemini-stream
|
||||
1 y
|
||||
:bgcolor (bgcolor croatoan-window)
|
||||
:fgcolor (fgcolor croatoan-window)))))))
|
||||
|
||||
(defun open-gemini-stream-window ()
|
||||
(let* ((low-level-window (make-croatoan-window :enable-function-keys t)))
|
||||
(setf *gemini-streams-window*
|
||||
(make-instance 'gemini-streams-window
|
||||
:top-row-padding 0
|
||||
:title (_ "Current gemini streams")
|
||||
:single-row-height 1
|
||||
:uses-border-p t
|
||||
:keybindings keybindings:*gemini-downloads-keymap*
|
||||
:croatoan-window low-level-window))
|
||||
(refresh-config *gemini-streams-window*)
|
||||
(resync-rows-db *gemini-streams-window* :redraw nil)
|
||||
(when (rows *gemini-streams-window*)
|
||||
(select-row *gemini-streams-window* 0))
|
||||
(draw *gemini-streams-window*)
|
||||
*gemini-streams-window*))
|
||||
|
@ -252,6 +252,8 @@ produces a tree and graft the latter on `existing-tree'"
|
||||
(defparameter *open-gemini-link-keymap* (make-starting-comand-tree)
|
||||
"The keymap for window to open gemini's links.")
|
||||
|
||||
(defparameter *gemini-downloads-keymap* (make-starting-comand-tree)
|
||||
"The keymap for window that shows all gemini streams.")
|
||||
|
||||
(defun define-key (key-sequence function &optional (existing-keymap *global-keymap*))
|
||||
"Define a key sequence that trigger a function:
|
||||
|
@ -925,6 +925,7 @@
|
||||
:+key-tags-window+
|
||||
:+key-open-attach-window+
|
||||
:+key-open-message-link-window+
|
||||
:+key-open-gemini-stream-window+
|
||||
:+key-conversations-window+
|
||||
:+key-keybindings-window+
|
||||
:+key-suggestions-window+
|
||||
@ -1043,6 +1044,7 @@
|
||||
:text-length
|
||||
:find-max-line-width
|
||||
:ncat-complex-string
|
||||
:to-tui-string
|
||||
:cat-complex-string
|
||||
:cat-tui-string
|
||||
:tui-char->char
|
||||
@ -1105,7 +1107,8 @@
|
||||
:*tags-window*
|
||||
:*conversations-window*
|
||||
:*open-attach-window*
|
||||
:*open-message-link-window*))
|
||||
:*open-message-link-window*
|
||||
:*gemini-streams-window*))
|
||||
|
||||
(defpackage :complete
|
||||
(:use
|
||||
@ -1217,6 +1220,7 @@
|
||||
:function-event
|
||||
:gemini-got-line-event
|
||||
:gemini-abort-downloading-event
|
||||
:gemini-enqueue-download-event
|
||||
:dispatch-program-events
|
||||
:add-pagination-status-event
|
||||
:status-id
|
||||
@ -1333,6 +1337,7 @@
|
||||
:*open-attach-keymap*
|
||||
:*open-message-link-keymap*
|
||||
:*open-gemini-link-keymap*
|
||||
:*gemini-downloads-keymap*
|
||||
:define-key
|
||||
:init-keyboard-mapping
|
||||
:find-keymap-node
|
||||
@ -1911,6 +1916,11 @@
|
||||
:tui-utils)
|
||||
(:shadowing-import-from :misc :random-elt :shuffle)
|
||||
(:export
|
||||
:push-db-stream
|
||||
:remove-db-stream
|
||||
:find-db-stream-if
|
||||
:find-db-stream-url
|
||||
:db-entry-to-foreground
|
||||
:gemini-metadata-p
|
||||
:make-gemini-metadata
|
||||
:gemini-metadata-links
|
||||
@ -1922,9 +1932,24 @@
|
||||
:add-url-to-history
|
||||
:history-back
|
||||
:view-source
|
||||
:gemini-stream
|
||||
:download-uri
|
||||
:start-time
|
||||
:download-stream
|
||||
:download-socket
|
||||
:support-file
|
||||
:octect-count
|
||||
:port
|
||||
:status-code
|
||||
:status-code-description
|
||||
:meta
|
||||
:path
|
||||
:host
|
||||
:thread
|
||||
:abort-downloading
|
||||
:downloading-allowed-p
|
||||
:request))
|
||||
:request
|
||||
:open-gemini-stream-window))
|
||||
|
||||
(defpackage :main-window
|
||||
(:use
|
||||
@ -2081,7 +2106,12 @@
|
||||
:open-gemini-address
|
||||
:gemini-history-back
|
||||
:gemini-view-source
|
||||
:gemini-abort-download))
|
||||
:gemini-abort-download
|
||||
:gemini-open-streams-window
|
||||
:gemini-streams-window-up
|
||||
:gemini-streams-window-down
|
||||
:gemini-streams-window-close
|
||||
:gemini-streams-window-open-stream))
|
||||
|
||||
(defpackage :modules
|
||||
(:use
|
||||
|
@ -969,8 +969,17 @@
|
||||
(defclass gemini-abort-downloading-event (program-event) ())
|
||||
|
||||
(defmethod process-event ((object gemini-abort-downloading-event))
|
||||
(with-accessors ((download-stream payload)) object
|
||||
(gemini-viewer:abort-downloading download-stream)))
|
||||
(with-accessors ((uri payload)) object
|
||||
(when-let ((stream-object (gemini-viewer:find-db-stream-url uri)))
|
||||
(gemini-viewer:abort-downloading stream-object)
|
||||
(gemini-viewer:remove-db-stream stream-object)
|
||||
(line-oriented-window:resync-rows-db specials:*gemini-streams-window*))))
|
||||
|
||||
(defclass gemini-enqueue-download-event (program-event) ())
|
||||
|
||||
(defmethod process-event ((object gemini-enqueue-download-event))
|
||||
(with-accessors ((stream-object payload)) object
|
||||
(gemini-viewer:push-db-stream stream-object)))
|
||||
|
||||
(defclass function-event (program-event) ())
|
||||
|
||||
|
@ -378,6 +378,7 @@
|
||||
suggestions-window
|
||||
open-attach-window
|
||||
open-message-link-window
|
||||
open-gemini-stream-window
|
||||
command-window
|
||||
command-separator
|
||||
gemini
|
||||
|
@ -51,3 +51,6 @@
|
||||
|
||||
(defparameter *open-message-link-window* nil
|
||||
"The window that shows links in a message.")
|
||||
|
||||
(defparameter *gemini-streams-window* nil
|
||||
"The window that shows all gemini-streams.")
|
||||
|
@ -141,6 +141,11 @@ as argument `complex-string'."
|
||||
"Destructively concatenate the `complex-string' `a' and `b'"
|
||||
(croatoan:nconcat-complex-string a b))
|
||||
|
||||
(defgeneric to-tui-string (object &key &allow-other-keys))
|
||||
|
||||
(defmethod to-tui-string ((object string) &key &allow-other-keys)
|
||||
(make-tui-string object))
|
||||
|
||||
(defgeneric cat-complex-string (a b &key color-attributes-contagion)
|
||||
(:documentation "Return a new `complex-string' that is the results
|
||||
of concatenating `a' and 'b'. If `color-attributes-contagion' is non
|
||||
|
@ -354,15 +354,21 @@ Metadata includes:
|
||||
(if print-message
|
||||
(_ "focus passed on threads window")
|
||||
nil)
|
||||
*open-message-link-window* *open-attach-window*
|
||||
*conversations-window* *tags-window* *send-message-window*
|
||||
*message-window* *follow-requests-window*))
|
||||
*gemini-streams-window*
|
||||
*open-message-link-window*
|
||||
*open-attach-window*
|
||||
*conversations-window*
|
||||
*tags-window*
|
||||
*send-message-window*
|
||||
*message-window*
|
||||
*follow-requests-window*))
|
||||
|
||||
(gen-focus-to-window message-window
|
||||
specials:*message-window*
|
||||
:documentation "Move focus on message window"
|
||||
:info-change-focus-message (_ "Focus passed on message window")
|
||||
:windows-lose-focus (specials:*open-message-link-window*
|
||||
:windows-lose-focus (specials:*gemini-streams-window*
|
||||
specials:*open-message-link-window*
|
||||
specials:*open-attach-window*
|
||||
specials:*conversations-window*
|
||||
specials:*tags-window*
|
||||
@ -370,12 +376,12 @@ Metadata includes:
|
||||
specials:*send-message-window*
|
||||
specials:*follow-requests-window*))
|
||||
|
||||
|
||||
(gen-focus-to-window send-message-window
|
||||
specials:*send-message-window*
|
||||
:documentation "Move focus on send message window"
|
||||
:info-change-focus-message (_ "Focus passed on send message window")
|
||||
:windows-lose-focus (specials:*open-message-link-window*
|
||||
:windows-lose-focus (specials:*gemini-streams-window*
|
||||
specials:*open-message-link-window*
|
||||
specials:*open-attach-window*
|
||||
specials:*conversations-window*
|
||||
specials:*tags-window*
|
||||
@ -387,7 +393,8 @@ Metadata includes:
|
||||
specials:*follow-requests-window*
|
||||
:documentation "Move focus on follow requests window"
|
||||
:info-change-focus-message (_ "Focus passed on follow requests window")
|
||||
:windows-lose-focus (specials:*open-message-link-window*
|
||||
:windows-lose-focus (specials:*gemini-streams-window*
|
||||
specials:*open-message-link-window*
|
||||
specials:*open-attach-window*
|
||||
specials:*conversations-window*
|
||||
specials:*tags-window*
|
||||
@ -399,7 +406,8 @@ Metadata includes:
|
||||
specials:*tags-window*
|
||||
:documentation "Move focus on tags window"
|
||||
:info-change-focus-message (_ "Focus passed on tags window")
|
||||
:windows-lose-focus (specials:*open-message-link-window*
|
||||
:windows-lose-focus (specials:*gemini-streams-window*
|
||||
specials:*open-message-link-window*
|
||||
specials:*open-attach-window*
|
||||
specials:*conversations-window*
|
||||
specials:*follow-requests-window*
|
||||
@ -410,7 +418,8 @@ Metadata includes:
|
||||
specials:*conversations-window*
|
||||
:documentation "Move focus on conversations window"
|
||||
:info-change-focus-message (_ "Focus passed on conversation window")
|
||||
:windows-lose-focus (specials:*open-message-link-window*
|
||||
:windows-lose-focus (specials:*gemini-streams-window*
|
||||
specials:*open-message-link-window*
|
||||
specials:*open-attach-window*
|
||||
specials:*tags-window*
|
||||
specials:*follow-requests-window*
|
||||
@ -422,7 +431,8 @@ Metadata includes:
|
||||
specials:*open-attach-window*
|
||||
:documentation "Move focus on open-attach window"
|
||||
:info-change-focus-message (_ "Focus passed on attach window")
|
||||
:windows-lose-focus (specials:*open-message-link-window*
|
||||
:windows-lose-focus (specials:*gemini-streams-window*
|
||||
specials:*open-message-link-window*
|
||||
specials:*conversations-window*
|
||||
specials:*tags-window*
|
||||
specials:*follow-requests-window*
|
||||
@ -434,7 +444,8 @@ Metadata includes:
|
||||
specials:*open-message-link-window*
|
||||
:documentation "Move focus on open-link window"
|
||||
:info-change-focus-message (_ "Focus passed on link window")
|
||||
:windows-lose-focus (specials:*conversations-window*
|
||||
:windows-lose-focus (specials:*gemini-streams-window*
|
||||
specials:*conversations-window*
|
||||
specials:*open-attach-window*
|
||||
specials:*tags-window*
|
||||
specials:*follow-requests-window*
|
||||
@ -442,6 +453,18 @@ Metadata includes:
|
||||
specials:*message-window*
|
||||
specials:*send-message-window*))
|
||||
|
||||
(gen-focus-to-window open-gemini-stream-windows
|
||||
specials:*gemini-streams-window*
|
||||
:documentation "Move focus on open gemini streams window"
|
||||
:info-change-focus-message (_ "Focus passed on gemini-stream window")
|
||||
:windows-lose-focus (specials:*open-message-link-window*
|
||||
specials:*conversations-window*
|
||||
specials:*open-attach-window*
|
||||
specials:*tags-window*
|
||||
specials:*follow-requests-window*
|
||||
specials:*thread-window*
|
||||
specials:*message-window*
|
||||
specials:*send-message-window*))
|
||||
(defun print-quick-help ()
|
||||
"Print a quick help"
|
||||
(keybindings:print-help specials:*main-window*))
|
||||
@ -1378,6 +1401,38 @@ This command will remove those limits so that we can just jump to the last messa
|
||||
|
||||
(defun gemini-abort-download ()
|
||||
"Stop a transferring data from a gemini server"
|
||||
(let ((event (make-instance 'gemini-abort-downloading-event
|
||||
(when-let* ((fields (line-oriented-window:selected-row-fields specials:*gemini-streams-window*))
|
||||
(uri-to-abort (gemini-viewer:download-uri fields))
|
||||
(event (make-instance 'gemini-abort-downloading-event
|
||||
:payload uri-to-abort
|
||||
:priority program-events:+maximum-event-priority+)))
|
||||
(push-event event)))
|
||||
|
||||
(defun gemini-open-streams-window ()
|
||||
"Open a window listing the gemini streams"
|
||||
(gemini-viewer:open-gemini-stream-window)
|
||||
(focus-to-open-gemini-stream-windows))
|
||||
|
||||
(defun gemini-streams-move (amount)
|
||||
(ignore-errors
|
||||
(line-oriented-window:unselect-all specials:*gemini-streams-window*)
|
||||
(line-oriented-window:row-move specials:*gemini-streams-window* amount)
|
||||
(draw specials:*gemini-streams-window*)))
|
||||
|
||||
(defun gemini-streams-window-up ()
|
||||
"Move to the upper stream in the list."
|
||||
(gemini-streams-move -1))
|
||||
|
||||
(defun gemini-streams-window-down ()
|
||||
"Move to the lower stream in the list."
|
||||
(gemini-streams-move 1))
|
||||
|
||||
(defun gemini-streams-window-close ()
|
||||
"Close the streams window."
|
||||
(close-window-and-return-to-message specials:*gemini-streams-window*))
|
||||
|
||||
(defun gemini-streams-window-open-stream ()
|
||||
"Open the selected stream."
|
||||
(when-let* ((fields (line-oriented-window:selected-row-fields specials:*gemini-streams-window*))
|
||||
(uri-to-open (gemini-viewer:download-uri fields)))
|
||||
(gemini-viewer:db-entry-to-foreground uri-to-open)))
|
||||
|
Loading…
x
Reference in New Issue
Block a user