cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-13 07:30:35 +01:00
Code Issues

- [gemini] added a draft for gemlog subscriptions.

Browse Source
This commit is contained in:
cage 2021-01-09 16:27:40 +01:00
parent 9b4d719e4b
commit a0f8c83681
14 changed files with 408 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
etc/default-theme.conf
View File

@ -519,3 +519,9 @@ chats-list-window.input.selected.foreground = black
# actual chat window # actual chat window
chat-window.date-format.value = "[%hour:%min]" chat-window.date-format.value = "[%hour:%min]"
# gemlog subscriptions
gemini-subscription-window.background = black
gemini-subscription-window.foreground = cyan

12
etc/init.lisp
View File

@ -145,6 +145,8 @@
(define-key "M-c" #'open-chats-list-window) (define-key "M-c" #'open-chats-list-window)
(define-key "M-g s" #'gemini-open-gemlog-window)
;; focus ;; focus
(define-key "f1" #'focus-to-tags-window) (define-key "f1" #'focus-to-tags-window)
@ -359,6 +361,16 @@
(define-key "C-J" #'gemini-delete-certificate *gemini-certificates-keymap*) (define-key "C-J" #'gemini-delete-certificate *gemini-certificates-keymap*)
;; gemini subscription window
(define-key "C-J" #'show-gemlog-to-screen *gemlog-subscription-keymap*)
(define-key "up" #'gemlogs-subscription-go-up *gemlog-subscription-keymap*)
(define-key "down" #'gemlogs-subscription-go-down *gemlog-subscription-keymap*)
(define-key "q" #'close-gemlog-window *gemlog-subscription-keymap*)
;; tags keymap ;; tags keymap
(define-key "up" #'tag-go-up *tags-keymap*) (define-key "up" #'tag-go-up *tags-keymap*)

65
src/db.lisp
View File

@ -1751,6 +1751,10 @@ row."
(gen-access-message-row title :title) (gen-access-message-row title :title)
(gen-access-message-row subtitle :subtitle)
(gen-access-message-row url :url)
(gen-access-message-row expire-date :expire-date) (gen-access-message-row expire-date :expire-date)
(gen-access-message-row chat-id :chat-id) (gen-access-message-row chat-id :chat-id)
@ -2872,6 +2876,35 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)'
(row (fetch-single query))) (row (fetch-single query)))
row)) row))
(defun row-unseen-count (row)
(and row
(db-getf row :unseen-count 0)))
(defun row-seen-count (row)
(and row
(db-getf row :seen-count 0)))
(defun gemini-all-subscriptions ()
(when-let* ((query (select (:gemini-subscription.*
(:as (select (fields (:count :url))
(from :gemlog-entries)
(where (:and (:= :gemlog-entries.seenp
(prepare-for-db nil :to-integer t))
(:= :gemlog-entries.gemlog-id
:gemini-subscription.url))))
:unseen-count)
(:as (select (fields (:count :url))
(from :gemlog-entries)
(where (:and (:= :gemlog-entries.seenp
(prepare-for-db t :to-integer t))
(:= :gemlog-entries.gemlog-id
:gemini-subscription.url))))
:seen-count))
(from +table-gemini-subscription+)
(order-by :title)))
(rows (fetch-all-rows query)))
rows))
(defun find-gemlog-entry (post-url) (defun find-gemlog-entry (post-url)
(when-let* ((query (select :* (when-let* ((query (select :*
(from +table-gemlog-entries+) (from +table-gemlog-entries+)
@ -2888,7 +2921,7 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)'
:seenp) :seenp)
(post-url (post-url
gemlog-iri gemlog-iri
post-date (decode-datetime-string post-date)
post-title post-title
(prepare-for-db seenp :to-integer t))))) (prepare-for-db seenp :to-integer t)))))
@ -2909,6 +2942,8 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)'
(gen-access-message-row post-title :post-title) (gen-access-message-row post-title :post-title)
(gen-access-message-row post-link :post-link)
(defun gemlog-entries (gemlog-url &key (unseen-only nil) (seen-only nil)) (defun gemlog-entries (gemlog-url &key (unseen-only nil) (seen-only nil))
(assert (not (and unseen-only (assert (not (and unseen-only
seen-only))) seen-only)))
@ -2917,21 +2952,35 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)'
(:as :gemini-subscription.subtitle :gemlog-subtitle) (:as :gemini-subscription.subtitle :gemlog-subtitle)
(:as :gemlog-entries.date :post-date) (:as :gemlog-entries.date :post-date)
(:as :gemlog-entries.title :post-title) (:as :gemlog-entries.title :post-title)
(:as :gemlog-entries.url :post-link)
(:as :gemlog-entries.seenp :seenp)) (:as :gemlog-entries.seenp :seenp))
(from :gemlog-entries) (from :gemlog-entries)
(join :gemini-subscription (join :gemini-subscription
:on (:= :gemlog-entries.gemlog-id :on (:= :gemlog-entries.gemlog-id
:gemini-subscription.url)) :gemini-subscription.url))
(where (:= :gemini-subscription.url gemlog-url)) (where (:= :gemini-subscription.url gemlog-url))))
(order-by (:desc :gemlog-entries.date)))) (unordered-rows (fetch-all-rows query))
(rows (fetch-all-rows query))) (actual-rows (cond
(cond
(unseen-only (unseen-only
(remove-if-not (lambda (row) (db-nil-p (row-seenp row))) rows)) (remove-if-not (lambda (row) (db-nil-p (row-seenp row)))
unordered-rows))
(seen-only (seen-only
(remove-if (lambda (row) (db-nil-p (row-seenp row))) rows)) (remove-if (lambda (row) (db-nil-p (row-seenp row)))
unordered-rows))
(t (t
rows)))) unordered-rows))))
(num:multisort actual-rows (list (num:gen-multisort-test string>
string<
(lambda (a)
(row-post-date a)))
(num:gen-multisort-test (lambda (a b)
(declare (ignore a))
(db-nil-p b))
(lambda (a b)
(declare (ignore b))
(db-nil-p a))
(lambda (a)
(db-getf a :seenp)))))))
(defun delete-gemlog-entry (gemlog-url) (defun delete-gemlog-entry (gemlog-url)
(query (delete-from +table-gemlog-entries+ (where (:= :url gemlog-url))))) (query (delete-from +table-gemlog-entries+ (where (:= :url gemlog-url)))))

