Support for NICK changes
This commit is contained in:
parent
7803e352a4
commit
33cceb341d
|
@ -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))]))
|
||||||
|
|
||||||
|
|
||||||
|
|
Reference in New Issue