X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=eightsync%2Fsystems%2Firc.scm;h=da39b5a8033f98a59ae81b3cad1ee7f9becfe8a8;hp=a802167726ba8805967aa53a4864624b6eeeaae5;hb=3ee18e4426de00fd9f654b37f5214388eafabf78;hpb=8f71a1c0f6ddc9e295d929480503222c6baf9e4e diff --git a/eightsync/systems/irc.scm b/eightsync/systems/irc.scm index a802167..da39b5a 100755 --- a/eightsync/systems/irc.scm +++ b/eightsync/systems/irc.scm @@ -30,7 +30,7 @@ #:use-module (ice-9 match) #:export (;; The only things you definitely need if writing a bot make-irc-bot-cli - irc-format irc-display + irc-format irc-display irc-send-message irc-send-formatted ;; Useful things if you're making something more complicated irc-line @@ -91,6 +91,14 @@ (display (irc-line line) dest) (display (irc-line dest)))) +(define (irc-send-message socket channel message) + (irc-format socket "PRIVMSG ~a :~a" channel message)) + +(define-syntax-rule (irc-send-formatted socket channel format-string + args ...) + (irc-format socket "PRIVMSG ~a :~a" channel + (format #f format-string args ...))) + (define* (handle-login socket username #:key (hostname "*") @@ -187,7 +195,7 @@ (string-join (cons first-word rest-message) " ") #f))))) -(define (echo-back-message my-name speaker +(define (echo-back-message socket my-name speaker channel-name message is-action) (if is-action (format #t "~a emoted ~s in channel ~a\n" @@ -208,7 +216,8 @@ (receive (channel-name message is-action) (condense-privmsg-line (irc-line-params parsed-line)) (let ((username (irc-line-username parsed-line))) - (handle-privmsg my-username username channel-name message is-action)))) + (handle-privmsg socket my-username username + channel-name message is-action)))) (_ (display line) (newline))))) @@ -225,28 +234,34 @@ (set! buffer (cons (read-char socket) buffer)) (match buffer ((#\newline #\return (? char? line-chars) ...) - (%sync (%run (handle-line - socket - (list->string (reverse line-chars)) - username))) - ;; reset buffer - (set! buffer '())) + (let ((ready-line (list->string (reverse line-chars)))) + ;; reset buffer + (set! buffer '()) + ;; run it + ;; @@: does this need to be %8sync? + (%8sync (%run (handle-line + socket + ready-line + username))))) (_ #f)))) irc-handler)) +(define default-line-handler (make-handle-line)) (define* (queue-and-start-irc-agenda! agenda socket #:key (username "syncbot") (inet-port default-irc-port) - (handler (make-basic-irc-handler - (lambda args - (apply (make-handle-line) args)) - username)) + (line-handler default-line-handler) (channels '())) (dynamic-wind (lambda () #f) (lambda () - (enq! (agenda-queue agenda) (wrap (install-socket socket handler))) + (enq! (agenda-queue agenda) + (wrap (install-socket + socket + (make-basic-irc-handler + line-handler + username)))) (enq! (agenda-queue agenda) (wrap (handle-login socket username #:channels channels))) (start-agenda agenda)) @@ -270,7 +285,9 @@ (channels (value #t)) (listen))) -(define* (make-irc-bot-cli) +(define* (make-irc-bot-cli #:optional + (line-handler default-line-handler) + (print-and-continue-on-error #t)) (define (main args) (let* ((options (getopt-long args option-spec)) (hostname (option-ref options 'server #f)) @@ -279,7 +296,9 @@ (username (option-ref options 'username #f)) (listen (option-ref options 'listen #f)) (channels (option-ref options 'channels "")) - (agenda (make-agenda))) + (agenda (if print-and-continue-on-error + (make-agenda #:pre-unwind-handler print-error-and-continue) + (make-agenda)))) (display `((server ,hostname) (port ,port) (username ,username) (listen ,listen) (channels-split ,(string-split channels #\space)))) (newline) @@ -290,8 +309,8 @@ (irc-socket-setup hostname port) #:inet-port port #:username username - #:channels (string-split channels #\space)))) + #:channels (string-split channels #\space) + #:line-handler line-handler))) main) (define main (make-irc-bot-cli)) -