Add global user-states (user-enable-state!, etc)
This commit is contained in:
parent
84ca2a0113
commit
eff8910cd3
31
chatdir.scm
31
chatdir.scm
|
@ -156,7 +156,6 @@
|
||||||
(create-directory (subpath root channel ".users" state) #t)]
|
(create-directory (subpath root channel ".users" state) #t)]
|
||||||
[user-path (subpath ".." "all" username)]
|
[user-path (subpath ".." "all" username)]
|
||||||
[state-link (subpath state-path username)])
|
[state-link (subpath state-path username)])
|
||||||
(print state-path)
|
|
||||||
(if (not (or (file-exists? state-link)
|
(if (not (or (file-exists? state-link)
|
||||||
(symbolic-link? state-link)))
|
(symbolic-link? state-link)))
|
||||||
(create-symbolic-link user-path
|
(create-symbolic-link user-path
|
||||||
|
@ -169,6 +168,32 @@
|
||||||
(channel-user-enable-state! root channel username enabled-state))
|
(channel-user-enable-state! root channel username enabled-state))
|
||||||
|
|
||||||
|
|
||||||
|
;; Enables a user's state (online/offline/etc), for all channels they are in.
|
||||||
|
(define (user-enable-state! root username state)
|
||||||
|
(map
|
||||||
|
(lambda (channel)
|
||||||
|
(channel-user-enable-state! root channel username state))
|
||||||
|
(directory (subpath root ".users" username "local"))))
|
||||||
|
|
||||||
|
|
||||||
|
;; Disables a user's state (online/offline/etc), for all channels they are in.
|
||||||
|
(define (user-disable-state! root username state)
|
||||||
|
(map
|
||||||
|
(lambda (channel)
|
||||||
|
(channel-user-disable-state! root channel username state))
|
||||||
|
(directory (subpath root ".users" username "local"))))
|
||||||
|
|
||||||
|
|
||||||
|
;; Ensures the enabled-state is enabled, and it's opposite (disabled-state) is not,
|
||||||
|
;; for all channels the given user is in.
|
||||||
|
(define (user-toggle-states! root username enabled-state disabled-state)
|
||||||
|
(map
|
||||||
|
(lambda (channel)
|
||||||
|
(channel-user-toggle-states! root channel username
|
||||||
|
enabled-state disabled-state))
|
||||||
|
(directory (subpath root ".users" username "local"))))
|
||||||
|
|
||||||
|
|
||||||
(define (write-string-to-file file value)
|
(define (write-string-to-file file value)
|
||||||
(call-with-output-file file
|
(call-with-output-file file
|
||||||
(lambda (out-port)
|
(lambda (out-port)
|
||||||
|
@ -391,3 +416,7 @@
|
||||||
|
|
||||||
(input-loop root-dir callbacks-alist))
|
(input-loop root-dir callbacks-alist))
|
||||||
|
|
||||||
|
|
||||||
|
;; Repeat after me:
|
||||||
|
;; 🎵 Symbolic links cannot have extended attributes, and that is a war-crime. 🎶
|
||||||
|
;; 🎵 Directories cannot have extended attributes, and that is a war-crime. 🎶
|
||||||
|
|
|
@ -175,6 +175,7 @@
|
||||||
|
|
||||||
;; Check a room user-directory with corresponding global user-directory,
|
;; Check a room user-directory with corresponding global user-directory,
|
||||||
;; but without the above link/pairity.
|
;; but without the above link/pairity.
|
||||||
|
(channel-user-add! *dir* *room* "mawa" #t #f)
|
||||||
(channel-user-add! *dir* *new-room* "mawa" #t #f)
|
(channel-user-add! *dir* *new-room* "mawa" #t #f)
|
||||||
(channel-user-file-set! *dir* *new-room* "mawa" "nick" "mawarth")
|
(channel-user-file-set! *dir* *new-room* "mawa" "nick" "mawarth")
|
||||||
(user-file-set! *dir* "mawa" "nick" "magma")
|
(user-file-set! *dir* "mawa" "nick" "magma")
|
||||||
|
@ -210,6 +211,12 @@
|
||||||
=>
|
=>
|
||||||
#f)
|
#f)
|
||||||
|
|
||||||
|
(user-enable-state! *dir* "mawa" "online")
|
||||||
|
(check (list (symbolic-link? (subpath *new-room-users* "online" "mawa"))
|
||||||
|
(symbolic-link? (subpath *dir* *room* ".users" "online" "mawa")))
|
||||||
|
=>
|
||||||
|
'(#t #t))
|
||||||
|
|
||||||
|
|
||||||
;; ——————————————————————————————————————————————————
|
;; ——————————————————————————————————————————————————
|
||||||
(check-report)
|
(check-report)
|
||||||
|
|
Reference in New Issue