code.delx.au - gnu-emacs-elpa/blob - chess-irc.el

   1 ;;; chess-irc.el --- This transport uses an IRC bot to send/receive moves.
   2
   3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
   4
   5 ;; This is free software; you can redistribute it and/or modify it under
   6 ;; the terms of the GNU General Public License as published by the Free
   7 ;; Software Foundation; either version 3, or (at your option) any later
   8 ;; version.
   9 ;;
  10 ;; This is distributed in the hope that it will be useful, but WITHOUT
  11 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  12 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  13 ;; for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 ;;; Commentary:
  19
  20 ;;; Code:
  21
  22 (require 'chess-network)
  23
  24 (defgroup chess-irc nil
  25   "Use an IRC bot for sending/receiving moves."
  26   :group 'chess-engine)
  27
  28 (defcustom chess-irc-server "irc.openprojects.net"
  29   "The IRC host to connect your chess-irc engine to."
  30   :type 'string
  31   :group 'chess-irc)
  32
  33 (defcustom chess-irc-port 6667
  34   "The port of the IRC host specified by `chess-irc-server'."
  35   :type 'string
  36   :group 'chess-irc)
  37
  38 (defcustom chess-irc-nick (user-login-name)
  39   "The nick you wish to use for sending/receiving IRC chess moves."
  40   :type 'string
  41   :group 'chess-irc)
  42
  43 ;;; Code:
  44
  45 (chess-message-catalog 'english
  46   '((opponent-says  . "Your opponent says: %s")
  47     (irc-connecting . "Connecting to IRC server '%s:%d'...")
  48     (irc-logging-in . "Connected, now logging in as '%s'...")
  49     (irc-waiting    . "Now waiting for 'name USER' via /msg, or `M-x chess-irc-engage'")
  50     (irc-challenge  . "IRC nick of user to challenge: ")))
  51
  52 (defvar chess-irc-regexp-alist
  53   (append chess-network-regexp-alist
  54           (list (cons ".+"
  55                       (function
  56                        (lambda ()
  57                          (chess-message 'opponent-says
  58                                         (match-string 0))))))))
  59
  60 (defvar chess-irc-process)
  61 (defvar chess-irc-engine)
  62 (defvar chess-irc-opponent)
  63 (defvar chess-irc-working nil)
  64 (defvar chess-irc-last-pos nil)
  65 (defvar chess-irc-use-ctcp nil)
  66
  67 (make-variable-buffer-local 'chess-irc-process)
  68 (make-variable-buffer-local 'chess-irc-engine)
  69 (make-variable-buffer-local 'chess-irc-opponent)
  70 (make-variable-buffer-local 'chess-irc-working)
  71 (make-variable-buffer-local 'chess-irc-last-pos)
  72 (make-variable-buffer-local 'chess-irc-use-ctcp)
  73
  74 (defun chess-irc-handler (game event &rest args)
  75   "This is an example of a generic transport engine."
  76   (unless chess-engine-handling-event
  77     (cond
  78      ((eq event 'initialize)
  79       (chess-message 'irc-connecting chess-irc-server chess-irc-port)
  80       (let ((engine (current-buffer)) proc)
  81         (with-current-buffer (generate-new-buffer " *chess-irc*")
  82           (setq chess-irc-engine engine
  83                 proc (open-network-stream "*chess-irc*" (current-buffer)
  84                                           chess-irc-server chess-irc-port))
  85           (chess-message 'irc-logging-in chess-irc-nick)
  86           (when (and proc (processp proc)
  87                      (eq (process-status proc) 'open))
  88             (process-send-string proc (format "USER %s 0 * :%s\n"
  89                                               (user-login-name)
  90                                               chess-full-name))
  91             (process-send-string proc (format "NICK %s\n" chess-irc-nick))
  92             (set-process-filter proc 'chess-irc-filter)
  93             (set-process-buffer proc (current-buffer))
  94             (set-marker (process-mark proc) (point))
  95             (chess-message 'irc-waiting)))
  96         (setq chess-irc-process proc))
  97       t)
  98
  99      ((eq event 'match)
 100       (setq chess-irc-opponent (read-string (chess-string 'irc-challenge)))
 101       (chess-network-handler 'match chess-irc-opponent))
 102
 103      ((eq event 'destroy)
 104       (chess-engine-send nil "quit")
 105       (process-send-string chess-irc-process "QUIT :Goodbye\n")
 106       (kill-buffer (process-buffer chess-irc-process)))
 107
 108      ((eq event 'send)
 109       (process-send-string chess-irc-process
 110                            (if chess-irc-use-ctcp
 111                                (format "PRIVMSG %s :\C-aCHESS %s\C-a\n"
 112                                        chess-irc-opponent (car args))
 113                              (format "PRIVMSG %s :%s\n"
 114                                      chess-irc-opponent (car args)))))
 115      (t
 116       (apply 'chess-network-handler game event args)))))
 117
 118 ;; This filter translates IRC syntax into basic chess-network protocol
 119 (defun chess-irc-filter (proc string)
 120   (let ((buf (process-buffer proc)))
 121     (when (buffer-live-p buf)
 122       (with-current-buffer buf
 123         (let ((moving (= (point) (process-mark proc))))
 124           (save-excursion
 125             ;; Insert the text, advancing the marker.
 126             (goto-char (process-mark proc))
 127             (while (string-match "\r" string)
 128               (setq string (replace-match "" t t string)))
 129             (insert string)
 130             (set-marker (process-mark proc) (point)))
 131           (if moving (goto-char (process-mark proc))))
 132         (unless chess-irc-working
 133           (setq chess-irc-working t)
 134           (unwind-protect
 135               (progn
 136                 (if chess-irc-last-pos
 137                     (goto-char chess-irc-last-pos)
 138                   (goto-char (point-min)))
 139                 (beginning-of-line)
 140                 (while (not (eobp))
 141                   (cond
 142                    ((looking-at
 143                      ":\\([^ \t\n!]+\\)!\\S-+ PRIVMSG \\(\\S-+\\) :\\(\C-aCHESS \\)?\\(.+\\)\C-a?\n")
 144                     (let ((sender (match-string 1))
 145                           (target (match-string 2))
 146                           (ctcp (match-string 3))
 147                           (msg (match-string 4)))
 148                     (with-current-buffer chess-irc-engine
 149                       (when (and (string= chess-irc-nick target)
 150                                  (or (null chess-irc-opponent)
 151                                      (string= chess-irc-opponent sender)))
 152                         (unless chess-irc-opponent
 153                           (setq chess-irc-opponent sender))
 154                         (if (and (not chess-irc-use-ctcp)
 155                                  ctcp (> (length ctcp) 0))
 156                           (setq chess-irc-use-ctcp t))
 157                         (chess-engine-submit nil (concat msg "\n")))))))
 158                   (forward-line)))
 159             (setq chess-irc-last-pos (point)
 160                   chess-irc-working nil)))))))
 161
 162 (provide 'chess-irc)
 163
 164 ;;; chess-irc.el ends here