97
src/gemini-subscription-window.lisp Normal file
View File

@ -0,0 +1,97 @@
;; tinmop: an humble gemini and pleroma client
;; Copyright (C) 2021 cage
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program.
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
(in-package :gemini-subscription-window)
(defclass gemini-subscription-window (focus-marked-window
simple-line-navigation-window
title-window
border-window)
())
(defmethod refresh-config :after ((object gemini-subscription-window))
(open-attach-window:refresh-view-links-window-config object
swconf:+key-gemini-subscription-window+)
(refresh-config-sizes object swconf:+key-thread-window+)
(win-move object
(- (win-width *main-window*)
(win-width object))
0)
(win-move object
(- (win-width *main-window*)
(win-width object))
0)
object)
(defun gemlog->text (gemlog-db-row window)
(format nil
"~a ~s ~a/~a"
(tui:text-ellipsis (db:row-title gemlog-db-row)
(truncate (/ (win-width window)
3)))
(when (db:row-subtitle gemlog-db-row)
(tui:text-ellipsis (db:row-subtitle gemlog-db-row)
(truncate (/ (win-width window)
3)))
(_ "No subtitle"))
(db:row-unseen-count gemlog-db-row)
(+ (db:row-unseen-count gemlog-db-row)
(db:row-seen-count gemlog-db-row))))
(defmethod resync-rows-db ((object gemini-subscription-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 (gemlogs bg fg)
(mapcar (lambda (gemlog)
(make-instance 'line
:normal-text (gemlog->text gemlog object)
:selected-text (gemlog->text gemlog object)
:fields gemlog
:normal-bg fg
:normal-fg bg
:selected-bg bg
:selected-fg fg))
gemlogs)))
(with-croatoan-window (croatoan-window object)
(setf rows (make-rows (db:gemini-all-subscriptions)
selected-line-bg
selected-line-fg))
(when suggested-message-index
(select-row object suggested-message-index))
(when redraw
(draw object))))))
(defun open-gemini-subscription-window ()
(let* ((low-level-window (make-croatoan-window :enable-function-keys t)))
(setf *gemini-subscription-window*
(make-instance 'gemini-subscription-window
:top-row-padding 0
:title (_ "Subscribed gemlogs")
:single-row-height 1
:uses-border-p t
:keybindings keybindings:*gemlog-subscription-keymap*
:croatoan-window low-level-window))
(refresh-config *gemini-subscription-window*)
(resync-rows-db *gemini-subscription-window* :redraw nil)
(when (rows *gemini-subscription-window*)
(select-row *gemini-subscription-window* 0))
(draw *gemini-subscription-window*)
*gemini-subscription-window*))

