1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
;;; erc-chess.el --- CTCP chess playing support for ERC
;; Copyright (C) 2002, 2004 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 2, 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 ((buf (process-buffer erc-server-process))
(nick erc-chess-partner)
(msg (substring (car args) 0 (1- (length (car args))))))
(when (buffer-live-p buf)
(with-current-buffer buf
(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)))
(with-current-buffer (erc-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)))
(with-current-buffer (erc-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
|
