mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-02 04:36:43 +01:00
- [gemini] added a draft for gemlog subscriptions.
This commit is contained in:
parent
9b4d719e4b
commit
a0f8c83681
@ -518,4 +518,10 @@ chats-list-window.input.selected.foreground = black
|
||||
|
||||
# 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
|
||||
|
@ -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*)
|
||||
|
91
src/db.lisp
91
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)))))
|
||||
|
97
src/gemini-subscription-window.lisp
Normal file
97
src/gemini-subscription-window.lisp
Normal 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*))
|
@ -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))
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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:
|
||||
|
||||
|
@ -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))
|
||||
|
||||
|
@ -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)
|
||||
|
@ -367,6 +367,7 @@
|
||||
message-window
|
||||
chat-window
|
||||
chats-list-window
|
||||
gemini-subscription-window
|
||||
attachment-header
|
||||
max-numbers-allowed-attachments
|
||||
max-message-length
|
||||
|
@ -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.")
|
||||
|
@ -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.
|
||||
|
||||
|
@ -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")
|
||||
|
Loading…
x
Reference in New Issue
Block a user