echo back message stuff

[8sync.git] / demos / irc.scm

diff --git a/demos/irc.scm b/demos/irc.scm
index 04b297ad5bad53d19a0f26bc29e13d53c82cf037..37e4e0195ecbbe4a5b449aa19b39d8521a3e94f1 100755 (executable)
--- a/demos/irc.scm
+++ b/demos/irc.scm
@@ -162,23 +162,32 @@
                (string-join (cons first-word rest-message) " ")
                #f)))))
 
-(define (handle-line socket line my-username)
-  (let ((parsed-line (parse-line line)))
-    (match (irc-line-command parsed-line)
-      ("PING"
-       (irc-display "PONG" socket))
-      ("PRIVMSG"
-       (receive (channel-name message is-action)
-           (condense-privmsg-line (irc-line-params parsed-line))
-         (let ((username (irc-line-username parsed-line)))
-           (if is-action
-               (format #t "~a emoted ~s in channel ~a\n"
-                       username message channel-name)
-               (format #t "~a said ~s in channel ~a\n"
-                       username message channel-name)))))
-      (_
-       (display line)
-       (newline)))))
+(define (echo-back-message my-name speaker
+                           channel-name message is-action)
+  (if is-action
+      (format #t "~a emoted ~s in channel ~a\n"
+              speaker message channel-name)
+      (format #t "~a said ~s in channel ~a\n"
+              speaker message channel-name)))
+
+(define default-handle-privmsg echo-back-message)
+
+(define* (make-handle-line #:key
+                           (handle-privmsg default-handle-privmsg))
+  (define (handle-line socket line my-username)
+    (let ((parsed-line (parse-line line)))
+      (match (irc-line-command parsed-line)
+        ("PING"
+         (irc-display "PONG" socket))
+        ("PRIVMSG"
+         (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))))
+        (_
+         (display line)
+         (newline)))))
+  handle-line)
 
 (define (make-simple-irc-handler handle-line username)
   (let ((buffer '()))
@@ -205,7 +214,7 @@
                                       (inet-port default-irc-port)
                                       (handler (make-simple-irc-handler
                                                 (lambda args
-                                                  (apply handle-line args))
+                                                  (apply (make-handle-line) args))
                                                 username))
                                       (channels '()))
   (dynamic-wind