From 02e0a217071040d700f19dda0c44cbd9d41cead0 Mon Sep 17 00:00:00 2001 From: cage Date: Sat, 30 Mar 2024 15:47:39 +0100 Subject: [PATCH] - added command to switch fediverse account at runtime; - removed hardcoded string constants. --- etc/init.lisp | 3 ++- src/command-line.lisp | 3 ++- src/complete.lisp | 3 +++ src/constants.lisp | 2 ++ src/main.lisp | 7 ++++--- src/package.lisp | 6 +++++- src/software-configuration.lisp | 8 ++++++++ src/ui-goodies.lisp | 25 +++++++++++++++++++++++++ 8 files changed, 51 insertions(+), 6 deletions(-) diff --git a/etc/init.lisp b/etc/init.lisp index 712010f..a8c9604 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -151,6 +151,8 @@ (define-key ">" #'open-net-address) +(define-key "S a" #'switch-fediverse-account) + (define-key "?" #'print-quick-help) (define-key "C d" #'clear-cache) @@ -216,7 +218,6 @@ (define-key "q" #'confirm-and-clean-close-program) - ;; follow requests keymap (define-key "C-J" #'process-follow-requests *follow-requests-keymap*) diff --git a/src/command-line.lisp b/src/command-line.lisp index dfdd07e..99573d7 100644 --- a/src/command-line.lisp +++ b/src/command-line.lisp @@ -185,7 +185,8 @@ (write-shell-array options)))))) (defun fediverse-account-parameters () - (when-let ((splitted (cl-ppcre:split "@" *fediverse-account*))) + (when-let ((splitted (cl-ppcre:split +fediverse-account-name-server-separator+ + *fediverse-account*))) (values (elt splitted 0) (elt splitted 1)))) diff --git a/src/complete.lisp b/src/complete.lisp index 4674cac..db8dc06 100644 --- a/src/complete.lisp +++ b/src/complete.lisp @@ -277,6 +277,9 @@ list af all possible candidates for completion." (with-simple-complete language-codes (lambda () constants:+language-codes+)) +(with-simple-complete fediverse-account + (lambda () (swconf:all-fediverse-accounts))) + (defun quote-hint (a) (cl-ppcre:quote-meta-chars a)) diff --git a/src/constants.lisp b/src/constants.lisp index f9b8bdb..5bfc662 100644 --- a/src/constants.lisp +++ b/src/constants.lisp @@ -179,6 +179,8 @@ General Public License for more details." (define-constant +internal-path-gemlogs+ "gemlog" :test #'string=) +(define-constant +fediverse-account-name-server-separator+ "@" :test #'string=) + (define-constant +language-codes+ '("ab" "aar" "af" diff --git a/src/main.lisp b/src/main.lisp index 7d4b3f5..ff5899e 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -195,9 +195,10 @@ etc.) happened" (ui:display-latest-visited-urls) (ui:focus-to-message-window)) (ui:focus-to-thread-window)) - ;; now init the client we do not check for empty server name as - ;; the length of server-nems and usernames must be the same (this - ;; rule is enforced by 'swconf:trivial-configuration-checks') + ;; now init the client; we do not check for empty server name + ;; list, as the length of server-names and usernames must be the + ;; same (this rule is enforced by + ;; 'swconf:trivial-configuration-checks') (when (not (or *gemini-full-screen-mode* (null (swconf::config-username)))) (client:init) diff --git a/src/package.lisp b/src/package.lisp index f256975..3333ea5 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -77,6 +77,7 @@ :+internal-scheme+ :+internal-path-bookmark+ :+internal-path-gemlogs+ + :+fediverse-account-name-server-separator+ :+language-codes+ ;; GUI :+minimum-padding+ @@ -1443,6 +1444,7 @@ :config-notification-icon :current-username :current-server-name + :all-fediverse-accounts :set-current-username-and-server :config-password-echo-character :config-win-focus-mark @@ -1629,6 +1631,7 @@ :complete-always-empty :bookmark-section-complete :bookmark-description-complete-clsr + :fediverse-account :language-codes)) (defpackage :program-events @@ -3199,7 +3202,8 @@ :print-mentions :delete-notifications :show-announcements - :show-parent-post)) + :show-parent-post + :switch-fediverse-account)) (defpackage :scheduled-events (:use diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index 9b41afb..1e60353 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -1123,6 +1123,14 @@ (gen-simple-access (username) +key-username+) +(defun all-fediverse-accounts () + (loop for username in (config-username) + for server-name in (config-server-name) + collect + (text-utils:strcat username + +fediverse-account-name-server-separator+ + server-name))) + (defun current-username () *current-username*) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 9800fec..609c08d 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -3610,3 +3610,28 @@ gemini client certificates!)." "Delete all the password for TLS certificates that has been cached in memory." (gemini-client:clear-cache-certificate-password) (info-message (_ "Cache for TLS passord cleared"))) + +(defun switch-fediverse-account () + "Switch to a different fediverse account (if defined in the configuration file)" + (flet ((on-input-complete (account) + (if (find account (swconf:all-fediverse-accounts) :test #'string=) + (with-enqueued-process () + (db::close-db) + (setf command-line::*fediverse-account* account) + (multiple-value-bind (command-line-username command-line-server-name) + (command-line:fediverse-account-parameters) + (swconf:set-current-username-and-server command-line-username + command-line-server-name) + (main::init-db) + (client:init) + (client:authorize) + (line-oriented-window:resync-rows-db *thread-window* :redraw t) + (line-oriented-window:resync-rows-db *tags-window* :redraw t) + (line-oriented-window:resync-rows-db *conversations-window* :redraw t) + (win-clear *main-window* :redraw t))) + (error-message (format nil + (_ "Unable to find the account ~a in the configuration file") + account))))) + (ask-string-input #'on-input-complete + :prompt (_ "Switch to account: ") + :complete-fn #'complete:fediverse-account)))