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

280
etc/default-theme.conf
View File

@ -20,106 +20,106 @@
# - blink # - blink
# The text that starts the title section of a window # The text that starts the title section of a window
window.title.left.stopper.value = "╼▌" window.title.left.stopper.value = "╼▌"
# The text taht end the title section of a window # The text taht end the title section of a window
window.title.right.stopper.value = "▐╾" window.title.right.stopper.value = "▐╾"
# default background color of terminal # default background color of terminal
main-window.background = black main-window.background = black
# default foreground color (text) of terminal # default foreground color (text) of terminal
main-window.foreground = white main-window.foreground = white
# shown when a message was trasmitted in crypted form # shown when a message was trasmitted in crypted form
crypted.mark.value = " 🔏👌" crypted.mark.value = " 🔏👌"
# the string to be drawn instead of actual character when input password # the string to be drawn instead of actual character when input password
password-echo-character = "•" password-echo-character = "•"
# the character used to draw the vote's horizontal histogram # the character used to draw the vote's horizontal histogram
# note: keeps it one character wide # note: keeps it one character wide
vote-vertical-bar = "⯀" vote-vertical-bar = "⯀"
# quick help window style # quick help window style
quick-help.header.foreground = white quick-help.header.foreground = white
quick-help.header.background = red quick-help.header.background = red
quick-help.header.attribute = bold quick-help.header.attribute = bold
# help dialog style # help dialog style
help-dialog.background = white help-dialog.background = white
help-dialog.foreground = red help-dialog.foreground = red
# info dialog style # info dialog style
info-dialog.background = blue info-dialog.background = blue
info-dialog.foreground = yellow info-dialog.foreground = yellow
# error dialog style # error dialog style
error-dialog.background = red error-dialog.background = red
error-dialog.foreground = yellow error-dialog.foreground = yellow
# input dialog style # input dialog style
input-dialog.background = blue input-dialog.background = blue
input-dialog.foreground = white input-dialog.foreground = white
# this color specifies the style for form of the dialog # this color specifies the style for form of the dialog
input-dialog.input.foreground = black input-dialog.input.foreground = black
input-dialog.input.background = #aaaaaa input-dialog.input.background = #aaaaaa
# this color specify the style for active form of the dialog # this color specify the style for active form of the dialog
input-dialog.input.selected.foreground = black input-dialog.input.selected.foreground = black
input-dialog.input.selected.background = white input-dialog.input.selected.background = white
# the notify window shows useful information to the user # the notify window shows useful information to the user
notify-window.background = #0219A2 notify-window.background = #0219A2
notify-window.foreground = #55D67C notify-window.foreground = #55D67C
notify-window.life = 2 notify-window.life = 2
# a window shows this text in the top left corner to indicate that it # a window shows this text in the top left corner to indicate that it
# has focus # has focus
window.focus.mark.value = "📌" window.focus.mark.value = "📌"
window.focus.mark.foreground = white window.focus.mark.foreground = white
window.focus.mark.background = black window.focus.mark.background = black
# this specify style for the thread window # this specify style for the thread window
thread-window.background = black thread-window.background = black
thread-window.foreground = blue thread-window.foreground = blue
# the modeline window is a small section on the very bottom of the # the modeline window is a small section on the very bottom of the
# thread window that shows some information about the threads see # thread window that shows some information about the threads see
# below. # below.
thread-window.modeline.background = blue thread-window.modeline.background = blue
thread-window.modeline.foreground = yellow thread-window.modeline.foreground = yellow
# this variable customize the information that the modeline will # this variable customize the information that the modeline will
# shows, values prefixed with a '%' will be expanded, allowe values to # shows, values prefixed with a '%' will be expanded, allowe values to
@ -134,120 +134,120 @@ thread-window.modeline.foreground = yellow
# - %tags in selected messages (if any) # - %tags in selected messages (if any)
# - %% a percent sign # - %% a percent sign
thread-window.modeline.value = "%u@%s ◈ %k %r/%t ◈ folder: %f ◈ tags: %h" thread-window.modeline.value = "%u@%s ◈ %k %r/%t ◈ folder: %f ◈ tags: %h"
# this is the only width you have to specify as the others windows # this is the only width you have to specify as the others windows
# just fills the void left by this one # just fills the void left by this one
thread-window.width = 5/6 thread-window.width = 5/6
thread-window.height = 1/4 thread-window.height = 1/4
# colors for selected messages in thread window # colors for selected messages in thread window
thread-window.message.selected.background = cyan thread-window.message.selected.background = cyan
thread-window.message.selected.foreground = black thread-window.message.selected.foreground = black
#thread-window.message.selected.attribute = bold #thread-window.message.selected.attribute = bold
# colors for messages marked for deletion in thread window # colors for messages marked for deletion in thread window
thread-window.message.deleted.background = red thread-window.message.deleted.background = red
thread-window.message.deleted.foreground = white thread-window.message.deleted.foreground = white
thread-window.message.deleted.attribute = bold thread-window.message.deleted.attribute = bold
# colors for already read messages in thread window # colors for already read messages in thread window
thread-window.message.read.background = black thread-window.message.read.background = black
thread-window.message.read.foreground = #aaaaaa thread-window.message.read.foreground = #aaaaaa
thread-window.message.read.attribute = italic thread-window.message.read.attribute = italic
# colors for new (not read) messages in thread window # colors for new (not read) messages in thread window
thread-window.message.unread.background = black thread-window.message.unread.background = black
thread-window.message.unread.foreground = cyan thread-window.message.unread.foreground = cyan
#thread-window.message.unread.attribute = bold #thread-window.message.unread.attribute = bold
# text to signal that you favourited this message # text to signal that you favourited this message
thread-window.message.favourite.value = "★" thread-window.message.favourite.value = "★"
# color of the text that signals that you favourited this message # color of the text that signals that you favourited this message
thread-window.message.favourite.foreground = yellow thread-window.message.favourite.foreground = yellow
# text to signal that this message is marked as sensible # text to signal that this message is marked as sensible
thread-window.message.sensitive.value = "⚠" thread-window.message.sensitive.value = "⚠"
# color of the text that signals that this message is marked as sensible # color of the text that signals that this message is marked as sensible
thread-window.message.sensitive.foreground = blue thread-window.message.sensitive.foreground = blue
# text that signals that you boosted this message # text that signals that you boosted this message
thread-window.message.boosted.value = "♻" thread-window.message.boosted.value = "♻"
# color of the text that signals that you boosted this message # color of the text that signals that you boosted this message
thread-window.message.boosted.foreground = cyan thread-window.message.boosted.foreground = cyan
# text to signal that this message is the root (on the server) of the # text to signal that this message is the root (on the server) of the
# thread # thread
thread-window.message.root.value = "↓ " thread-window.message.root.value = "↓ "
# color of the text that signals that this message is the root (on the server) # color of the text that signals that this message is the root (on the server)
# of the thread # of the thread
thread-window.message.root.foreground = blue thread-window.message.root.foreground = blue
# the messages are organized in trees # the messages are organized in trees
# color of the branch of the tree (the segments that connect messages) # color of the branch of the tree (the segments that connect messages)
thread-window.tree.branch.foreground = red thread-window.tree.branch.foreground = red
# color of the arrow in the tree that points to a single message # color of the arrow in the tree that points to a single message
thread-window.tree.arrow.foreground = magenta thread-window.tree.arrow.foreground = magenta
# color of the subject of the message (AKA sensistive text) for a # color of the subject of the message (AKA sensistive text) for a
# message # message
thread-window.tree.data.foreground = white thread-window.tree.data.foreground = white
# color of the subject of the message (AKA sensistive text) for # color of the subject of the message (AKA sensistive text) for
# message with no replies # message with no replies
thread-window.tree.data-leaf.foreground = white thread-window.tree.data-leaf.foreground = white
# color of the subject of the message (AKA sensistive text) for # color of the subject of the message (AKA sensistive text) for
# message with no parents # message with no parents
thread-window.tree.root.foreground = yellow thread-window.tree.root.foreground = yellow
# arrow that point to a message # arrow that point to a message
thread-window.tree.arrow.value = "🞂 " thread-window.tree.arrow.value = "🞂 "
# segment that connect a message with no replies to the tree # segment that connect a message with no replies to the tree
thread-window.tree.leaf.value = "╰" thread-window.tree.leaf.value = "╰"
# segment that connect a message with replies to the tree # segment that connect a message with replies to the tree
thread-window.tree.branch.value = "├" thread-window.tree.branch.value = "├"
# segment that push to the left a message subject # segment that push to the left a message subject
thread-window.tree.spacer.value = "─" thread-window.tree.spacer.value = "─"
# vertical segment that connect tree branches # vertical segment that connect tree branches
thread-window.tree.vertical-line.value = "│" thread-window.tree.vertical-line.value = "│"
# a message shows the composition date, specify the format: # a message shows the composition date, specify the format:
# values starting with '%' will be expanded, allowed values are: # values starting with '%' will be expanded, allowed values are:
@ -264,145 +264,145 @@ thread-window.tree.vertical-line.value = "│"
# - %short-month Jan to Dec # - %short-month Jan to Dec
# - %% a percent sign # - %% a percent sign
thread-window.date-format.value = "%year %short-month %day %hour:%min" thread-window.date-format.value = "%year %short-month %day %hour:%min"
# the windows that shows tags subscriptions # the windows that shows tags subscriptions
tags-window.height = 1/2 tags-window.height = 1/2
tags-window.background = black tags-window.background = black
tags-window.foreground = #67998B tags-window.foreground = #67998B
# the colors for currently selected tags # the colors for currently selected tags
tags-window.input.selected.background = black tags-window.input.selected.background = black
tags-window.input.selected.foreground = #71AF8C tags-window.input.selected.foreground = #71AF8C
# tags shows a little histogram (note that some servers do not provide # tags shows a little histogram (note that some servers do not provide
# this information) for number of messages posted every day that # this information) for number of messages posted every day that
# contains this tag # contains this tag
tags-window.histogram.foreground = yellow tags-window.histogram.foreground = yellow
# test to indicate that this tags got new messages # test to indicate that this tags got new messages
tags-window.new-message.mark.value = " 📬" tags-window.new-message.mark.value = " 📬"
# this is the window that shows active conversation (a conversation is # this is the window that shows active conversation (a conversation is
# active until the user chooses to ignore it) # active until the user chooses to ignore it)
conversations-window.background = black conversations-window.background = black
conversations-window.foreground = #B48B21 conversations-window.foreground = #B48B21
# the colors for currently selected conversation # the colors for currently selected conversation
conversations-window.input.selected.background = #4B0301 conversations-window.input.selected.background = #4B0301
conversations-window.input.selected.foreground = #B27DE5 conversations-window.input.selected.foreground = #B27DE5
#colors for count of read messages for conversation #colors for count of read messages for conversation
#conversations-window.read.background = black #conversations-window.read.background = black
#conversations-window.read.foreground = blue #conversations-window.read.foreground = blue
#colors for count of unreaded messages for conversation #colors for count of unreaded messages for conversation
conversations-window.unread.background = black conversations-window.unread.background = black
conversations-window.unread.foreground = red conversations-window.unread.foreground = red
# this is the message that shows available keybindings # this is the message that shows available keybindings
keybindings-window.background = black keybindings-window.background = black
keybindings-window.foreground = #E2BE6F keybindings-window.foreground = #E2BE6F
keybindings-window.height = 1/2 keybindings-window.height = 1/2
# see configuration for tree in thread window above # see configuration for tree in thread window above
keybindings-window.tree.branch.foreground = red keybindings-window.tree.branch.foreground = red
keybindings-window.tree.arrow.foreground = magenta keybindings-window.tree.arrow.foreground = magenta
keybindings-window.tree.root.foreground = #ffff00 keybindings-window.tree.root.foreground = #ffff00
keybindings-window.tree.data.foreground = white keybindings-window.tree.data.foreground = white
keybindings-window.tree.data-leaf.foreground = cyan keybindings-window.tree.data-leaf.foreground = cyan
keybindings-window.tree.arrow.value = "🞂 " keybindings-window.tree.arrow.value = "🞂 "
keybindings-window.tree.leaf.value = "╰" keybindings-window.tree.leaf.value = "╰"
keybindings-window.tree.branch.value = "├" keybindings-window.tree.branch.value = "├"
keybindings-window.tree.spacer.value = "─" keybindings-window.tree.spacer.value = "─"
keybindings-window.tree.vertical-line.value = "│" keybindings-window.tree.vertical-line.value = "│"
# autocomplete window # autocomplete window
suggestions-window.background = blue suggestions-window.background = blue
suggestions-window.foreground = yellow suggestions-window.foreground = yellow
suggestions-window.height = 1/4 suggestions-window.height = 1/4
# the directive belows configure the window at the very bottom of the # the directive belows configure the window at the very bottom of the
# screen that user uses to give command to the program, also is used # screen that user uses to give command to the program, also is used
# to shows some input errors or other informations # to shows some input errors or other informations
command-window.background = black command-window.background = black
command-window.foreground = white command-window.foreground = white
# text to separate keybindig added so far by the user # text to separate keybindig added so far by the user
command-window.command-separator.value = " → " command-window.command-separator.value = " → "
# colors of the separator above # colors of the separator above
command-window.command-separator.foreground = yellow command-window.command-separator.foreground = yellow
command-window.command-separator.background = black command-window.command-separator.background = black
# color for error message shown in command window # color for error message shown in command window
command-window.error.message.background = black command-window.error.message.background = black
command-window.error.message.foreground = red command-window.error.message.foreground = red
command-window.error.message.attribute = bold command-window.error.message.attribute = bold
# color for info message shown in command window # color for info message shown in command window
command-window.info.message.foreground = yellow command-window.info.message.foreground = yellow
command-window.info.message.background = black command-window.info.message.background = black
command-window.info.message.attribute = bold command-window.info.message.attribute = bold
# this is the window that show the content of a message # this is the window that show the content of a message
message-window.background = black message-window.background = black
message-window.foreground = #c9c0c0 message-window.foreground = #c9c0c0
# a marker on the right side of the window to show the position of the # a marker on the right side of the window to show the position of the
# message is visualized in repect of the message lines length (similar # message is visualized in repect of the message lines length (similar
# to scrollbar in GUI) # to scrollbar in GUI)
message-window.line-position-mark.foreground = white message-window.line-position-mark.foreground = white
message-window.line-position-mark.background = black message-window.line-position-mark.background = black
# the text for the marker above # the text for the marker above
message-window.line-position-mark.value = "⧫" message-window.line-position-mark.value = "⧫"
# the date format for message # the date format for message
# values starting with '%' will be expanded, allowed values are: # values starting with '%' will be expanded, allowed values are:
@ -419,57 +419,69 @@ message-window.line-position-mark.value = "⧫"
# - %short-month Jan to Dec # - %short-month Jan to Dec
# - %% a percent sign # - %% a percent sign
message-window.date-format.value = "%year %short-month %day %hour:%min" message-window.date-format.value = "%year %short-month %day %hour:%min"
message-window.attachment-header.prefix.value = "~%──── " message-window.attachment-header.prefix.value = "~%──── "
message-window.attachment-header.postfix.value = " ────~%" message-window.attachment-header.postfix.value = " ────~%"
message-window.account.locked.mark.value = " 🔒" message-window.account.locked.mark.value = " 🔒"
message-window.account.unlocked.mark.value = " 🔓" message-window.account.unlocked.mark.value = " 🔓"
# the string for the header of attachments in a message, if not # the string for the header of attachments in a message, if not
# specified a default is chosen by the software. # specified a default is chosen by the software.
#message-window.attachment-header.value = " attachment " #message-window.attachment-header.value = " attachment "
# this is the window that allow to browse the attachments of a message # this is the window that allow to browse the attachments of a message
open-attach-window.background = black open-attach-window.background = black
open-attach-window.foreground = #67998B open-attach-window.foreground = #67998B
# the colors of selected attachment # the colors of selected attachment
open-attach-window.input.selected.background = black open-attach-window.input.selected.background = black
open-attach-window.input.selected.foreground = #71AF8C open-attach-window.input.selected.foreground = #71AF8C
# this is the window that allow to browse the links of a message # this is the window that allow to browse the links of a message
open-message-link-window.background = black open-message-link-window.background = black
open-message-link-window.foreground = #FEB200 open-message-link-window.foreground = #FEB200
# the colors of selected link # the colors of selected link
open-message-link-window.input.selected.background = black open-message-link-window.input.selected.background = black
open-message-link-window.input.selected.foreground = #FFB200 open-message-link-window.input.selected.foreground = #FFB200
# gemini browser # gemini browser
gemini.link.scheme.gemini.prefix = "→ " gemini.link.scheme.gemini.prefix = "→ "
gemini.link.scheme.other.prefix = "➶ " gemini.link.scheme.other.prefix = "➶ "
gemini.quote.prefix = "🞂 " gemini.quote.prefix = "🞂 "
gemini.bullet.prefix = "• " gemini.bullet.prefix = "• "
gemini.h1.prefix = "🞓 " 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))

289
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,25 +280,16 @@
: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
for line-as-array = (read-line-into-array download-stream) for line-as-array = (read-line-into-array download-stream)
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,19 +420,21 @@
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))
:download-stream response (gemini-stream (make-instance 'gemini-others-data-stream
:download-socket socket)) :stream-status starting-status
:download-stream response
:download-socket socket))
(thread-fn (thread-fn
(request-stream-other-document-thread gemini-stream (request-stream-other-document-thread gemini-stream
socket socket
@ -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

81
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*))
:priority program-events:+maximum-event-priority+))) (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))) (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)))