mirror of https://codeberg.org/cage/tinmop/
- [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.
This commit is contained in:
parent
629cf8e784
commit
41511b70eb
|
@ -37,7 +37,7 @@
|
||||||
(defun make-base-slot ()
|
(defun make-base-slot ()
|
||||||
"Makes the 'base' slots for credential, used in credentials
|
"Makes the 'base' slots for credential, used in credentials
|
||||||
initform."
|
initform."
|
||||||
(strcat +protocol-scheme+ (swconf:config-server-name)))
|
(strcat +protocol-scheme+ (swconf:current-server-name)))
|
||||||
|
|
||||||
(defclass credentials ()
|
(defclass credentials ()
|
||||||
((base
|
((base
|
||||||
|
@ -178,7 +178,7 @@ authorizations was performed with success."
|
||||||
"Convenience funtion to build a `api-client' instance
|
"Convenience funtion to build a `api-client' instance
|
||||||
|
|
||||||
Returns nil if the user did not provided a server in the configuration file"
|
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
|
(make-instance 'api-client
|
||||||
:website +package-url+
|
:website +package-url+
|
||||||
:base (make-base-slot)
|
:base (make-base-slot)
|
||||||
|
|
|
@ -132,7 +132,8 @@ etc.) happened"
|
||||||
e
|
e
|
||||||
+program-name+)
|
+program-name+)
|
||||||
(invoke-restart 'res:create-empty-in-home))))
|
(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))
|
(defun shared-init (&key (verbose t))
|
||||||
(num:lcg-set-seed)
|
(num:lcg-set-seed)
|
||||||
|
|
|
@ -1437,8 +1437,9 @@
|
||||||
:config-gemini-fragment-as-regex-p
|
:config-gemini-fragment-as-regex-p
|
||||||
:config-notify-window-geometry
|
:config-notify-window-geometry
|
||||||
:config-notification-icon
|
:config-notification-icon
|
||||||
:config-server-name
|
:current-username
|
||||||
:config-username
|
:current-server-name
|
||||||
|
:set-current-username-and-server
|
||||||
:config-password-echo-character
|
:config-password-echo-character
|
||||||
:config-win-focus-mark
|
:config-win-focus-mark
|
||||||
:config-gopher-line-prefix-directory
|
:config-gopher-line-prefix-directory
|
||||||
|
|
|
@ -303,11 +303,13 @@
|
||||||
|
|
||||||
(defrule server-assign
|
(defrule server-assign
|
||||||
(and server-key blanks assign blanks generic-value blanks)
|
(and server-key blanks assign blanks generic-value blanks)
|
||||||
(:function remove-if-null))
|
(:function (lambda (a)
|
||||||
|
(list (first a) (fifth a)))))
|
||||||
|
|
||||||
(defrule username-assign
|
(defrule username-assign
|
||||||
(and username-key blanks assign blanks generic-value blanks)
|
(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 #'=
|
(define-constant +buffer-minimum-size-to-open+ (expt 1024 2) :test #'=
|
||||||
:documentation "Minimum size of the saved contents (non gemini text)
|
:documentation "Minimum size of the saved contents (non gemini text)
|
||||||
|
@ -665,7 +667,9 @@
|
||||||
(eq +key-ignore-user-boost-re+ key)
|
(eq +key-ignore-user-boost-re+ key)
|
||||||
(eq +key-ignore-tag-re+ key)
|
(eq +key-ignore-tag-re+ key)
|
||||||
(eq +key-open-link-helper+ 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)
|
(setf (access:accesses *software-configuration* key)
|
||||||
(append (access:accesses *software-configuration* key)
|
(append (access:accesses *software-configuration* key)
|
||||||
(list value))))
|
(list value))))
|
||||||
|
@ -1100,6 +1104,11 @@
|
||||||
+key-notify-window+
|
+key-notify-window+
|
||||||
+key-width+)))
|
+key-width+)))
|
||||||
|
|
||||||
|
|
||||||
|
(defparameter *current-username* nil)
|
||||||
|
|
||||||
|
(defparameter *current-server-name* nil)
|
||||||
|
|
||||||
(gen-simple-access (notification-icon)
|
(gen-simple-access (notification-icon)
|
||||||
+key-thread-window+
|
+key-thread-window+
|
||||||
+key-modeline+
|
+key-modeline+
|
||||||
|
@ -1112,6 +1121,41 @@
|
||||||
(gen-simple-access (username)
|
(gen-simple-access (username)
|
||||||
+key-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)
|
(gen-simple-access (password-echo-character)
|
||||||
+key-password-echo-character+)
|
+key-password-echo-character+)
|
||||||
|
|
||||||
|
|
|
@ -209,8 +209,8 @@
|
||||||
|
|
||||||
(defun default-expander ()
|
(defun default-expander ()
|
||||||
(list (cons "%" (lambda (w) (with-tuify-results (w) "%")))
|
(list (cons "%" (lambda (w) (with-tuify-results (w) "%")))
|
||||||
(cons "s" (lambda (w) (with-tuify-results (w) (swconf:config-server-name))))
|
(cons "s" (lambda (w) (with-tuify-results (w) (swconf:current-server-name))))
|
||||||
(cons "u" (lambda (w) (with-tuify-results (w) (swconf:config-username))))
|
(cons "u" (lambda (w) (with-tuify-results (w) (swconf:current-username))))
|
||||||
(cons "k" #'expand-timeline-type)
|
(cons "k" #'expand-timeline-type)
|
||||||
(cons "f" #'expand-folder-name)
|
(cons "f" #'expand-folder-name)
|
||||||
(cons "h" #'expand-message-hashtags)
|
(cons "h" #'expand-message-hashtags)
|
||||||
|
|
Loading…
Reference in New Issue