diff --git a/src/api-client.lisp b/src/api-client.lisp index 442408d..bdfcf76 100644 --- a/src/api-client.lisp +++ b/src/api-client.lisp @@ -37,7 +37,7 @@ (defun make-base-slot () "Makes the 'base' slots for credential, used in credentials initform." - (strcat +protocol-scheme+ (swconf:config-server-name))) + (strcat +protocol-scheme+ (swconf:current-server-name))) (defclass credentials () ((base @@ -178,7 +178,7 @@ authorizations was performed with success." "Convenience funtion to build a `api-client' instance Returns nil if the user did not provided a server in the configuration file" - (when (text-utils:string-not-empty-p (swconf:config-server-name)) + (when (text-utils:string-not-empty-p (swconf:current-server-name)) (make-instance 'api-client :website +package-url+ :base (make-base-slot) diff --git a/src/main.lisp b/src/main.lisp index c91cbf1..c0615a2 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -132,7 +132,8 @@ etc.) happened" e +program-name+) (invoke-restart 'res:create-empty-in-home)))) - (swconf:load-config-file swconf:+conf-filename+))) + (swconf:load-config-file swconf:+conf-filename+) + (swconf:set-current-username-and-server))) (defun shared-init (&key (verbose t)) (num:lcg-set-seed) diff --git a/src/package.lisp b/src/package.lisp index 8c2d311..9bbc951 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1437,8 +1437,9 @@ :config-gemini-fragment-as-regex-p :config-notify-window-geometry :config-notification-icon - :config-server-name - :config-username + :current-username + :current-server-name + :set-current-username-and-server :config-password-echo-character :config-win-focus-mark :config-gopher-line-prefix-directory diff --git a/src/software-configuration.lisp b/src/software-configuration.lisp index e0e98af..e82aa50 100644 --- a/src/software-configuration.lisp +++ b/src/software-configuration.lisp @@ -303,11 +303,13 @@ (defrule server-assign (and server-key blanks assign blanks generic-value blanks) - (:function remove-if-null)) + (:function (lambda (a) + (list (first a) (fifth a))))) (defrule username-assign (and username-key blanks assign blanks generic-value blanks) - (:function remove-if-null)) + (:function (lambda (a) + (list (first a) (fifth a))))) (define-constant +buffer-minimum-size-to-open+ (expt 1024 2) :test #'= :documentation "Minimum size of the saved contents (non gemini text) @@ -665,7 +667,9 @@ (eq +key-ignore-user-boost-re+ key) (eq +key-ignore-tag-re+ key) (eq +key-open-link-helper+ key) - (eq +key-post-allowed-language+ key)) + (eq +key-post-allowed-language+ key) + (eq +key-server+ key) + (eq +key-username+ key)) (setf (access:accesses *software-configuration* key) (append (access:accesses *software-configuration* key) (list value)))) @@ -1100,6 +1104,11 @@ +key-notify-window+ +key-width+))) + +(defparameter *current-username* nil) + +(defparameter *current-server-name* nil) + (gen-simple-access (notification-icon) +key-thread-window+ +key-modeline+ @@ -1112,6 +1121,41 @@ (gen-simple-access (username) +key-username+) +(defun current-username () + *current-username*) + +(defun current-server-name () + *current-server-name*) + +(defun set-current-username-and-server (&optional username server-name) + (flet ((set-currents (username server-name) + (setf *current-username* username) + (setf *current-server-name* server-name))) + (cond + ((not (or username + server-name)) + (set-currents (first (config-username)) (first (config-server-name)))) + ((and (text-utils:string-not-empty-p username) + (text-utils:string-not-empty-p server-name)) + (let* ((position-all-usernames (loop for pos from 0 + for i in (config-username) + when (string= i username) + collect + pos)) + (matched-server-position (loop named scanner + for i in position-all-usernames + when (string= (elt (config-server-name) i) + server-name) + do (return-from scanner i)))) + (if matched-server-position + (set-currents (elt (config-username) matched-server-position) + (elt (config-server-name) matched-server-position)) + (error "no matching server for user ~a" username)))) + (t + (if username + (error "server name value can not be null") + (error "username value can not be null")))))) + (gen-simple-access (password-echo-character) +key-password-echo-character+) diff --git a/src/thread-window.lisp b/src/thread-window.lisp index d7c2a72..94bc70e 100644 --- a/src/thread-window.lisp +++ b/src/thread-window.lisp @@ -209,8 +209,8 @@ (defun default-expander () (list (cons "%" (lambda (w) (with-tuify-results (w) "%"))) - (cons "s" (lambda (w) (with-tuify-results (w) (swconf:config-server-name)))) - (cons "u" (lambda (w) (with-tuify-results (w) (swconf:config-username)))) + (cons "s" (lambda (w) (with-tuify-results (w) (swconf:current-server-name)))) + (cons "u" (lambda (w) (with-tuify-results (w) (swconf:current-username)))) (cons "k" #'expand-timeline-type) (cons "f" #'expand-folder-name) (cons "h" #'expand-message-hashtags)