jadedctrl/ chicken-chatdir
Archived
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Activity

Support for NICK changes

This commit is contained in:
Jaidyn Ann 2023-01-14 14:25:32 -06:00
parent 7803e352a4
commit 33cceb341d
1 changed files with 41 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
irc-chatd.scm
View File

@ -24,29 +24,38 @@
getopt-long) getopt-long)
;; Write a to-be-JSON alist to the appropriate output
(define (chatd-json-write conn alist)
(json-write alist)
(print "\n"))
;; Return a user-info in chatd-friendly alist-format, by its alist ;; Return a user-info in chatd-friendly alist-format, by its alist
(define (user-alist conn nick) (define (user-alist conn nick)
(let* ([ircc-alist (irc:user-alist conn nick)] (let* ([ircc-alist (irc:user-alist conn nick)]
[hostmask (alist-ref 'hostmask ircc-alist)]) [hostmask (alist-ref 'hostmask ircc-alist)])
(if (not hostmask) (if (not hostmask)
(list (cons 'name nick))) (list (cons 'name nick))
(list (cons 'name nick) (list (cons 'name nick)
(cons 'id hostmask)))) (cons 'id (irc:hostmask-userhost hostmask))))))
;; Return an IRC room in chatd-amicable alist-format, using its hashtable ;; Return an IRC room in chatd-amicable alist-format, using its hashtable
(define (channel-alist conn channel) (define (channel-alist conn channel)
(let ([channel-table (irc:channel-table conn channel)]) (let ([channel-table (irc:channel-table conn channel)])
;; (pretty-print (hash-table-ref channel-table 'users)) (filter
(lambda (item) item)
(list (list
(cons 'id channel) (cons 'id channel)
(cons 'name channel) (cons 'name channel)
(cons 'topic (hash-table-ref channel-table 'topic)) (cons 'topic (if (hash-table-exists? channel-table 'topic)
(hash-table-ref channel-table 'topic)
#f))
(cons 'users (cons 'users
(map (map
(lambda (nick) (lambda (nick)
(cons 'user (user-alist conn nick))) (cons 'user (user-alist conn nick)))
(hash-table-ref channel-table 'users)))))) (hash-table-ref channel-table 'users)))))))
;; Returns a channel's chatd-friendly alist format, but solely with ID ;; Returns a channel's chatd-friendly alist format, but solely with ID
@ -88,15 +97,21 @@
(define (on-command conn cmd params #!optional sender) (define (on-command conn cmd params #!optional sender)
(cond (cond
[(string=? cmd "PRIVMSG") [(string=? cmd "PRIVMSG")
(json-write (let ([target (if (irc:user-is-self? conn (car params))
(compose-event-alist conn "message" #:channel (car params) (irc:hostmask-nick sender)
#:text (last params) #:user (irc:hostmask-nick sender)))] (car params))])
(chatd-json-write conn
(compose-event-alist conn "message" #:channel target
#:text (last params) #:user (irc:hostmask-nick sender))))]
[(string=? cmd "JOIN") [(string=? cmd "JOIN")
(json-write (chatd-json-write conn
(compose-event-alist conn "room-join" #:channel (car params) (compose-event-alist conn "room-join" #:channel (car params)
#:user (irc:hostmask-nick sender)))]) #:user (irc:hostmask-nick sender)))]
[(string=? cmd "NICK")
(print sender ":" cmd params)) (chatd-json-write conn
(compose-event-alist conn "user-info" #:user (last params)))])
)
;; (pretty-print (list sender ":" cmd params)))
;; Hook function for irc:loop; handles all IRC errors and replies ;; Hook function for irc:loop; handles all IRC errors and replies
@ -105,9 +120,16 @@
(cond (cond
[(eq? reply RPL_WELCOME) [(eq? reply RPL_WELCOME)
(irc:write-cmd conn "JOIN" "#thevoid")] (irc:write-cmd conn "JOIN" "#thevoid")]
[(or (eq? reply RPL_TOPIC)
(eq? reply RPL_ENDOFWHO)) ;; After receiving a user-list or topic update, tell the user!
(json-write [(let ([channel (second params)])
(and (irc:channel? channel)
(or (eq? reply RPL_TOPIC)
(eq? reply RPL_TOPICWHOTIME)
(and (irc:capability? conn 'userhost-in-names)
(eq? reply RPL_ENDOFNAMES))
(eq? reply RPL_ENDOFWHO))))
(chatd-json-write conn
(compose-event-alist conn "room-info" #:channel (second params) #:long-channel #t))])) (compose-event-alist conn "room-info" #:channel (second params) #:long-channel #t))]))