X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=eightsync%2Fsystems%2Firc.scm;h=c872b468a26a512dd40bd3a330f5b1f167c67ef7;hp=a802167726ba8805967aa53a4864624b6eeeaae5;hb=f6a77e5e588057731d5c4f98ae575a20936d4415;hpb=8f71a1c0f6ddc9e295d929480503222c6baf9e4e diff --git a/eightsync/systems/irc.scm b/eightsync/systems/irc.scm index a802167..c872b46 100755 --- a/eightsync/systems/irc.scm +++ b/eightsync/systems/irc.scm @@ -2,22 +2,23 @@ -e main -s !# -;; Copyright (C) 2015 Christopher Allan Webber - -;; This library is free software; you can redistribute it and/or -;; modify it under the terms of the GNU Lesser General Public -;; License as published by the Free Software Foundation; either -;; version 3 of the License, or (at your option) any later version. -;; -;; This library is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; Lesser General Public License for more details. -;; -;; You should have received a copy of the GNU Lesser General Public -;; License along with this library; if not, write to the Free Software -;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA -;; 02110-1301 USA +;;; 8sync --- Asynchronous programming for Guile +;;; Copyright (C) 2015 Christopher Allan Webber +;;; +;;; This file is part of 8sync. +;;; +;;; 8sync is free software: you can redistribute it and/or modify it +;;; under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation, either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; 8sync is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with 8sync. If not, see . (define-module (eightsync systems irc) #:use-module (eightsync repl) @@ -30,7 +31,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 +92,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 +196,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 +217,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 +235,33 @@ (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 + (%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)) -