blob: 2f5d2c860fb4015a6672b1f091425a96f377a5d7 (
plain)
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
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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))))
(defun chess-irc-engage (nick)
"Begin playing with another chess-irc user with the given NICK.
NOTE: This function is meant to be called from a display buffer!"
(interactive "sYour opponent's IRC nick: ")
(with-current-buffer
(cdr (assq 'chess-engine-event-handler
(chess-game-hooks (chess-display-game nil))))
(setq chess-irc-opponent nick)
(chess-engine-send engine (format "name %s\n" (user-full-name)))))
;; 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
|