35
src/gemini/gemini-parser.lisp
View File

@ -19,6 +19,41 @@
(defparameter *raw-mode* nil) (defparameter *raw-mode* nil)
(define-constant +h1-prefix+ "#" :test #'string=)
(define-constant +h2-prefix+ "##" :test #'string=)
(define-constant +h3-prefix+ "###" :test #'string=)
(define-constant +list-bullet-prefix+ "* " :test #'string=)
(define-constant +quote-prefix+ ">" :test #'string=)
(define-constant +preformatted-prefix+ "```" :test #'string=)
(define-constant +link-prefix+ "=>" :test #'string=)
(defmacro gen-geminize-line (name prefix)
`(defun ,(format-fn-symbol t "geminize-~a" name) (text)
(strcat ,prefix text)))
(gen-geminize-line h1 +h1-prefix+)
(gen-geminize-line h2 +h2-prefix+)
(gen-geminize-line h3 +h3-prefix+)
(gen-geminize-line list +list-bullet-prefix+)
(gen-geminize-line quote +quote-prefix+)
(gen-geminize-line link +link-prefix+)
(defun make-gemini-link (url title)
(format nil "~a ~a"
(geminize-link url)
title))
(defrule space (or #\Space #\Tab) (defrule space (or #\Space #\Tab)
(:constant nil)) (:constant nil))

7
src/gemini/package.lisp
View File

@ -37,6 +37,13 @@
(:shadowing-import-from :misc :random-elt :shuffle) (:shadowing-import-from :misc :random-elt :shuffle)
(:export (:export
:+gemini-scheme+ :+gemini-scheme+
:geminize-h1
:geminize-h2
:geminize-h3
:geminize-list
:geminize-quote
:geminize-link
:make-gemini-link
:gemini-link :gemini-link
:target :target
:name :name

3
src/gemini/subscription.lisp
View File

@ -46,7 +46,8 @@ A link text entry is like 'aaaa-mm-dd post title'
This function parses the 'aaaa-mm-dd' part. This function parses the 'aaaa-mm-dd' part.
" "
(local-time:parse-timestring link-text :start 0 :end 10 :fail-on-error nil)) (when (>= (length link-text) 10)
(local-time:parse-timestring link-text :start 0 :end 10 :fail-on-error nil)))
(defun link-post-title (link-text) (defun link-post-title (link-text)
"Returns the title of gemlog entry from link text "Returns the title of gemlog entry from link text

3
src/keybindings.lisp
View File

@ -264,6 +264,9 @@ produces a tree and graft the latter on `existing-tree'"
(defparameter *chat-message-keymap* (make-starting-comand-tree) (defparameter *chat-message-keymap* (make-starting-comand-tree)
"The keymap for message-window when shows chat.") "The keymap for message-window when shows chat.")
(defparameter *gemlog-subscription-keymap* (make-starting-comand-tree)
"The keymap for gemlog subscriptions window.")
(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:

39
src/package.lisp
View File

@ -831,6 +831,8 @@
:row-poll-expired-p :row-poll-expired-p
:row-poll-multiple-vote-p :row-poll-multiple-vote-p
:row-title :row-title
:row-subtitle
:row-url
:row-expire-date :row-expire-date
:row-account-id :row-account-id
:row-updated-at :row-updated-at
@ -951,14 +953,18 @@
:find-tls-certificates-rows :find-tls-certificates-rows
:gemini-subscribe-url :gemini-subscribe-url
:gemini-find-subscription :gemini-find-subscription
:gemini-all-subscriptions
:row-seen-count
:row-unseen-count
:find-gemlog-entry :find-gemlog-entry
:add-gemlog-entries :add-gemlog-entries
:gemlog-mark-as-seen :gemlog-mark-as-seen
:gemlog-url :gemlog-url
:gemlog-title :gemlog-title
:gemlog-subtitle :gemlog-subtitle
:post-date :row-post-date
:post-title :row-post-title
:row-post-link
:gemlog-entries :gemlog-entries
:delete-gemlog-entry)) :delete-gemlog-entry))
@ -1022,6 +1028,7 @@
:+key-message-window+ :+key-message-window+
:+key-chat-window+ :+key-chat-window+
:+key-chats-list-window+ :+key-chats-list-window+
:+key-gemini-subscription-window+
:+key-favourite+ :+key-favourite+
:+key-sensitive+ :+key-sensitive+
:+key-boosted+ :+key-boosted+
@ -1216,6 +1223,7 @@
:*open-message-link-window* :*open-message-link-window*
:*gemini-streams-window* :*gemini-streams-window*
:*gemini-certificates-window* :*gemini-certificates-window*
:*gemini-subscription-window*
:*chats-list-window*)) :*chats-list-window*))
(defpackage :complete (defpackage :complete
@ -1340,6 +1348,7 @@
:gemini-compact-lines-event :gemini-compact-lines-event
:gemini-enqueue-download-event :gemini-enqueue-download-event
:gemini-gemlog-subscribe-event :gemini-gemlog-subscribe-event
:gemlog-show-event
:get-chat-messages-event :get-chat-messages-event
:get-chats-event :get-chats-event
:chat-show-event :chat-show-event
@ -1500,6 +1509,7 @@
:*gemini-certificates-keymap* :*gemini-certificates-keymap*
:*chats-list-keymap* :*chats-list-keymap*
:*chat-message-keymap* :*chat-message-keymap*
:*gemlog-subscription-keymap*
:define-key :define-key
:init-keyboard-mapping :init-keyboard-mapping
:find-keymap-node :find-keymap-node
@ -1957,6 +1967,26 @@
(:export (:export
:open-gemini-certificates-window)) :open-gemini-certificates-window))
(defpackage :gemini-subscription-window
(:use
:cl
:alexandria
:cl-ppcre
:access
:croatoan
:config
:constants
:text-utils
:misc
:mtree
:specials
:windows
:line-oriented-window
:tui-utils)
(:shadowing-import-from :misc :random-elt :shuffle)
(:export
:open-gemini-subscription-window))
(defpackage :command-window (defpackage :command-window
(:use (:use
:cl :cl
@ -2353,6 +2383,11 @@
:gemini-streams-window-open-stream :gemini-streams-window-open-stream
:gemini-refresh-page :gemini-refresh-page
:gemini-subscribe-gemlog :gemini-subscribe-gemlog
:gemini-open-gemlog-window
:gemlogs-subscription-go-up
:gemlogs-subscription-go-down
:close-gemlog-window
:show-gemlog-to-screen
:send-to-pipe :send-to-pipe
:send-message-to-pipe)) :send-message-to-pipe))

60
src/program-events.lisp
View File

@ -1143,7 +1143,7 @@
(defmethod process-event ((object gemini-gemlog-subscribe-event)) (defmethod process-event ((object gemini-gemlog-subscribe-event))
(with-accessors ((url payload)) object (with-accessors ((url payload)) object
(let ((subscribedp (gemini-subscription:subscribe url))) (let ((subscribedp (gemini-subscription:subscribe url)))
(when (not subscribedp) (if subscribedp
(gemini-subscription:refresh url) (gemini-subscription:refresh url)
(ui:notify (format nil (ui:notify (format nil
(_ "Unable to subscribe to ~s") (_ "Unable to subscribe to ~s")
@ -1151,6 +1151,64 @@
:as-error t))))) :as-error t)))))
(defclass gemlog-show-event (program-event)
((title
:initarg :title
:accessor title)
(subtitle
:initarg :subtitle
:accessor subtitle)
(gemlog-url
:initarg :gemlog-url
:accessor gemlog-url)
(entries
:initarg :entries
:accessor entries)))
(defmethod process-event ((object gemlog-show-event))
(with-accessors ((title title)
(subtitle subtitle)
(entries entries)
(gemlog-url gemlog-url)) object
(let* ((gemini-page (with-output-to-string (stream)
(format stream
"~a~2%"
(gemini-parser:geminize-h1 title))
(if subtitle
(format stream
"~a~2%"
(gemini-parser:geminize-h2 subtitle))
(format stream
"~a~2%"
(gemini-parser:geminize-h2 (_ "No subtitle"))))
(loop for entry in entries do
(let* ((link (db:row-post-link entry))
(date-format (swconf:date-fmt swconf:+key-message-window+))
(date (db:row-post-date entry))
(encoded-date (db-utils:encode-datetime-string date))
(title (text-utils:strcat (format-time encoded-date date-format)
" "
(db:row-post-title entry))))
(format stream
"~a~%"
(gemini-parser:make-gemini-link link
title))))))
(url (iri:iri-parse gemlog-url))
(parsed (gemini-parser:parse-gemini-file gemini-page))
(links (gemini-parser:sexp->links parsed
(uri:host url)
(uri:port url)
(uri:path url)))
(theme gemini-client::*gemini-page-theme*))
(gemini-viewer::maybe-initialize-metadata specials:*message-window*)
(refresh-gemini-message-window links
gemini-page
(gemini-parser:sexp->text parsed theme)
nil)
(setf (windows:keybindings specials:*message-window*)
keybindings:*gemini-message-keymap*)
(windows:draw specials:*message-window*))))
;;;; pleroma ;;;; pleroma
(defclass get-chat-messages-event (program-event) (defclass get-chat-messages-event (program-event)

1
src/software-configuration.lisp
View File

@ -367,6 +367,7 @@
message-window message-window
chat-window chat-window
chats-list-window chats-list-window
gemini-subscription-window
attachment-header attachment-header
max-numbers-allowed-attachments max-numbers-allowed-attachments
max-message-length max-message-length

3
src/specials.lisp
View File

@ -58,5 +58,8 @@
(defparameter *gemini-certificates-window* nil (defparameter *gemini-certificates-window* nil
"The window that shows all gemini client certificates.") "The window that shows all gemini client certificates.")
(defparameter *gemini-subscription-window* nil
"The window that shows all the subscribed gemlogs.")
(defparameter *chats-list-window* nil (defparameter *chats-list-window* nil
"The window that shows all the chats.") "The window that shows all the chats.")

79
src/ui-goodies.lisp
View File

@ -388,6 +388,8 @@ Metadata includes:
(if print-message (if print-message
(_ "focus passed on threads window") (_ "focus passed on threads window")
nil) nil)
*gemini-subscription-window*
*gemini-certificates-window*
*chats-list-window* *chats-list-window*
*gemini-streams-window* *gemini-streams-window*
*open-message-link-window* *open-message-link-window*
@ -404,7 +406,8 @@ Metadata includes:
*message-window* *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 (*gemini-certificates-window* :windows-lose-focus (*gemini-subscription-window*
*gemini-certificates-window*
*chats-list-window* *chats-list-window*
*gemini-streams-window* *gemini-streams-window*
*open-message-link-window* *open-message-link-window*
@ -419,7 +422,8 @@ Metadata includes:
*send-message-window* *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 (*gemini-certificates-window* :windows-lose-focus (*gemini-subscription-window*
*gemini-certificates-window*
*chats-list-window* *chats-list-window*
*gemini-streams-window* *gemini-streams-window*
*open-message-link-window* *open-message-link-window*
@ -434,7 +438,8 @@ Metadata includes:
*follow-requests-window* *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 (*gemini-certificates-window* :windows-lose-focus (*gemini-subscription-window*
*gemini-certificates-window*
*chats-list-window* *chats-list-window*
*gemini-streams-window* *gemini-streams-window*
*open-message-link-window* *open-message-link-window*
@ -449,7 +454,8 @@ Metadata includes:
*tags-window* *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 (*gemini-certificates-window* :windows-lose-focus (*gemini-subscription-window*
*gemini-certificates-window*
*chats-list-window* *chats-list-window*
*gemini-streams-window* *gemini-streams-window*
*open-message-link-window* *open-message-link-window*
@ -463,7 +469,8 @@ Metadata includes:
*conversations-window* *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 (*gemini-certificates-window* :windows-lose-focus (*gemini-subscription-window*
*gemini-certificates-window*
*chats-list-window* *chats-list-window*
*gemini-streams-window* *gemini-streams-window*
*open-message-link-window* *open-message-link-window*
@ -478,7 +485,8 @@ Metadata includes:
*open-attach-window* *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 (*gemini-certificates-window* :windows-lose-focus (*gemini-subscription-window*
*gemini-certificates-window*
*chats-list-window* *chats-list-window*
*gemini-streams-window* *gemini-streams-window*
*open-message-link-window* *open-message-link-window*
@ -493,7 +501,8 @@ Metadata includes:
*open-message-link-window* *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 (*gemini-certificates-window* :windows-lose-focus (*gemini-subscription-window*
*gemini-certificates-window*
*chats-list-window* *chats-list-window*
*gemini-streams-window* *gemini-streams-window*
*conversations-window* *conversations-window*
@ -508,7 +517,8 @@ Metadata includes:
*gemini-streams-window* *gemini-streams-window*
:documentation "Move focus on open gemini streams window" :documentation "Move focus on open gemini streams window"
:info-change-focus-message (_ "Focus passed on gemini-stream window") :info-change-focus-message (_ "Focus passed on gemini-stream window")
:windows-lose-focus (*gemini-certificates-window* :windows-lose-focus (*gemini-subscription-window*
*gemini-certificates-window*
*chats-list-window* *chats-list-window*
*open-message-link-window* *open-message-link-window*
*conversations-window* *conversations-window*
@ -523,7 +533,8 @@ Metadata includes:
*chats-list-window* *chats-list-window*
:documentation "Move focus on chats list window" :documentation "Move focus on chats list window"
:info-change-focus-message (_ "Focus passed on chats list window") :info-change-focus-message (_ "Focus passed on chats list window")
:windows-lose-focus (*gemini-certificates-window* :windows-lose-focus (*gemini-subscription-window*
*gemini-certificates-window*
*gemini-streams-window* *gemini-streams-window*
*open-message-link-window* *open-message-link-window*
*conversations-window* *conversations-window*
@ -538,7 +549,23 @@ Metadata includes:
*gemini-certificates-window* *gemini-certificates-window*
:documentation "Move focus on open-gemini certificates window" :documentation "Move focus on open-gemini certificates window"
:info-change-focus-message (_ "Focus passed on TLS certificates window.") :info-change-focus-message (_ "Focus passed on TLS certificates window.")
:windows-lose-focus (*chats-list-window* :windows-lose-focus (*gemini-subscription-window*
*chats-list-window*
*gemini-streams-window*
*conversations-window*
*open-attach-window*
*tags-window*
*follow-requests-window*
*thread-window*
*message-window*
*send-message-window*))
(gen-focus-to-window open-gemini-subscription-window
*gemini-subscription-window*
:documentation "Move focus on open-gemini certificates window"
:info-change-focus-message (_ "Focus passed on TLS certificates window.")
:windows-lose-focus (*gemini-certificates-window*
*chats-list-window*
*gemini-streams-window* *gemini-streams-window*
*conversations-window* *conversations-window*
*open-attach-window* *open-attach-window*
@ -1208,6 +1235,26 @@ certificate).
:prompt (_ "Delete this certificate? [Y/n] ") :prompt (_ "Delete this certificate? [Y/n] ")
:complete-fn #'complete:complete-always-empty))) :complete-fn #'complete:complete-always-empty)))
(defun gemini-open-gemlog-window ()
"Open a window with all the gemlog subscribed."
(gemini-subscription-window:open-gemini-subscription-window)
(focus-to-open-gemini-subscription-window))
(defun close-gemlog-window ()
(close-window-and-return-to-threads *gemini-subscription-window*))
(defun show-gemlog-to-screen ()
(when-let* ((fields (line-oriented-window:selected-row-fields *gemini-subscription-window*))
(gemlog-id (db:row-url fields))
(entries (db:gemlog-entries gemlog-id))
(event (make-instance 'program-events:gemlog-show-event
:gemlog-url gemlog-id
:title (db:row-title fields)
:subtitle (db:row-subtitle fields)
:entries entries)))
(program-events:push-event event)
(focus-to-message-window)))
(defun prompt-for-username (prompt complete-function event (defun prompt-for-username (prompt complete-function event
notify-starting-message notify-starting-message
notify-ending-message) notify-ending-message)
@ -1783,6 +1830,18 @@ mot recent updated to least recent"
(push-event event-abort) (push-event event-abort)
(push-event event-open))) (push-event event-open)))
(defun gemlogs-subscription-move (amount)
(ignore-errors
(line-oriented-window:unselect-all *gemini-subscription-window*)
(line-oriented-window:row-move *gemini-subscription-window* amount)
(draw *gemini-subscription-window*)))
(defun gemlogs-subscription-go-down ()
(follow-request-move 1))
(defun gemlogs-subscription-go-up ()
(follow-request-move -1))
(defun gemini-subscribe-gemlog () (defun gemini-subscribe-gemlog ()
"Subscribe to the gemlog shown in the main window. "Subscribe to the gemlog shown in the main window.

1
tinmop.asd
View File

@ -114,6 +114,7 @@
(:file "open-attach-window") (:file "open-attach-window")
(:file "open-message-link-window") (:file "open-message-link-window")
(:file "gemini-client-certificates-window") (:file "gemini-client-certificates-window")
(:file "gemini-subscription-window")
(:file "command-window") (:file "command-window")
(:file "sending-message") (:file "sending-message")
(:file "follow-requests") (:file "follow-requests")