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

- [gemini] added a window to manage all the gemini streams opened.

This commit is contained in:
cage 2020-08-30 15:34:08 +02:00
parent 1c3a3d9bff
commit f7d025ea2a
12 changed files with 545 additions and 200 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
etc/default-theme.conf
View File

@ -473,3 +473,15 @@ gemini.h1.prefix = "🞓 "
gemini.h2.prefix = "🞐 " gemini.h2.prefix = "🞐 "
gemini.h3.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

14
etc/init.lisp
View File

@ -303,7 +303,19 @@
(define-key "U" #'gemini-view-source *gemini-message-keymap*) (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 ;; tags keymap

6
etc/shared.conf
View File

@ -97,6 +97,12 @@ color-regexp = "🞎 " yellow
color-regexp = "• " blue bold color-regexp = "• " blue bold
color-regexp = ":completed" green bold
color-regexp = ":aborted" red
color-regexp = ":rendering" cyan
# the signature file path relative to $HOME # the signature file path relative to $HOME
# signature-file = ".signature" # signature-file = ".signature"

15
src/gemini-viewer-metadata.lisp
View File

@ -35,3 +35,18 @@
(setf (gemini-metadata-source-file object) (setf (gemini-metadata-source-file object)
(strcat (gemini-metadata-source-file object) (strcat (gemini-metadata-source-file object)
source-file))) 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))

283
src/gemini-viewer.lisp
View File

