diff options
Diffstat (limited to 'lisp/erc/erc-chess.el')
| -rw-r--r-- | lisp/erc/erc-chess.el | 181 |
1 files changed, 181 insertions, 0 deletions
diff --git a/lisp/erc/erc-chess.el b/lisp/erc/erc-chess.el new file mode 100644 index 00000000000..94715439c99 --- /dev/null +++ b/lisp/erc/erc-chess.el @@ -0,0 +1,181 @@ +;;; erc-chess.el --- CTCP chess playing support for ERC + +;; Copyright (C) 2002, 2004, 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: Mario Lang <mlang@delysid.org> +;; Keywords: games, comm + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs 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 General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; This module requires chess.el by John Wiegley. +;; You need to have chess.el installed (load-path properly set) + +;;; Code: + +(require 'erc) +(require 'chess-network) +(require 'chess-display) +(require 'chess) + +;;;; Variables + +(defgroup erc-chess nil + "Playing chess over IRC." + :group 'erc) + +(defcustom erc-chess-verbose-flag nil + "*If non-nil, inform about bogus CTCP CHESS messages in the server buffer." + :group 'erc-chess + :type 'boolean) + +(defcustom erc-chess-debug-flag t + "*If non-nil, print all chess CTCP messages received in the server buffer." + :group 'erc-chess + :type 'boolean) + +;;;###autoload +(defvar erc-ctcp-query-CHESS-hook '(erc-chess-ctcp-query-handler)) + +(defvar erc-chess-alist nil + "Alist of chess sessions. It has the form of (NICK ENGINE)") +(make-variable-buffer-local 'erc-chess-alist) + +(defvar erc-chess-regexp-alist chess-network-regexp-alist) +(defvar erc-chess-partner) +(make-variable-buffer-local 'erc-chess-partner) + +;;;; Catalog messages + +(erc-define-catalog + 'english + '((ctcp-chess-debug . "CTCPchess: %n (%u@%h) sent: '%m'") + (ctcp-chess-quit . "Chess game with %n (%u@%h) quit"))) + + +(defun erc-chess-response-handler (event &rest args) + (when (and (eq event 'accept) + (eq chess-engine-pending-offer 'match)) + (let ((display (chess-game-data (chess-engine-game nil) 'display))) + (chess-display-enable-popup display) + (chess-display-popup display))) + + (apply 'chess-engine-default-handler event args)) + + +(defun erc-chess-handler (game event &rest args) + "Handle erc-chess events. +This is the main handler for the erc-chess module." + (cond + ((eq event 'initialize) + (setq erc-chess-partner (car args)) + (setq erc-server-process (nth 1 args)) + t) + + ((eq event 'send) + ;; Transmit the string given in `(car args)' to the nick + ;; saved in `erc-chess-partner'. + (let ((nick erc-chess-partner) + (msg (substring (car args) 0 (1- (length (car args)))))) + (erc-with-server-buffer + (erc-send-ctcp-message nick (concat "CHESS " msg) t)))) + + (t + (cond + ((eq event 'accept) + (let ((display (chess-game-data (chess-engine-game nil) 'display))) + (chess-display-enable-popup display) + (chess-display-popup display))) + + ((eq event 'destroy) + (let* ((buf (process-buffer erc-server-process)) + (nick (erc-downcase erc-chess-partner)) + (engine (current-buffer))) + (erc-with-server-buffer + (let ((elt (assoc nick erc-chess-alist))) + (when (and elt (eq (nth 1 elt) engine)) + (message "Removed from erc-chess-alist in destroy event") + (setq erc-chess-alist (delq elt erc-chess-alist)))))))) + + ;; Pass all other events down to chess-network + (apply 'chess-network-handler game event args)))) + +;;;; Game initialisation + +(defun erc-chess-engine-create (nick) + "Initialize a game for a particular nick. +This function adds to `erc-chess-alist' too." + ;; Maybe move that into the connect callback? + (let* ((objects (chess-session 'erc-chess t 'erc-chess-response-handler + nick erc-server-process)) + (engine (car objects)) + (display (cadr objects))) + (when engine + (if display + (chess-game-set-data (chess-display-game display) + 'display display)) + (push (list (erc-downcase nick) engine) erc-chess-alist) + engine))) + +;;;; IRC /commands + +;;;###autoload +(defun erc-cmd-CHESS (line &optional force) + "Initiate a chess game via CTCP to NICK. +NICK should be the first and only arg to /chess" + (cond + ((string-match (concat "^\\s-*\\(" erc-valid-nick-regexp "\\)\\s-*$") line) + (let ((nick (match-string 1 line))) + (erc-with-server-buffer + (if (assoc (erc-downcase nick) erc-chess-alist) + ;; Maybe check for correctly connected game, and switch here. + (erc-display-message + nil 'notice 'active + (concat "Invitation for a game already sent to " nick)) + (with-current-buffer (erc-chess-engine-create nick) + (erc-chess-handler nil 'match) + t))))) + (t nil))) + +;;; CTCP handler +;;;###autoload +(defun erc-chess-ctcp-query-handler (proc nick login host to msg) + (if erc-chess-debug-flag + (erc-display-message + nil 'notice (current-buffer) + 'ctcp-chess-debug ?n nick ?m msg ?u login ?h host)) + (when (string-match "^CHESS\\s-+\\(.*\\)$" msg) + (let ((str (concat (match-string 1 msg) "\n")) + (elt (assoc (erc-downcase nick) erc-chess-alist))) + (if (not elt) + (chess-engine-submit (erc-chess-engine-create nick) str) + (if (buffer-live-p (nth 1 elt)) + (chess-engine-submit (nth 1 elt) str) + (setq erc-chess-alist (delq elt erc-chess-alist))))))) + +(provide 'erc-chess) + +;;; erc-chess.el ends here +;; +;; Local Variables: +;; indent-tabs-mode: t +;; tab-width: 8 +;; End: + +;; arch-tag: beb148d1-db16-48da-8145-9f3a7ff27b7b |