diff --git a/etc/default-theme.conf b/etc/default-theme.conf index 8ca7cd8..6c7675b 100644 --- a/etc/default-theme.conf +++ b/etc/default-theme.conf @@ -20,106 +20,106 @@ # - blink # 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 -window.title.right.stopper.value = "▐╾" +window.title.right.stopper.value = "▐╾" # default background color of terminal -main-window.background = black +main-window.background = black # default foreground color (text) of terminal -main-window.foreground = white +main-window.foreground = white # 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 -password-echo-character = "•" +password-echo-character = "•" # the character used to draw the vote's horizontal histogram # note: keeps it one character wide -vote-vertical-bar = "⯀" +vote-vertical-bar = "⯀" # 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.background = white +help-dialog.background = white -help-dialog.foreground = red +help-dialog.foreground = red # info dialog style -info-dialog.background = blue +info-dialog.background = blue -info-dialog.foreground = yellow +info-dialog.foreground = yellow # error dialog style -error-dialog.background = red +error-dialog.background = red -error-dialog.foreground = yellow +error-dialog.foreground = yellow # 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 -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 -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 -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 # 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 -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 # thread window that shows some information about the threads see # 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 # 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) # - %% 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 # 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 -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 -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 -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 -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 -thread-window.message.favourite.value = "★" +thread-window.message.favourite.value = "★" # 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 -thread-window.message.sensitive.value = "⚠" +thread-window.message.sensitive.value = "⚠" # 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 -thread-window.message.boosted.value = "♻" +thread-window.message.boosted.value = "♻" # 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 # 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) # of the thread -thread-window.message.root.foreground = blue +thread-window.message.root.foreground = blue # the messages are organized in trees # 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 -thread-window.tree.arrow.foreground = magenta +thread-window.tree.arrow.foreground = magenta # color of the subject of the message (AKA sensistive text) for a # message -thread-window.tree.data.foreground = white +thread-window.tree.data.foreground = white # color of the subject of the message (AKA sensistive text) for # 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 # message with no parents -thread-window.tree.root.foreground = yellow +thread-window.tree.root.foreground = yellow # 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 -thread-window.tree.leaf.value = "╰" +thread-window.tree.leaf.value = "╰" # 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 -thread-window.tree.spacer.value = "─" +thread-window.tree.spacer.value = "─" # 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: # values starting with '%' will be expanded, allowed values are: @@ -264,145 +264,145 @@ thread-window.tree.vertical-line.value = "│" # - %short-month Jan to Dec # - %% 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 -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 -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 # this information) for number of messages posted every day that # contains this tag -tags-window.histogram.foreground = yellow +tags-window.histogram.foreground = yellow # 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 # 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 -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 -#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 -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 -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 -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 -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 # screen that user uses to give command to the program, also is used # 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 -command-window.command-separator.value = " → " +command-window.command-separator.value = " → " # 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 -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 -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 -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 # message is visualized in repect of the message lines length (similar # 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 -message-window.line-position-mark.value = "⧫" +message-window.line-position-mark.value = "⧫" # the date format for message # values starting with '%' will be expanded, allowed values are: @@ -419,57 +419,69 @@ message-window.line-position-mark.value = "⧫" # - %short-month Jan to Dec # - %% 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 # 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 -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 -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 -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 -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.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 diff --git a/etc/init.lisp b/etc/init.lisp index d818150..290a058 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -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 diff --git a/etc/shared.conf b/etc/shared.conf index f9caa95..e8bbb0d 100644 --- a/etc/shared.conf +++ b/etc/shared.conf @@ -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" diff --git a/src/gemini-viewer-metadata.lisp b/src/gemini-viewer-metadata.lisp index 07356c9..a4e833a 100644 --- a/src/gemini-viewer-metadata.lisp +++ b/src/gemini-viewer-metadata.lisp @@ -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)) diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp index baf8709..3cb2e40 100644 --- a/src/gemini-viewer.lisp +++ b/src/gemini-viewer.lisp @@ -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,25 +280,16 @@ :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 for line-as-array = (read-line-into-array download-stream) 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))) + (let* ((line (babel:octets-to-string line-as-array :errorp nil)) + (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,19 +420,21 @@ 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 - :download-stream response - :download-socket socket)) + (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 (request-stream-other-document-thread gemini-stream socket @@ -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*)) diff --git a/src/keybindings.lisp b/src/keybindings.lisp index e15cb67..71e845c 100644 --- a/src/keybindings.lisp +++ b/src/keybindings.lisp @@ -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: diff --git a/src/package.lisp b/src/package.lisp index f3d0d4b..69f7785 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/program-events.lisp b/src/program-events.lisp index dfe7f9a..67cc494 100644 --- a/src/program-events.lisp +++ b/src/program-events.lisp @@ -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) ()) diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index bf0e110..d6ad893 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -378,6 +378,7 @@ suggestions-window open-attach-window open-message-link-window + open-gemini-stream-window command-window command-separator gemini diff --git a/src/specials.lisp b/src/specials.lisp index e6649b9..c2c2016 100644 --- a/src/specials.lisp +++ b/src/specials.lisp @@ -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.") diff --git a/src/tui-utils.lisp b/src/tui-utils.lisp index e56b666..4fefc70 100644 --- a/src/tui-utils.lisp +++ b/src/tui-utils.lisp @@ -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 diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index a2287b1..31f8069 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -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 - :priority program-events:+maximum-event-priority+))) + (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)))