- default-irc-port))
-
-\f
-;;; Network stuff
-;;; =============
-
-(define default-irc-port 6665)
-
-(define* (irc-socket-setup hostname #:optional (inet-port default-irc-port))
- (let* ((s (socket PF_INET SOCK_STREAM 0))
- (flags (fcntl s F_GETFL))
- (ip-address (inet-ntop AF_INET (car (hostent:addr-list (gethost hostname))))))
- (cond (s
- (fcntl s F_SETFL (logior O_NONBLOCK flags))
- (connect s AF_INET (inet-pton AF_INET ip-address) inet-port)
- s)
- (else
- (8sleep 1)
- (irc-socket-setup hostname inet-port)))))
-
-(define irc-eol "\r\n")
-
-(define (startswith-colon? str)
- (and (> (string-length str) 0)
- (eq? (string-ref str 0)
- #\:)))
-
-;; TODO: This needs a cleanup. Maybe even just using a regex is fine.
-(define (parse-line line)
- (define (parse-params pre-params)
- ;; This is stupid and imperative but I can't wrap my brain around
- ;; the right way to do it in a functional way :\
- (let ((param-list '())
- (currently-building '()))
- (for-each
- (lambda (param-item)
- (cond
- ((startswith-colon? param-item)
- (if (not (eq? currently-building '()))
- (set! param-list
- (cons
- (reverse currently-building)
- param-list)))
- (set! currently-building (list param-item)))
- (else
- (set! currently-building (cons param-item currently-building)))))
- pre-params)
- ;; We're still building something, so tack that on there
- (if (not (eq? currently-building '()))
- (set! param-list
- (cons (reverse currently-building) param-list)))
- ;; return the reverse of the param list
- (reverse param-list)))
-
- (match (string-split line #\space)
- (((? startswith-colon? prefix)
- command
- pre-params ...)
- (values prefix command
- (parse-params pre-params)))
- ((command pre-params ...)
- (values #f command
- (parse-params pre-params)))))
-
-(define (strip-colon-if-necessary string)
- (if (and (> (string-length string) 0)
- (string-ref string 0))
- (substring/copy string 1)
- string))
-
-;; @@: Not sure if this works in all cases, like what about in a non-privmsg one?
-(define (irc-line-username irc-line-prefix)
- (let* ((prefix-name (strip-colon-if-necessary irc-line-prefix))
- (exclaim-index (string-index prefix-name #\!)))
- (if exclaim-index
- (substring/copy prefix-name 0 exclaim-index)
- prefix-name)))
-
-(define (condense-privmsg-line line)
- "Condense message line and do multiple value return of
- (channel message emote?)"
- (define (strip-last-char string)
- (substring/copy string 0 (- (string-length string) 1)))
- (let* ((channel-name (caar line))
- (rest-params (apply append (cdr line))))
- (match rest-params
- (((or "\x01ACTION" ":\x01ACTION") middle-words ... (= strip-last-char last-word))
- (values channel-name
- (string-join
- (append middle-words (list last-word))
- " ")
- #t))
- (((= strip-colon-if-necessary first-word) rest-message ...)
- (values channel-name
- (string-join (cons first-word rest-message) " ")
- #f)))))
-
-;;; A goofy default