- [fediverse] allowed to specify more than one account in the configuration file, each couple of directive 'username' and 'server' an be specified more that once.

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)

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)

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

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+)
 

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)