From a0f8c83681086e122d79dc83fcf0ea97b2c3864e Mon Sep 17 00:00:00 2001
From: cage <cage-invalid@invalid>
Date: Sat, 9 Jan 2021 16:27:40 +0100
Subject: [PATCH] - [gemini] added a draft for gemlog subscriptions.
---
etc/default-theme.conf | 8 ++-
etc/init.lisp | 12 ++++
src/db.lisp | 91 ++++++++++++++++++++-------
src/gemini-subscription-window.lisp | 97 +++++++++++++++++++++++++++++
src/gemini/gemini-parser.lisp | 35 +++++++++++
src/gemini/package.lisp | 7 +++
src/gemini/subscription.lisp | 3 +-
src/keybindings.lisp | 3 +
src/package.lisp | 39 +++++++++++-
src/program-events.lisp | 70 +++++++++++++++++++--
src/software-configuration.lisp | 1 +
src/specials.lisp | 3 +
src/ui-goodies.lisp | 79 ++++++++++++++++++++---
tinmop.asd | 1 +
14 files changed, 408 insertions(+), 41 deletions(-)
create mode 100644 src/gemini-subscription-window.lisp
diff --git a/etc/default-theme.conf b/etc/default-theme.conf
index cca399f..d17140f 100644
--- a/etc/default-theme.conf
+++ b/etc/default-theme.conf
@@ -518,4 +518,10 @@ chats-list-window.input.selected.foreground = black
# actual chat window
-chat-window.date-format.value = "[%hour:%min]"
\ No newline at end of file
+chat-window.date-format.value = "[%hour:%min]"
+
+# gemlog subscriptions
+
+gemini-subscription-window.background = black
+
+gemini-subscription-window.foreground = cyan
diff --git a/etc/init.lisp b/etc/init.lisp
index 84047b9..58b665b 100644
--- a/etc/init.lisp
+++ b/etc/init.lisp
@@ -145,6 +145,8 @@
(define-key "M-c" #'open-chats-list-window)
+(define-key "M-g s" #'gemini-open-gemlog-window)
+
;; focus
(define-key "f1" #'focus-to-tags-window)
@@ -359,6 +361,16 @@
(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
(define-key "up" #'tag-go-up *tags-keymap*)
diff --git a/src/db.lisp b/src/db.lisp
index be56aab..b1459a4 100644
--- a/src/db.lisp
+++ b/src/db.lisp
@@ -1751,6 +1751,10 @@ row."
(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 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))
+(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)
(when-let* ((query (select :*
(from +table-gemlog-entries+)
@@ -2888,7 +2921,7 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)'
:seenp)
(post-url
gemlog-iri
- post-date
+ (decode-datetime-string post-date)
post-title
(prepare-for-db seenp :to-integer t)))))
@@ -2909,29 +2942,45 @@ 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-link :post-link)
+
(defun gemlog-entries (gemlog-url &key (unseen-only nil) (seen-only nil))
(assert (not (and unseen-only
seen-only)))
- (when-let* ((query (select ((:as :gemini-subscription.url :gemlog-url)
- (:as :gemini-subscription.title :gemlog-title)
- (:as :gemini-subscription.subtitle :gemlog-subtitle)
- (:as :gemlog-entries.date :post-date)
- (:as :gemlog-entries.title :post-title)
- (:as :gemlog-entries.seenp :seenp))
- (from :gemlog-entries)
- (join :gemini-subscription
- :on (:= :gemlog-entries.gemlog-id
- :gemini-subscription.url))
- (where (:= :gemini-subscription.url gemlog-url))
- (order-by (:desc :gemlog-entries.date))))
- (rows (fetch-all-rows query)))
- (cond
- (unseen-only
- (remove-if-not (lambda (row) (db-nil-p (row-seenp row))) rows))
- (seen-only
- (remove-if (lambda (row) (db-nil-p (row-seenp row))) rows))
- (t
- rows))))
+ (when-let* ((query (select ((:as :gemini-subscription.url :gemlog-url)
+ (:as :gemini-subscription.title :gemlog-title)
+ (:as :gemini-subscription.subtitle :gemlog-subtitle)
+ (:as :gemlog-entries.date :post-date)
+ (:as :gemlog-entries.title :post-title)
+ (:as :gemlog-entries.url :post-link)
+ (:as :gemlog-entries.seenp :seenp))
+ (from :gemlog-entries)
+ (join :gemini-subscription
+ :on (:= :gemlog-entries.gemlog-id
+ :gemini-subscription.url))
+ (where (:= :gemini-subscription.url gemlog-url))))
+ (unordered-rows (fetch-all-rows query))
+ (actual-rows (cond
+ (unseen-only
+ (remove-if-not (lambda (row) (db-nil-p (row-seenp row)))
+ unordered-rows))
+ (seen-only
+ (remove-if (lambda (row) (db-nil-p (row-seenp row)))
+ unordered-rows))
+ (t
+ 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)
(query (delete-from +table-gemlog-entries+ (where (:= :url gemlog-url)))))
diff --git a/src/gemini-subscription-window.lisp b/src/gemini-subscription-window.lisp
new file mode 100644
index 0000000..79e1b75
--- /dev/null
+++ b/src/gemini-subscription-window.lisp
@@ -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*))
diff --git a/src/gemini/gemini-parser.lisp b/src/gemini/gemini-parser.lisp
index 4868df3..de20b1c 100644
--- a/src/gemini/gemini-parser.lisp
+++ b/src/gemini/gemini-parser.lisp
@@ -19,6 +19,41 @@
(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)
(:constant nil))
diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp
index 6fa257e..9137851 100644
--- a/src/gemini/package.lisp
+++ b/src/gemini/package.lisp
@@ -37,6 +37,13 @@
(:shadowing-import-from :misc :random-elt :shuffle)
(:export
:+gemini-scheme+
+ :geminize-h1
+ :geminize-h2
+ :geminize-h3
+ :geminize-list
+ :geminize-quote
+ :geminize-link
+ :make-gemini-link
:gemini-link
:target
:name
diff --git a/src/gemini/subscription.lisp b/src/gemini/subscription.lisp
index e55ce6e..88ed6e0 100644
--- a/src/gemini/subscription.lisp
+++ b/src/gemini/subscription.lisp
@@ -46,7 +46,8 @@ A link text entry is like 'aaaa-mm-dd post title'
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)
"Returns the title of gemlog entry from link text
diff --git a/src/keybindings.lisp b/src/keybindings.lisp
index ced85ee..d1cbb7a 100644
--- a/src/keybindings.lisp
+++ b/src/keybindings.lisp
@@ -264,6 +264,9 @@ produces a tree and graft the latter on `existing-tree'"
(defparameter *chat-message-keymap* (make-starting-comand-tree)
"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*))
"Define a key sequence that trigger a function:
diff --git a/src/package.lisp b/src/package.lisp
index 6cdcbfb..617c961 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -831,6 +831,8 @@
:row-poll-expired-p
:row-poll-multiple-vote-p
:row-title
+ :row-subtitle
+ :row-url
:row-expire-date
:row-account-id
:row-updated-at
@@ -951,14 +953,18 @@
:find-tls-certificates-rows
:gemini-subscribe-url
:gemini-find-subscription
+ :gemini-all-subscriptions
+ :row-seen-count
+ :row-unseen-count
:find-gemlog-entry
:add-gemlog-entries
:gemlog-mark-as-seen
:gemlog-url
:gemlog-title
:gemlog-subtitle
- :post-date
- :post-title
+ :row-post-date
+ :row-post-title
+ :row-post-link
:gemlog-entries
:delete-gemlog-entry))
@@ -1022,6 +1028,7 @@
:+key-message-window+
:+key-chat-window+
:+key-chats-list-window+
+ :+key-gemini-subscription-window+
:+key-favourite+
:+key-sensitive+
:+key-boosted+
@@ -1216,6 +1223,7 @@
:*open-message-link-window*
:*gemini-streams-window*
:*gemini-certificates-window*
+ :*gemini-subscription-window*
:*chats-list-window*))
(defpackage :complete
@@ -1340,6 +1348,7 @@
:gemini-compact-lines-event
:gemini-enqueue-download-event
:gemini-gemlog-subscribe-event
+ :gemlog-show-event
:get-chat-messages-event
:get-chats-event
:chat-show-event
@@ -1500,6 +1509,7 @@
:*gemini-certificates-keymap*
:*chats-list-keymap*
:*chat-message-keymap*
+ :*gemlog-subscription-keymap*
:define-key
:init-keyboard-mapping
:find-keymap-node
@@ -1957,6 +1967,26 @@
(:export
: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
(:use
:cl
@@ -2353,6 +2383,11 @@
:gemini-streams-window-open-stream
:gemini-refresh-page
: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-message-to-pipe))
diff --git a/src/program-events.lisp b/src/program-events.lisp
index 6d03e09..028edc6 100644
--- a/src/program-events.lisp
+++ b/src/program-events.lisp
@@ -1143,14 +1143,72 @@
(defmethod process-event ((object gemini-gemlog-subscribe-event))
(with-accessors ((url payload)) object
(let ((subscribedp (gemini-subscription:subscribe url)))
- (when (not subscribedp)
- (gemini-subscription:refresh url)
- (ui:notify (format nil
- (_ "Unable to subscribe to ~s")
- url)
- :as-error t)))))
+ (if subscribedp
+ (gemini-subscription:refresh url)
+ (ui:notify (format nil
+ (_ "Unable to subscribe to ~s")
+ url)
+ :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
(defclass get-chat-messages-event (program-event)
diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp
index c47a539..6383b2e 100644
--- a/src/software-configuration.lisp
+++ b/src/software-configuration.lisp
@@ -367,6 +367,7 @@
message-window
chat-window
chats-list-window
+ gemini-subscription-window
attachment-header
max-numbers-allowed-attachments
max-message-length
diff --git a/src/specials.lisp b/src/specials.lisp
index 765c819..c357e28 100644
--- a/src/specials.lisp
+++ b/src/specials.lisp
@@ -58,5 +58,8 @@
(defparameter *gemini-certificates-window* nil
"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
"The window that shows all the chats.")
diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp
index 8c9f4e2..f471803 100644
--- a/src/ui-goodies.lisp
+++ b/src/ui-goodies.lisp
@@ -388,6 +388,8 @@ Metadata includes:
(if print-message
(_ "focus passed on threads window")
nil)
+ *gemini-subscription-window*
+ *gemini-certificates-window*
*chats-list-window*
*gemini-streams-window*
*open-message-link-window*
@@ -404,7 +406,8 @@ Metadata includes:
*message-window*
:documentation "Move focus 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*
*gemini-streams-window*
*open-message-link-window*
@@ -419,7 +422,8 @@ Metadata includes:
*send-message-window*
:documentation "Move focus 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*
*gemini-streams-window*
*open-message-link-window*
@@ -434,7 +438,8 @@ Metadata includes:
*follow-requests-window*
:documentation "Move focus 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*
*gemini-streams-window*
*open-message-link-window*
@@ -449,7 +454,8 @@ Metadata includes:
*tags-window*
:documentation "Move focus 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*
*gemini-streams-window*
*open-message-link-window*
@@ -463,7 +469,8 @@ Metadata includes:
*conversations-window*
:documentation "Move focus on conversations 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*
*gemini-streams-window*
*open-message-link-window*
@@ -478,7 +485,8 @@ Metadata includes:
*open-attach-window*
:documentation "Move focus on open-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*
*gemini-streams-window*
*open-message-link-window*
@@ -493,7 +501,8 @@ Metadata includes:
*open-message-link-window*
:documentation "Move focus on open-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*
*gemini-streams-window*
*conversations-window*
@@ -508,7 +517,8 @@ Metadata includes:
*gemini-streams-window*
:documentation "Move focus on open gemini streams 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*
*open-message-link-window*
*conversations-window*
@@ -523,7 +533,8 @@ Metadata includes:
*chats-list-window*
:documentation "Move focus 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*
*open-message-link-window*
*conversations-window*
@@ -538,7 +549,23 @@ Metadata includes:
*gemini-certificates-window*
:documentation "Move focus on open-gemini 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*
*conversations-window*
*open-attach-window*
@@ -1208,6 +1235,26 @@ certificate).
:prompt (_ "Delete this certificate? [Y/n] ")
: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
notify-starting-message
notify-ending-message)
@@ -1783,6 +1830,18 @@ mot recent updated to least recent"
(push-event event-abort)
(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 ()
"Subscribe to the gemlog shown in the main window.
diff --git a/tinmop.asd b/tinmop.asd
index 55f0058..91d9c0c 100644
--- a/tinmop.asd
+++ b/tinmop.asd
@@ -114,6 +114,7 @@
(:file "open-attach-window")
(:file "open-message-link-window")
(:file "gemini-client-certificates-window")
+ (:file "gemini-subscription-window")
(:file "command-window")
(:file "sending-message")
(:file "follow-requests")