added an IRC bot engine

1 files changed, 119 insertions, 0 deletions

diff --git a/chess-irc.el b/chess-irc.el
new file mode 100644
index 0000000..7f432dd
--- /dev/null
+++ b/chess-irc.el
@@ -0,0 +1,119 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This transport uses an IRC bot to send/receive moves.
+;;
+;; $Revision$
+
+(require 'chess-network)
+
+(defgroup chess-irc nil
+  "Use an IRC bot for sending/receiving moves."
+  :group 'chess-engine)
+
+(defcustom chess-irc-host "irc.openprojects.net"
+  ""
+  :type 'string
+  :group 'chess-irc)
+
+(defcustom chess-irc-port 6667
+  ""
+  :type 'string
+  :group 'chess-irc)
+
+(defcustom chess-irc-nick "jwchess"
+  ""
+  :type 'string
+  :group 'chess-irc)
+
+(defvar chess-irc-regexp-alist chess-network-regexp-alist)
+
+(defvar chess-irc-process)
+(defvar chess-irc-engine)
+(defvar chess-irc-opponent)
+(defvar chess-irc-working nil)
+(defvar chess-irc-last-pos nil)
+
+(make-variable-buffer-local 'chess-irc-process)
+(make-variable-buffer-local 'chess-irc-engine)
+(make-variable-buffer-local 'chess-irc-opponent)
+(make-variable-buffer-local 'chess-irc-working)
+(make-variable-buffer-local 'chess-irc-last-pos)
+
+(defun chess-irc-handler (event &rest args)
+  "This is an example of a generic transport engine."
+  (cond
+   ((eq event 'initialize)
+    (message "Connecting to IRC server '%s:%d'..."
+	     chess-irc-host chess-irc-port)
+    (let ((engine (current-buffer)) proc)
+      (with-current-buffer (generate-new-buffer "*chess-irc*")
+	(setq chess-irc-engine engine
+	      proc (open-network-stream "*chess-irc*" (current-buffer)
+					chess-irc-host chess-irc-port))
+	(message "Connected, now logging in as '%s'..." chess-irc-nick)
+	(when (and proc (eq (process-status proc) 'open))
+	  (process-send-string proc (format "USER %s 0 * :%s\n"
+					    (user-login-name)
+					    (user-full-name)))
+	  (process-send-string proc (format "NICK %s\n" chess-irc-nick))
+	  (set-process-filter proc 'chess-irc-filter)
+	  (set-process-buffer proc (current-buffer))
+	  (set-marker (process-mark proc) (point))
+	  (message "Now ready to accept protocol" chess-irc-nick)))
+      (setq chess-irc-process proc))
+    nil)
+
+   ((eq event 'shutdown)
+    (ignore-errors
+      (process-send-string chess-irc-process "QUIT :Goodbye\n"))
+    (ignore-errors
+      (kill-buffer (process-buffer chess-irc-process))))
+
+   ((eq event 'send)
+    (process-send-string chess-irc-process
+			 (format "PRIVMSG %s :%s\n"
+				 chess-irc-opponent (car args))))
+   (t
+    (apply 'chess-network-handler event args))))
+
+;; This filter translates IRC syntax into basic chess-network protocol
+(defun chess-irc-filter (proc string)
+  (let ((buf (process-buffer proc)))
+    (when (buffer-live-p buf)
+      (with-current-buffer buf
+	(let ((moving (= (point) (process-mark proc))))
+	  (save-excursion
+	    ;; Insert the text, advancing the marker.
+	    (goto-char (process-mark proc))
+	    (insert string)
+	    (set-marker (process-mark proc) (point)))
+	  (if moving (goto-char (process-mark proc))))
+	(unless chess-irc-working
+	  (setq chess-irc-working t)
+	  (unwind-protect
+	      (progn
+		(if chess-irc-last-pos
+		    (goto-char chess-irc-last-pos)
+		  (goto-char (point-min)))
+		(beginning-of-line)
+		(while (not (eobp))
+		  (cond
+		   ((looking-at
+		     ":\\([^ \t\n!]+\\)!\\S-+ PRIVMSG \\(\\S-+\\) :\\(.+\\)")
+		    (let ((sender (match-string 1))
+			  (target (match-string 2))
+			  (msg (match-string 3)))
+		    (with-current-buffer chess-irc-engine
+		      (when (and (string= chess-irc-nick target)
+				 (or (null chess-irc-opponent)
+				     (string= chess-irc-opponent sender)))
+			(unless chess-irc-opponent
+			  (setq chess-irc-opponent sender))
+			(chess-engine-submit nil (concat msg "\n")))))))
+		  (forward-line)))
+	    (setq chess-irc-last-pos (point)
+		  chess-irc-working nil)))))))
+
+(provide 'chess-irc)
+
+;;; chess-irc.el ends here