@ -17,24 +17,37 @@
(in-package :gemini-viewer) (in-package :gemini-viewer)
(defun add-url-to-history (window url) (define-constant +read-buffer-size+ 1024
(let* ((metadata (message-window:metadata window)) :documentation "Chunk's size of the buffer when reading non gemini contents from stream")
(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) (defparameter *gemini-streams-db* ())
(when (not (gemini-metadata-p (message-window:metadata window)))
(setf (message-window:metadata window)
(make-gemini-metadata)))
(message-window:metadata window))
(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 () (defclass gemini-stream ()
((download-thread-lock ((download-thread-lock
@ -73,11 +86,67 @@
:initform 0 :initform 0
:initarg :octect-count :initarg :octect-count
:accessor 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 (thread
:initform nil :initform nil
:initarg :thread :initarg :thread
:accessor 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 abort-downloading (object))
(defgeneric allow-downloading (object)) (defgeneric allow-downloading (object))
@ -88,6 +157,7 @@
(defmethod abort-downloading ((object gemini-stream)) (defmethod abort-downloading ((object gemini-stream))
(with-accessors ((download-thread-lock download-thread-lock)) object (with-accessors ((download-thread-lock download-thread-lock)) object
(setf (stream-status object) :aborted)
(with-lock (download-thread-lock) (with-lock (download-thread-lock)
(setf (download-thread-blocked object) t)))) (setf (download-thread-blocked object) t))))
@ -105,7 +175,7 @@
(with-accessors ((download-thread-lock download-thread-lock) (with-accessors ((download-thread-lock download-thread-lock)
(stream-status stream-status)) object (stream-status stream-status)) object
(with-lock (download-thread-lock) (with-lock (download-thread-lock)
(setf stream-status val)))) (setf (slot-value object 'stream-status) val))))
(defmethod stream-status ((object gemini-stream)) (defmethod stream-status ((object gemini-stream))
(with-accessors ((download-thread-lock download-thread-lock)) object (with-accessors ((download-thread-lock download-thread-lock)) object
@ -127,6 +197,15 @@
(defclass gemini-file-stream (gemini-stream) ()) (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) ()) (defclass gemini-others-data-stream (gemini-stream) ())
(defmacro with-open-support-file ((stream file &optional (element-type '(unsigned-byte 8))) (defmacro with-open-support-file ((stream file &optional (element-type '(unsigned-byte 8)))
@ -154,9 +233,30 @@
(with-accessors ((octect-count octect-count)) object (with-accessors ((octect-count octect-count)) object
(incf octect-count data))) (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 (defun request-stream-gemini-document-thread (wrapper-object host
port path query port path query)
status-code status-code-description meta)
(with-accessors ((download-socket download-socket) (with-accessors ((download-socket download-socket)
(download-stream download-stream) (download-stream download-stream)
(octect-count octect-count) (octect-count octect-count)
@ -167,7 +267,8 @@
(lambda () (lambda ()
(with-open-support-file (file-stream support-file character) (with-open-support-file (file-stream support-file character)
(let* ((url (gemini-parser:make-gemini-uri host path query port)) (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 (url-response (gemini-client:make-gemini-file-response nil
nil nil
nil nil
@ -179,6 +280,8 @@
:wrapper-object wrapper-object :wrapper-object wrapper-object
:payload url-response :payload url-response
:append-text nil))) :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) (maybe-render-line url-event)
(loop (loop
named download-loop named download-loop
@ -186,18 +289,7 @@
while line-as-array do while line-as-array do
(if (downloading-allowed-p wrapper-object) (if (downloading-allowed-p wrapper-object)
(let* ((line (babel:octets-to-string line-as-array :errorp nil)) (let* ((line (babel:octets-to-string line-as-array :errorp nil))
(parsed (gemini-parser:parse-gemini-file line)) (event (make-gemini-download-event line wrapper-object t)))
(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)))
(write-sequence line file-stream) (write-sequence line file-stream)
(increment-bytes-count wrapper-object line :convert-to-octects t) (increment-bytes-count wrapper-object line :convert-to-octects t)
(maybe-render-line event)) (maybe-render-line event))
@ -205,10 +297,12 @@
(return-from download-loop nil)))) (return-from download-loop nil))))
(if (not (downloading-allowed-p wrapper-object)) (if (not (downloading-allowed-p wrapper-object))
(ui:notify (_ "Gemini document downloading aborted")) (ui:notify (_ "Gemini document downloading aborted"))
(ui:notify (_ "Gemini document downloading completed"))) (progn
(allow-downloading wrapper-object) (ui:notify (_ "Gemini document downloading completed"))
(gemini-client:close-ssl-socket download-socket))) (setf (stream-status wrapper-object) :completed)))
(fs:delete-file-if-exists support-file))))) ;; (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 (defun request-stream-other-document-thread (wrapper-object
socket socket
@ -228,18 +322,20 @@
(lambda () (lambda ()
(with-open-support-file (file-stream support-file) (with-open-support-file (file-stream support-file)
(labels ((%fill-buffer () (labels ((%fill-buffer ()
(when (downloading-allowed-p wrapper-object)
(multiple-value-bind (buffer read-so-far) (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) (increment-bytes-count wrapper-object read-so-far)
(if (< read-so-far (length buffer)) (if (< read-so-far (length buffer))
(progn (progn
(write-sequence buffer file-stream :start 0 :end read-so-far) (write-sequence buffer file-stream :start 0 :end read-so-far)
(force-output file-stream) (force-output file-stream)
(setf (stream-status wrapper-object) :completed)
(gemini-client:close-ssl-socket socket) (gemini-client:close-ssl-socket socket)
(os-utils:xdg-open support-file)) (os-utils:xdg-open support-file))
(progn (progn
(write-sequence buffer file-stream) (write-sequence buffer file-stream)
(%fill-buffer)))))) (%fill-buffer)))))))
(%fill-buffer)))))) (%fill-buffer))))))
(defun request (url &key (enqueue nil)) (defun request (url &key (enqueue nil))
@ -264,7 +360,7 @@
:rendering) :rendering)
(if enqueue (if enqueue
nil nil
nil))) :running)))
(get-user-input (hide-input host prompt) (get-user-input (hide-input host prompt)
(flet ((on-input-complete (input) (flet ((on-input-complete (input)
(when (string-not-empty-p input) (when (string-not-empty-p input)
@ -309,6 +405,13 @@
(if (gemini-file-stream-p meta) (if (gemini-file-stream-p meta)
(let* ((starting-status (starting-status meta)) (let* ((starting-status (starting-status meta))
(gemini-stream (make-instance 'gemini-file-stream (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 :stream-status starting-status
:download-stream response :download-stream response
:download-socket socket)) :download-socket socket))
@ -317,17 +420,19 @@
host host
port port
path path
query query))
status (enqueue-event (make-instance 'program-events:gemini-enqueue-download-event
code-description :payload gemini-stream)))
meta))) (program-events:push-event enqueue-event)
(downloading-start-thread gemini-stream (downloading-start-thread gemini-stream
thread-fn thread-fn
host host
port port
path path
query)) 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-stream response
:download-socket socket)) :download-socket socket))
(thread-fn (thread-fn
@ -339,7 +444,10 @@
query query
status status
code-description 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 (downloading-start-thread gemini-stream
thread-fn thread-fn
host host
@ -388,3 +496,90 @@
(setf (message-window:source-text window) source) (setf (message-window:source-text window) source)
(draw window) (draw window)
(ui:info-message (format nil (_ "Viewing source of: ~a") last)))) (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*))

2
src/keybindings.lisp
View File

@ -252,6 +252,8 @@ produces a tree and graft the latter on `existing-tree'"
(defparameter *open-gemini-link-keymap* (make-starting-comand-tree) (defparameter *open-gemini-link-keymap* (make-starting-comand-tree)
"The keymap for window to open gemini's links.") "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*)) (defun define-key (key-sequence function &optional (existing-keymap *global-keymap*))
"Define a key sequence that trigger a function: "Define a key sequence that trigger a function:

36
src/package.lisp
View File

@ -925,6 +925,7 @@
:+key-tags-window+ :+key-tags-window+
:+key-open-attach-window+ :+key-open-attach-window+
:+key-open-message-link-window+ :+key-open-message-link-window+
:+key-open-gemini-stream-window+
:+key-conversations-window+ :+key-conversations-window+
:+key-keybindings-window+ :+key-keybindings-window+
:+key-suggestions-window+ :+key-suggestions-window+
@ -1043,6 +1044,7 @@
:text-length :text-length
:find-max-line-width :find-max-line-width
:ncat-complex-string :ncat-complex-string
:to-tui-string
:cat-complex-string :cat-complex-string
:cat-tui-string :cat-tui-string
:tui-char->char :tui-char->char
@ -1105,7 +1107,8 @@
:*tags-window* :*tags-window*
:*conversations-window* :*conversations-window*
:*open-attach-window* :*open-attach-window*
:*open-message-link-window*)) :*open-message-link-window*
:*gemini-streams-window*))
(defpackage :complete (defpackage :complete
(:use (:use
@ -1217,6 +1220,7 @@
:function-event :function-event
:gemini-got-line-event :gemini-got-line-event
:gemini-abort-downloading-event :gemini-abort-downloading-event
:gemini-enqueue-download-event
:dispatch-program-events :dispatch-program-events
:add-pagination-status-event :add-pagination-status-event
:status-id :status-id
@ -1333,6 +1337,7 @@
:*open-attach-keymap* :*open-attach-keymap*
:*open-message-link-keymap* :*open-message-link-keymap*
:*open-gemini-link-keymap* :*open-gemini-link-keymap*
:*gemini-downloads-keymap*
:define-key :define-key
:init-keyboard-mapping :init-keyboard-mapping
:find-keymap-node :find-keymap-node
@ -1911,6 +1916,11 @@
:tui-utils) :tui-utils)
(:shadowing-import-from :misc :random-elt :shuffle) (:shadowing-import-from :misc :random-elt :shuffle)
(:export (:export
:push-db-stream
:remove-db-stream
:find-db-stream-if
:find-db-stream-url
:db-entry-to-foreground
:gemini-metadata-p :gemini-metadata-p
:make-gemini-metadata :make-gemini-metadata
:gemini-metadata-links :gemini-metadata-links
@ -1922,9 +1932,24 @@
:add-url-to-history :add-url-to-history
:history-back :history-back
:view-source :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 :abort-downloading
:downloading-allowed-p :downloading-allowed-p
:request)) :request
:open-gemini-stream-window))
(defpackage :main-window (defpackage :main-window
(:use (:use
@ -2081,7 +2106,12 @@
:open-gemini-address :open-gemini-address
:gemini-history-back :gemini-history-back
:gemini-view-source :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 (defpackage :modules
(:use (:use

13
src/program-events.lisp
View File

@ -969,8 +969,17 @@
(defclass gemini-abort-downloading-event (program-event) ()) (defclass gemini-abort-downloading-event (program-event) ())
(defmethod process-event ((object gemini-abort-downloading-event)) (defmethod process-event ((object gemini-abort-downloading-event))
(with-accessors ((download-stream payload)) object (with-accessors ((uri payload)) object
(gemini-viewer:abort-downloading download-stream))) (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) ()) (defclass function-event (program-event) ())

1
src/software-configuration.lisp
View File

@ -378,6 +378,7 @@
suggestions-window suggestions-window
open-attach-window open-attach-window
open-message-link-window open-message-link-window
open-gemini-stream-window
command-window command-window
command-separator command-separator
gemini gemini

3
src/specials.lisp
View File

@ -51,3 +51,6 @@
(defparameter *open-message-link-window* nil (defparameter *open-message-link-window* nil
"The window that shows links in a message.") "The window that shows links in a message.")
(defparameter *gemini-streams-window* nil
"The window that shows all gemini-streams.")

5
src/tui-utils.lisp
View File

@ -141,6 +141,11 @@ as argument `complex-string'."
"Destructively concatenate the `complex-string' `a' and `b'" "Destructively concatenate the `complex-string' `a' and `b'"
(croatoan:nconcat-complex-string a 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) (defgeneric cat-complex-string (a b &key color-attributes-contagion)
(:documentation "Return a new `complex-string' that is the results (:documentation "Return a new `complex-string' that is the results
of concatenating `a' and 'b'. If `color-attributes-contagion' is non of concatenating `a' and 'b'. If `color-attributes-contagion' is non

79
src/ui-goodies.lisp
View File

@ -354,15 +354,21 @@ Metadata includes:
(if print-message (if print-message
(_ "focus passed on threads window") (_ "focus passed on threads window")
nil) nil)
*open-message-link-window* *open-attach-window* *gemini-streams-window*
*conversations-window* *tags-window* *send-message-window* *open-message-link-window*
*message-window* *follow-requests-window*)) *open-attach-window*
*conversations-window*
*tags-window*
*send-message-window*
*message-window*
*follow-requests-window*))
(gen-focus-to-window message-window (gen-focus-to-window message-window
specials:*message-window* specials:*message-window*
:documentation "Move focus on message window" :documentation "Move focus on message window"
:info-change-focus-message (_ "Focus passed 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:*open-attach-window*
specials:*conversations-window* specials:*conversations-window*
specials:*tags-window* specials:*tags-window*
@ -370,12 +376,12 @@ Metadata includes:
specials:*send-message-window* specials:*send-message-window*
specials:*follow-requests-window*)) specials:*follow-requests-window*))
(gen-focus-to-window send-message-window (gen-focus-to-window send-message-window
specials:*send-message-window* specials:*send-message-window*
:documentation "Move focus on send message window" :documentation "Move focus on send message window"
:info-change-focus-message (_ "Focus passed 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:*open-attach-window*
specials:*conversations-window* specials:*conversations-window*
specials:*tags-window* specials:*tags-window*
@ -387,7 +393,8 @@ Metadata includes:
specials:*follow-requests-window* specials:*follow-requests-window*
:documentation "Move focus on follow requests window" :documentation "Move focus on follow requests window"
:info-change-focus-message (_ "Focus passed 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:*open-attach-window*
specials:*conversations-window* specials:*conversations-window*
specials:*tags-window* specials:*tags-window*
@ -399,7 +406,8 @@ Metadata includes:
specials:*tags-window* specials:*tags-window*
:documentation "Move focus on tags window" :documentation "Move focus on tags window"
:info-change-focus-message (_ "Focus passed 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:*open-attach-window*
specials:*conversations-window* specials:*conversations-window*
specials:*follow-requests-window* specials:*follow-requests-window*
@ -410,7 +418,8 @@ Metadata includes:
specials:*conversations-window* specials:*conversations-window*
:documentation "Move focus on conversations window" :documentation "Move focus on conversations window"
:info-change-focus-message (_ "Focus passed on conversation 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:*open-attach-window*
specials:*tags-window* specials:*tags-window*
specials:*follow-requests-window* specials:*follow-requests-window*
@ -422,7 +431,8 @@ Metadata includes:
specials:*open-attach-window* specials:*open-attach-window*
:documentation "Move focus on open-attach window" :documentation "Move focus on open-attach window"
:info-change-focus-message (_ "Focus passed on 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:*conversations-window*
specials:*tags-window* specials:*tags-window*
specials:*follow-requests-window* specials:*follow-requests-window*
@ -434,7 +444,8 @@ Metadata includes:
specials:*open-message-link-window* specials:*open-message-link-window*
:documentation "Move focus on open-link window" :documentation "Move focus on open-link window"
:info-change-focus-message (_ "Focus passed on 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:*open-attach-window*
specials:*tags-window* specials:*tags-window*
specials:*follow-requests-window* specials:*follow-requests-window*
@ -442,6 +453,18 @@ Metadata includes:
specials:*message-window* specials:*message-window*
specials:*send-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 () (defun print-quick-help ()
"Print a quick help" "Print a quick help"
(keybindings:print-help specials:*main-window*)) (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 () (defun gemini-abort-download ()
"Stop a transferring data from a gemini server" "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+))) :priority program-events:+maximum-event-priority+)))
(push-event event))) (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)))