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

   1 ;;; chess-ics.el --- Play on Internet Chess Servers
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2014  Free Software Foundation, Inc.
   4
   5 ;; Author: John Wiegley
   6 ;; Maintainer: Mario Lang <mlang@delysid.org>
   7 ;; Keywords: games, processes
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; This module allows to play chess on an Internet Chess Server.
  25 ;; Contrary to other chess engine modules for chess.el, you are not supposed to
  26 ;; use `chess-ics' as an engine for `M-x chess', rather, you call
  27 ;; `M-x chess-ics' directly to play chess on the internet.
  28 ;;
  29 ;; The two major Internet Chess Servers, freechess.org and chessclub.com
  30 ;; are both supported.  See `chess-ics-server-list' for the supported servers.
  31
  32 ;;; Code:
  33
  34 (require 'cl-lib)
  35 (require 'comint)
  36
  37 (require 'chess)
  38 (require 'chess-network)
  39 (require 'chess-pos)
  40
  41 (eval-when-compile
  42   (require 'rx)
  43   (require 'sort))
  44
  45 (defgroup chess-ics nil
  46   "Engine for interacting with Internet Chess Servers."
  47   :group 'chess
  48   :link '(custom-manual "(chess)Internet Chess Servers"))
  49
  50 (defcustom chess-ics-server-list '(("freechess.org" 5000)
  51                                    ("chess.unix-ag.uni-kl.de" 5000)
  52                                    ("chessclub.com" 5000)
  53                                    ("chess.net" 5000)
  54                                    ("oics.olympuschess.com" 5000))
  55   "A list of servers to connect to.
  56 The format of each entry is:
  57
  58   (SERVER PORT [HANDLE] [PASSWORD-OR-FILENAME] [HELPER] [HELPER ARGS...])"
  59   :type '(repeat (list (string :tag "Server")
  60                        (integer :tag "Port")
  61                        (choice (const :tag "Login as guest" nil)
  62                                (string :tag "Handle"))
  63                        (choice (const :tag "No password or ask" nil)
  64                                (string :tag "Password")
  65                                (file :tag "Filename"))
  66                        (choice (const :tag "Direct connection" nil)
  67                                (file :tag "Command"))
  68                        (choice (const :tag "No arguments" nil)
  69                                (repeat string))))
  70   :group 'chess-ics)
  71
  72
  73
  74 (defcustom chess-ics-initial-commands
  75   (list
  76    (list "freechess.org"
  77          "iset defprompt 1"  ; So we can't be supprised by a user setting
  78          (format "set interface emacs-chess %s" chess-version)
  79          "iset seekremove 1" ; For real-time sought display
  80          "iset startpos 1"   ; Sends initial position before movelist
  81          "set style 12"      ; So we can parse the board "easily"
  82          "set bell 0")       ; We have our own way of announcing events
  83    (list "chessclub.com"
  84          (format "/set-quietly interface emacs-chess %s" chess-version)
  85          "/set-quietly style 12"      ; So we can parse the board "easily"
  86          "/set-quietly bell 0")
  87    (list nil
  88          (format "set interface emacs-chess %s" chess-version)
  89          "set style 12"      ; So we can parse the board "easily"
  90          "set bell 0"))
  91   "A list of commands to send automatically upon successful login.
  92 The format is (SERVER COMMANDS...) where SERVER is either the server-name
  93 \(see `chess-ics-server-list') or nil, which is the default to use for all
  94 servers which do not have a specialized entry in this list.  COMMAND is a
  95 string which should be sent (newline characters will be added automatically.)"
  96   :group 'chess-ics
  97   :type '(repeat
  98           (list :tag "Initialisation for"
  99                 (choice (string :tag "Server Name") (const :tag "Default" nil))
 100                 (repeat :inline t (string :tag "Command")))))
 101
 102 (defcustom chess-ics-prompt-regexp "\\(?:[0-2][0-9]:[0-6][0-9]_\\)?[af]ics% $"
 103   "*Regexp which matches an ICS prompt."
 104   :group 'chess-ics
 105   :type 'regexp)
 106
 107 (defvar chess-ics-server nil
 108   "The ICS server name of this connection.")
 109 (make-variable-buffer-local 'chess-ics-server)
 110
 111 (defvar chess-ics-handle nil
 112   "The ICS handle of this connection.")
 113 (make-variable-buffer-local 'chess-ics-handle)
 114
 115 (defvar chess-ics-password nil
 116   "Password to use to identify to the server.")
 117 (make-variable-buffer-local 'chess-ics-password)
 118
 119 (defvar chess-ics-handling-login nil
 120   "Non-nil if we are currently handling the ICS login sequence.")
 121 (make-variable-buffer-local 'chess-ics-handling-login)
 122
 123 (defvar chess-ics-server-type 'FICS
 124   "The type of chss server we are about to connect too.
 125 Possible values are currently FICS (the default, and best supported)
 126 and ICC.")
 127 (make-variable-buffer-local 'chess-ics-server-type)
 128
 129 (defcustom chess-ics-icc-datagrams '(22 23 26 33 50 51 56 110 111)
 130   "*A list of datagrams to request when connecting to ICC."
 131   :group 'chess-ics
 132   :type '(repeat (choice (const :tag "DG_SEND_MOVES" 24)
 133                          (const :tag "DG_KIBITZ" 26)
 134                          (const :tag "DG_MOVE_ALGEBRAIC" 33)
 135                          (const :tag "DG_SEEK" 50)
 136                          (const :tag "DG_SEEK_REMOVED" 51)
 137                          (const :tag "DG_MSEC" 56)
 138                          (const :tag "DG_POSITION_BEGIN" 101)
 139                          (const :tag "DG_POSITION_BEGIN2" 110)
 140                          (const :tag "DG_PAST_MOVE" 111))))
 141
 142 (defvar chess-ics-movelist-game-number nil
 143   "If we are about to receive a movelist, this variable is set to the
 144 game number.")
 145 (make-variable-buffer-local 'chess-ics-movelist-game-number)
 146
 147 (defvar chess-ics-movelist-game nil
 148   "If we are receiving a movelist, this variable is set to the game object.")
 149 (make-variable-buffer-local 'chess-ics-movelist-game)
 150
 151 (defvar chess-ics-movelist-start-position chess-starting-position
 152   "The starting position to use upon receiving of a movelist.
 153 It is possible to configure certain servers to automatically send a
 154 style12 board before sending a movelist, to allow retrieval of
 155 the movelist for a non-standard game (one which does not start at the
 156 standard position).  In those cases, this variable should be set to nil.")
 157 (make-variable-buffer-local 'chess-ics-movelist-start-position)
 158
 159 (defsubst chess-ics-send (string &optional buffer)
 160   "Send STRING to the ICS server."
 161   (comint-send-string (get-buffer-process (or buffer (current-buffer)))
 162                       (concat string "\n")))
 163
 164 (chess-message-catalog 'english
 165   '((ics-server-prompt . "Connect to chess server: ")
 166     (ics-connecting    . "Connecting to Internet Chess Server '%s'...")
 167     (ics-connected     . "Connecting to Internet Chess Server '%s'...done")
 168     (ics-anon-login    . "Logging in on Internet Chess Server '%s' as anonymous user...")
 169     (ics-logging-in    . "Logging in on Internet Chess Server '%s' as '%s'...")
 170     (ics-logged-in     . "Logging in on Internet Chess Server '%s' as '%s'...done")
 171     (challenge-whom    . "Whom would you like challenge? ")
 172     (failed-ics-parse  . "Failed to parse ICS move string (%s): ")))
 173
 174 (defconst chess-ics-style12-regexp
 175   (rx (and "<12> "
 176            (group (repeat 8 (in "-pnbrqkPNBRQK"))) " "
 177            (group (repeat 8 (in "-pnbrqkPNBRQK"))) " "
 178            (group (repeat 8 (in "-pnbrqkPNBRQK"))) " "
 179            (group (repeat 8 (in "-pnbrqkPNBRQK"))) " "
 180            (group (repeat 8 (in "-pnbrqkPNBRQK"))) " "
 181            (group (repeat 8 (in "-pnbrqkPNBRQK"))) " "
 182            (group (repeat 8 (in "-pnbrqkPNBRQK"))) " "
 183            (group (repeat 8 (in "-pnbrqkPNBRQK"))) " "
 184            (group (in "BW")) " "
 185            (group (and (? ?-) (in "0-7"))) " "
 186            (group (and (? ?-) digit)) " "
 187            (group (and (? ?-) digit)) " "
 188            (group (and (? ?-) digit)) " "
 189            (group (and (? ?-) digit)) " "
 190            (group (+ digit)) " "
 191            (group (+ digit)) " "
 192            (group (+ (not (in " ")))) " "
 193            (group (+ (not (in " ")))) " "
 194            (group (and (? ?-) digit)) " "
 195            (group (+ digit)) " "
 196            (group (+ digit)) " "
 197            (group (+ digit)) " "
 198            (group (+ digit)) " "
 199            (group (and (? ?-) (+ digit))) " "
 200            (group (and (? ?-) (+ digit))) " "
 201            (group (+ digit)) " "
 202            (group (+ (not (in " ")))) " "
 203            "(" (group (+ (not (in " )")))) ") "
 204            (group (+ (not (in " ")))) " "
 205            (group (and (? ?-) digit))
 206            (optional (and " " (group (and (? ?-) digit)) " "
 207                           (group (and (? ?-) (+ digit)))))))
 208   "A regular expression matching a style12 board string.")
 209
 210 (defvar chess-ics-matcher-alist
 211   (list
 212    (cons "www.chessclub.com"
 213          (function
 214           (lambda ()
 215             (when chess-ics-handling-login
 216               (setq chess-ics-server-type 'ICC
 217                     comint-preoutput-filter-functions
 218                     '(chess-icc-preoutput-filter)))
 219             'once)))
 220    (cons "\\(ogin\\|name\\):"
 221          (function
 222           (lambda ()
 223             (when (eq chess-ics-server-type 'ICC)
 224               (chess-ics-send
 225                (format "level2settings=%s"
 226                        (let ((str (make-string
 227                                    (1+ (apply 'max chess-ics-icc-datagrams))
 228                                    ?0)))
 229                          (dolist (dg chess-ics-icc-datagrams str)
 230                            (aset str dg ?1))))))
 231             (if (string= "guest" chess-ics-handle)
 232                 (chess-message 'ics-anon-login chess-ics-server)
 233               (chess-message
 234                'ics-logging-in chess-ics-server chess-ics-handle))
 235             (chess-ics-send chess-ics-handle)
 236             'once)))
 237    (cons "[Pp]assword:"
 238          (function
 239           (lambda ()
 240             (when chess-ics-handling-login
 241               (chess-ics-send chess-ics-password))
 242             'once)))
 243    (cons "\\(Logging you in as\\|Your name for this session will be\\) \"\\([^\"]+\\)\""
 244          (function
 245           (lambda ()
 246             (setq chess-ics-handle (match-string 2))
 247             'once)))
 248    (cons "Press return to enter the server as"
 249          (function
 250           (lambda ()
 251             (chess-ics-send "")
 252             'once)))
 253    (cons "Press return to enter chess.net as \"\\([^\"]+\\)\":"
 254          (function
 255           (lambda ()
 256             (setq chess-ics-handle (match-string 1))
 257             (chess-ics-send "")
 258             'once)))
 259    (cons "%\\s-*$"
 260          (function
 261           (lambda ()
 262             (chess-ics-send
 263              (mapconcat 'identity
 264                         (cdr
 265                          (or
 266                           (assoc chess-ics-server chess-ics-initial-commands)
 267                           (assoc nil chess-ics-initial-commands))) "\n"))
 268             (setq chess-ics-handling-login nil)
 269             (chess-message 'ics-logged-in chess-ics-server chess-ics-handle)
 270             'once)))
 271    (cons "fics%\\s-+startpos set.$"
 272          (function
 273           (lambda ()
 274             (setq chess-ics-movelist-start-position nil)
 275             'once)))
 276    (cons (concat "^Game [0-9]+: \\S-+ moves: " chess-algebraic-regexp-entire)
 277          (function
 278           (lambda ()
 279             (save-excursion
 280               (while (and (forward-line -1)
 281                           (or (looking-at "^[ \t]*$")
 282                               (looking-at
 283                                (concat "^" chess-ics-prompt-regexp))))
 284                 (delete-region (match-beginning 0) (1+ (match-end 0)))))
 285             t)))
 286    (cons "^\\([A-Za-z0-9]+\\)\\((\\*)\\|(B)\\|(CA?)\\|(H)\\|(DM)\\|(T[DM]?)\\|(SR)\\|(FM)\\|(W?[GI]M)\\|(U)\\|([0-9-]+)\\)*\\((\\([0-9]+\\))\\| tells you\\| s-shouts\\|\\[\\([0-9]+\\)\\] kibitzes\\): \\(.+\\)$"
 287          (function
 288           (lambda ()
 289             (let ((fill-prefix (make-string
 290                                 (- (match-end 1) (match-beginning 1)) ? ))
 291                   (game-num (match-string 5))
 292                   (text-begin (match-beginning 6)))
 293               (goto-char (match-beginning 0))
 294               (save-excursion
 295                 (while (and (forward-line 1)
 296                             (looking-at "^\\\\\\s-+"))
 297                   (delete-region (1- (match-beginning 0)) (match-end 0))))
 298               (when game-num
 299                 (chess-game-run-hooks
 300                  (chess-ics-game (string-to-number game-num))
 301                  'kibitz (buffer-substring text-begin (line-end-position))))
 302               (when (> (- (line-end-position) (line-beginning-position))
 303                        fill-column)
 304                 (save-excursion
 305                  (fill-region (point) (line-end-position))))
 306               (save-excursion
 307                 (while (and (forward-line -1)
 308                             (or (looking-at "^[ \t]*$")
 309                                 (looking-at "^[af]ics%\\s-*$")))
 310                   (delete-region (match-beginning 0) (1+ (match-end 0)))))))))
 311    (cons "{Game \\([0-9]+\\) (\\(\\S-+\\) vs\\. \\(\\S-+\\)) Creating [^ ]+ \\([^ ]+\\).*}"
 312          (function
 313           (lambda ()
 314             (let ((game-number (string-to-number (match-string 1)))
 315                   (white (match-string-no-properties 2))
 316                   (black (match-string-no-properties 3)))
 317               (message "Creating game %d (%s vs. %s)" game-number white black)
 318               (chess-ics-game game-number :White white :Black black)))))
 319    (cons "^<10>$" (function (lambda () (chess-ics-send "style 12\nrefresh"))))
 320    (cons "^Game \\([0-9]+\\): \\S-+ backs up \\([0-9]+\\).$"
 321          (function
 322           (lambda ()
 323             (chess-game-undo (chess-ics-game (string-to-number (match-string 1)))
 324                              (string-to-number (match-string 2))))))
 325    (cons chess-ics-style12-regexp #'chess-ics-handle-style12)
 326    (cons "Removing game \\([0-9]+\\) from observation list.$"
 327          (function
 328           (lambda ()
 329             (chess-ics-game-destroy (string-to-number (match-string 1))))))
 330    (cons "You are no longer examining game \\([0-9]+\\).$"
 331          (function
 332           (lambda ()
 333             (chess-ics-game-destroy (string-to-number (match-string 1))))))
 334    (cons "^Movelist for game \\([0-9]+\\):$"
 335          (function
 336           (lambda ()
 337             (if (or chess-ics-movelist-game-number
 338                     chess-ics-movelist-game)
 339                 (message "[movelist] left-over movelist-game[-number]")
 340               (setq chess-ics-movelist-game-number
 341                     (string-to-number (match-string 1)))))))
 342    (cons "^Move\\s-+\\*?\\(\\S-+\\)\\s-+\\*?\\(\\S-+\\)\\s-*$"
 343          (function
 344           (lambda ()
 345             (if (not chess-ics-movelist-game-number)
 346                 (progn
 347                   (goto-char (match-beginning 0))
 348                   (insert "(no game# known) "))
 349               (setq chess-ics-movelist-game
 350                     (chess-ics-game chess-ics-movelist-game-number
 351                                     :White (match-string 1)
 352                                     :Black (match-string 2)))
 353               (when chess-ics-movelist-start-position
 354               (chess-game-set-start-position
 355                chess-ics-movelist-game chess-ics-movelist-start-position)))
 356             t)))
 357    ;; Movelist item
 358    (cons (concat "^\\s-*\\([0-9]+\\)\\.\\s-+\\(" chess-algebraic-regexp "\\)"
 359                  "\\s-+\\(([0-9][0-9]?:[0-9][0-9])\\)\\s-*"
 360                  "\\(\\(" chess-algebraic-regexp "\\)\\s-+"
 361                  "\\(([0-9][0-9]?:[0-9][0-9])\\)\\s-*\\)?$")
 362          #'chess-ics-handle-movelist-item)
 363    (cons "\\s-+{Still in progress}\\s-+\\*$"
 364          (function
 365           (lambda ()
 366             (if (integerp chess-ics-movelist-game-number)
 367                 (setq chess-ics-movelist-game-number nil
 368                       chess-ics-movelist-game nil)
 369               (message "[movelist] end of movelist seen where no game known about")))))
 370    (cons "\\S-+ would like to take back \\([0-9]+\\) half move(s)."
 371          (function
 372           (lambda ()
 373             (funcall chess-engine-response-handler 'undo
 374                      (string-to-number (match-string 1))))))
 375    (cons "The game has been aborted on move [^.]+\\."
 376          (function
 377           (lambda ()
 378             (let ((chess-engine-pending-offer 'abort))
 379               (funcall chess-engine-response-handler 'accept)))))
 380    (cons "\\S-+ accepts the takeback request\\."
 381          (function
 382           (lambda ()
 383             (funcall chess-engine-response-handler 'accept))))
 384    (cons ;; resign announcement
 385     "{Game \\([0-9]+\\) (\\(\\S-+\\) vs\\. \\(\\S-+\\)) \\(\\S-+\\) resigns}"
 386     (function
 387      (lambda ()
 388        (let ((chess-engine-handling-event t)
 389              (opponent-p (not (string= chess-ics-handle (match-string 4))))
 390              (game (chess-ics-game (string-to-number (match-string 1))
 391                                    :White (match-string 2)
 392                                    :Black (match-string 3))))
 393          (with-current-buffer (chess-game-data game 'engine)
 394            (if opponent-p
 395                (funcall chess-engine-response-handler 'resign)
 396              (unless (chess-game-status game)
 397                (chess-game-end game :resign))))
 398          t))))
 399    (cons "\\(\\S-+\\) forfeits on time}"
 400          (function
 401           (lambda ()
 402             (if (string= (match-string 1) chess-engine-opponent-name)
 403                 (funcall chess-engine-response-handler 'flag-fell)
 404               (funcall chess-engine-response-handler 'call-flag t)))))
 405    (cons "Illegal move (\\([^)]+\\))\\."
 406          (function
 407           (lambda ()
 408             (funcall chess-engine-response-handler 'illegal
 409                      (match-string 1)))))
 410    (cons "Challenge: \\(\\S-+\\) \\S-+ \\S-+ \\S-+ .+"
 411          (function
 412           (lambda ()
 413             (let ((opponent (match-string 1)))
 414               (if (y-or-n-p (chess-string 'want-to-play opponent))
 415                   (chess-ics-send (concat "accept " opponent))
 416                 (chess-ics-send "decline match"))))))
 417    ;; Buttonize URLs.
 418    (cons "\"?\\(\\(https?\\|ftp\\)://[^ \t\n\r\"]+\\)\"?"
 419          (function
 420           (lambda ()
 421             (make-button (match-beginning 1) (match-end 1)
 422                          'action (lambda (button)
 423                                    (browse-url (button-label button))))))))
 424   "An alist of regular expressions to use to scan ICS server output.
 425 The car of each element is the regexp to try, and the cdr is a function
 426 to run whenever the regexp matches.")
 427
 428 (defvar chess-ics-sessions nil
 429   "A list of chess-sessions spawned from an Internet Chess Server connection.
 430 See `chess-ics-game'.")
 431 (make-variable-buffer-local 'chess-ics-sessions)
 432
 433 (defun chess-ics-game (game-number &rest tags)
 434   "Either create, or retrieve an existing game object with GAME-NUMBER."
 435   (cl-assert (integerp game-number))
 436   (cl-assert (or (zerop (logand (length tags) 1)) (eq (car tags) t)))
 437   (or
 438    ;; First try to find a game which matches the constraints in TAGS
 439    (catch 'ics-game
 440      (let ((sessions chess-ics-sessions))
 441        (while sessions
 442          (if (not (buffer-live-p (caar sessions)))
 443              (message "Found dead engine session in `chess-ics-sessions'")
 444            (let ((game (chess-engine-game (caar sessions)))
 445                  (tag-pairs tags))
 446              (when (= game-number (chess-game-data game 'ics-game-number))
 447                (if (or (null tags) (eq (car tags) t))
 448                    (throw 'ics-game game)
 449                  (while tag-pairs
 450                    (cl-assert (symbolp (car tag-pairs)))
 451                    (let ((tag (substring (symbol-name (car tag-pairs)) 1))
 452                          (val (cadr tag-pairs)))
 453                      (cl-assert (stringp val))
 454                      (if (string= (chess-game-tag game tag) val)
 455                          (setq tag-pairs (cddr tag-pairs))
 456                        (if (not (string= (chess-game-tag game tag) "?"))
 457                            (message "Game %d %s %s != %s"
 458                                   game-number tag (chess-game-tag game tag) val))
 459                        ;; Update tag and proceed
 460                        (chess-game-set-tag game tag val)
 461                        (setq tags (cddr tags)))))
 462                  (throw 'ics-game game)))))
 463          (setq sessions (cdr sessions)))))
 464    ;; if we are allowed to, create a new session for this game number
 465    (unless (eq (car tags) t)
 466      (push (let (chess-engine-handling-event)
 467              (chess-session 'chess-ics))
 468            chess-ics-sessions)
 469      (cl-assert (caar chess-ics-sessions))
 470      (let ((game (chess-engine-game (caar chess-ics-sessions))))
 471        (chess-game-set-data game 'ics-game-number game-number)
 472        (chess-game-set-data game 'ics-buffer (current-buffer))
 473        (chess-game-set-tag game "Site" chess-ics-server)
 474        (while tags
 475          (cl-assert (keywordp (car tags)))
 476          (chess-game-set-tag
 477           game (substring (symbol-name (car tags)) 1) (cadr tags))
 478          (setq tags (cddr tags)))
 479        game))))
 480
 481 (defun chess-ics-game-destroy (game-number &rest tags)
 482   (let ((sessions chess-ics-sessions)
 483         last-session)
 484     (while sessions
 485       (if (not (buffer-live-p (caar sessions)))
 486           (message "Found dead engine session in `chess-ics-sessions'")
 487         (let ((game (chess-display-game (cl-cadar sessions)))
 488               (tag-pairs tags)
 489               (found t))
 490           (when (= game-number (chess-game-data game 'ics-game-number))
 491             (if (null tags)
 492                 (progn
 493                   (chess-display-destroy (cl-cadar sessions))
 494                   (if last-session
 495                       (setcdr last-session (cdr sessions))
 496                     (setq chess-ics-sessions (cdr sessions))))
 497               (while (and tag-pairs found)
 498                 (cl-assert (symbolp (car tag-pairs)))
 499                 (let ((tag (substring (symbol-name (car tag-pairs)) 1))
 500                       (val (cadr tag-pairs)))
 501                   (cl-assert (stringp val))
 502                   (if (string= (chess-game-tag game tag) val)
 503                       (setq tag-pairs (cddr tag-pairs))
 504                     (setq found nil))))
 505               (if (not found)
 506                   (error "Game not found")
 507                 (chess-engine-destroy (cl-cadar sessions))
 508                 (if last-session
 509                     (setcdr last-session (cdr sessions))
 510                   (setq chess-ics-sessions (cdr sessions))))))))
 511       (setq last-session sessions
 512             sessions (cdr sessions)))))
 513
 514 (defun chess-ics-handle-movelist-item ()
 515   ;; TBD: time taken per ply
 516   (let ((chess-engine-handling-event t)
 517         (seq (string-to-number (match-string 1)))
 518         (wmove (match-string 2))
 519         (bmove (match-string 14))
 520         (game chess-ics-movelist-game))
 521     (when game
 522       (if (/= (chess-game-seq game) seq)
 523           (progn
 524             (goto-char (match-beginning 0))
 525             (insert (format "SeqNr. unmatched (%d): " seq)))
 526         (when (chess-pos-side-to-move (chess-game-pos game))
 527           (chess-game-move
 528            game (chess-algebraic-to-ply (chess-game-pos game) wmove))
 529           (when bmove
 530             (chess-game-move
 531              game (chess-algebraic-to-ply (chess-game-pos game) bmove))))))
 532     t))
 533
 534 ;; ICS style12 format (with artificial line breaks):
 535 ;;
 536 ;; <12> rnbqkbnr pppppppp -------- -------- \
 537 ;;      -------- -------- PPPPPPPP RNBQKBNR W -1 1 1 1 1 0 \
 538 ;;      65 jwiegley GuestZYNJ 1 5 0 39 39 300 300 1 P/e2-e4 (0:00) e4 0 0 0
 539
 540 (defun chess-ics-handle-style12 ()
 541   "Handle an ICS Style12 board string."
 542   (let* ((chess-engine-handling-event t)
 543          (begin (match-beginning 0))
 544          (end (match-end 0))
 545          (position (let ((pos (chess-pos-create t)))
 546                      (dotimes (r 8)
 547                        (let ((rank (match-string (1+ r))))
 548                          (dotimes (f 8)
 549                            (unless (= (aref rank f) ?-)
 550                              (chess-pos-set-piece
 551                               pos (chess-rf-to-index r f) (aref rank f))))))
 552                      (chess-pos-set-side-to-move pos (string= (match-string 9) "W"))
 553                      (let ((file (string-to-number (match-string 10))))
 554                        (when (>= file 0)
 555                          (chess-pos-set-en-passant
 556                           pos (chess-rf-to-index
 557                                (if (chess-pos-side-to-move pos) 3 4) file))))
 558                      (mapc (lambda (info)
 559                              (if (string= (match-string (cdr info)) "1")
 560                                  (chess-pos-set-can-castle pos (car info) t)))
 561                            '((?K . 11) (?Q . 12) (?k . 13) (?q . 14))) pos))
 562          (game (save-match-data
 563                  (chess-ics-game (string-to-number (match-string 16))
 564                                  :White (match-string 17)
 565                                  :Black (match-string 18))))
 566          (status
 567           ;; my relation to this game:
 568           ;; -3 isolated position, such as for "ref 3" or the "sposition"
 569           ;;    command
 570           ;; -2 I am observing game being examined
 571           ;;  2 I am the examiner of this game
 572           ;; -1 I am playing, it is my opponent's move
 573           ;;  1 I am playing and it is my move
 574           ;;  0 I am observing a game being played
 575           (string-to-number (match-string 19))))
 576     (when (or (= status 2) (= status -2) (= status 0))
 577       (chess-game-set-data game 'my-color (chess-pos-side-to-move position)))
 578     ;; initial time and increment (in seconds) of the match
 579     (chess-game-set-tag
 580      game "TimeControl" (format "%s/%s" (match-string 20) (match-string 21)))
 581     ;; material values for each side
 582     (let ((centipawn (* 100 (- (string-to-number (match-string 22))
 583                                (string-to-number (match-string 23))))))
 584       (chess-pos-set-epd position 'ce (if (chess-pos-side-to-move position)
 585                                           centipawn (- centipawn))))
 586     ;; White's and Black's remaining time
 587     (chess-game-set-data game 'white-remaining (string-to-number (match-string 24)))
 588     (chess-game-set-data game 'black-remaining (string-to-number (match-string 25)))
 589     (let ((index (- (* (string-to-number (match-string 26)) 2)
 590                     (if (eq (chess-game-data game 'black-moved-first) t)
 591                         (if (chess-pos-side-to-move position) 3 2)
 592                       (if (chess-pos-side-to-move position) 2 1))))
 593           (move (unless (string= (match-string 29) "none")
 594                   (cl-case (aref (match-string 29) (1- (length (match-string 29))))
 595                     (?+ (chess-pos-set-status position :check))
 596                     (?# (chess-pos-set-status position :checkmate)
 597                         (chess-pos-set-epd position 'ce 32767)))
 598                   ;; jww (2002-04-30): what about stalemate?  do I need to
 599                   ;; calculate this each time?
 600                   (when nil
 601                     (chess-pos-set-status position :stalemate))
 602                   (match-string 29)))
 603           error)
 604       (unwind-protect
 605           (if move
 606               (if (progn (setq error 'comparing-index)
 607                          (= (1- index) (chess-game-index game)))
 608                   (let ((ply (progn (setq error 'converting-ply)
 609                                     (chess-algebraic-to-ply
 610                                      (chess-game-pos game) move t))))
 611                     ;; each move gives the _position occurring after the ply_
 612                     (if (progn (setq error 'comparing-colors)
 613                                (eq (chess-pos-side-to-move position)
 614                                    (chess-game-data game 'my-color)))
 615                         (setq error 'applying-opponent-move)
 616                       (setq error 'applying-my-move))
 617                     ;; save us from generating a position we already have
 618                     (chess-ply-set-keyword ply :next-pos position)
 619                     (chess-pos-set-preceding-ply position ply)
 620                     ;; apply the move
 621                     (chess-game-move game ply)
 622                     (setq error nil))
 623                 (if (= index (chess-game-index game))
 624                     ;; this is a refresh, which we can use to verify that our
 625                     ;; notion of the game's current position is correct
 626                     (let ((their-fen (chess-pos-to-fen position))
 627                           (our-fen (chess-pos-to-fen (chess-game-pos game))))
 628                       (if (string= their-fen our-fen)
 629                           (setq error nil) ; ignore the refresh
 630                         (setq error
 631                               (format "comparing-position (%s != %s)"
 632                                       their-fen our-fen))))
 633                   (if (and (> index (1+ (chess-game-index game)))
 634                            (= 1 (chess-game-seq game)))
 635                       ;; we lack a complete game, try to get it via the
 636                       ;; movelist
 637                       (progn
 638                         (setq error nil)
 639                         (chess-ics-send
 640                          (format "moves %d"
 641                                  (chess-game-data game 'ics-game-number))))
 642                     (setq error
 643                           (format "comparing-index (%d:%d)"
 644                                   index (chess-game-index game))))))
 645             ;; no preceeding ply supplied, so this is a starting position
 646             (let ((chess-game-inhibit-events t)
 647                   (color (chess-pos-side-to-move position)))
 648               (when (or (= 1 status) (= -1 status))
 649                 (chess-game-set-data game 'my-color (if (= 1 status)
 650                                                         color (not color)))
 651                 (chess-game-set-data game 'active t))
 652               (setq error 'setting-start-position)
 653               (chess-game-set-start-position game position)
 654               (chess-game-set-data game 'black-moved-first (not color)))
 655             (setq error 'orienting-board)
 656             (chess-game-run-hooks game 'orient)
 657             (setq error nil))
 658         (goto-char begin)
 659         (if error
 660             (insert (chess-string 'failed-ics-parse error))
 661           (delete-region begin end)
 662           (save-excursion
 663             (while (and (forward-line -1)
 664                         (or (looking-at "^[ \t]*$")
 665                             (looking-at "^[^% \t\n\r]+%\\s-*$")))
 666               (delete-region (match-beginning 0) (1+ (match-end 0)))))
 667           ;; we need to counter the forward-line in chess-engine-filter
 668           (forward-line -1)))
 669       t)))
 670
 671 (defvar chess-ics-sought-parent-buffer nil
 672   "Contains the buffer from which this seektable originates.")
 673 (make-variable-buffer-local 'chess-ics-sought-parent-buffer)
 674
 675 (defun chess-ics-sought-accept (button)
 676   "Perform the action specified by a BUTTON."
 677   (let ((buffer (button-get button 'ics-buffer))
 678         (command (button-get button 'ics-command)))
 679     (when (and (buffer-live-p buffer) (stringp command))
 680       (chess-ics-send command buffer)
 681       t)))
 682
 683 (defcustom chess-ics-popup-sought t
 684   "If non-nil, display the sought buffer automatically."
 685   :group 'chess-ics
 686   :type 'boolean)
 687
 688 (defcustom chess-ics-sought-buffer-name "*chess-ics-sought*"
 689   "The name of the buffer which accumulates seek ads."
 690   :group 'chess-ics
 691   :type 'string)
 692
 693 (define-derived-mode chess-ics-ads-mode tabulated-list-mode "ICSAds"
 694   "Mode for displaying sought games from Internet Chess Servers."
 695   :group 'chess-ics
 696   (setq tabulated-list-format [("Player" 20 t)
 697                                ("Rating" 10 t :right-align t)
 698                                ("Rated" 5 nil :right-align t)
 699                                ("Time" 4 t :right-align t)
 700                                ("Inc" 4 t)
 701                                ("Variant" 40 t)])
 702   (setq tabulated-list-entries nil)
 703   (tabulated-list-init-header)
 704   (tabulated-list-print))
 705
 706 (defun chess-ics-sought-add (id name rating rated time inc variant
 707                              ics-buffer cmd)
 708   (let ((inhibit-redisplay t))
 709     (with-current-buffer
 710       (or (get-buffer chess-ics-sought-buffer-name)
 711           (with-current-buffer (get-buffer-create
 712                                 chess-ics-sought-buffer-name)
 713             (chess-ics-ads-mode)
 714             (and chess-ics-popup-sought (display-buffer (current-buffer)))
 715             (current-buffer)))
 716       (setq chess-ics-sought-parent-buffer ics-buffer)
 717       (add-to-list 'tabulated-list-entries
 718                    (list id
 719                          (vector (list name
 720                                        'ics-buffer ics-buffer
 721                                        'ics-command cmd
 722                                        'action #'chess-ics-sought-accept)
 723                                  (number-to-string rating)
 724                                  rated
 725                                  (number-to-string time)
 726                                  (number-to-string inc)
 727                                  variant)))
 728       (tabulated-list-revert))))
 729
 730 (defun chess-ics-seeking (string)
 731   ;; jww (2008-09-02): we should use rx for this regular expression also
 732   (while (string-match
 733           (concat "[\n\r]+\\(\\S-+\\) (\\([0-9+ -]+\\)) seeking \\([a-z]\\S-+ \\)?\\([0-9]+\\) \\([0-9]+\\) \\(\\(un\\)?rated\\) \\([^(]*\\)(\"\\([^\"]+\\)\" to respond)\\s-*[\n\r]+"
 734                   chess-ics-prompt-regexp)
 735           string)
 736     (let* ((pre (substring string 0 (match-beginning 0)))
 737            (post (substring string (match-end 0))))
 738       (chess-ics-sought-add (string-to-number (substring (match-string 9 string) 5))
 739                             (match-string 1 string)
 740                             (string-to-number (match-string 2 string))
 741                             (if (string= (match-string 6 string) "rated")
 742                                 "yes" "no")
 743                             (string-to-number (match-string 4 string))
 744                             (string-to-number (match-string 5 string))
 745                             (concat
 746                              (if (match-string 3 string)
 747                                  (concat (match-string 3 string) " ") "")
 748                              (match-string 8 string))
 749                             (current-buffer)
 750                             (match-string 9 string))
 751       (setq string (concat pre post))))
 752   string)
 753
 754 (defun chess-ics-ads-removed (string)
 755   "Look for Seek ad removal announcements in the output stream.
 756 This function should be put on `comint-preoutput-filter-functions'."
 757   (let (ids)
 758     (while (string-match
 759             (concat "[\n\r]+Ads removed: \\([0-9 ]+\\)\\s-*[\n\r]+"
 760                     chess-ics-prompt-regexp)
 761             string)
 762       (setq ids (append (mapcar #'string-to-number
 763                                 (save-match-data
 764                                   (split-string (match-string 1 string) " +")))
 765                         ids)
 766             string (concat (substring string 0 (match-beginning 0))
 767                            (substring string (match-end 0)))))
 768     (when ids
 769       (let ((buf (get-buffer chess-ics-sought-buffer-name))
 770             (inhibit-redisplay t))
 771         (when (buffer-live-p buf)
 772           (with-current-buffer buf
 773             (let ((old-length (length tabulated-list-entries)))
 774               (setq tabulated-list-entries
 775                     (cl-remove-if (lambda (entry) (member (car entry) ids))
 776                                   tabulated-list-entries))
 777               (when (/= (length tabulated-list-entries) old-length)
 778                 (tabulated-list-revert))))))))
 779   string)
 780
 781 (make-variable-buffer-local 'comint-preoutput-filter-functions)
 782
 783 ;;;###autoload
 784 (defun chess-ics (server port &optional handle password-or-filename
 785                          helper &rest helper-args)
 786   "Connect to an Internet Chess Server."
 787   (interactive
 788    (let ((args (if (= (length chess-ics-server-list) 1)
 789                    (car chess-ics-server-list)
 790                  (assoc (completing-read (chess-string 'ics-server-prompt)
 791                                          chess-ics-server-list
 792                                          nil t (caar chess-ics-server-list))
 793                         chess-ics-server-list))))
 794      (if (and (nth 2 args) (not (nth 3 args)))
 795          (append (list (nth 0 args) (nth 1 args) (nth 2 args)
 796                        (read-passwd "Password: ")
 797                        (nth 4 args))
 798                  (nthcdr 5 args))
 799        args)))
 800   (unless handle
 801     (setq handle "guest"))
 802   (chess-message 'ics-connecting server)
 803   (let ((buf (if helper
 804                  (apply 'make-comint "chess-ics" helper nil helper-args)
 805                (make-comint "chess-ics" (cons server port)))))
 806     (chess-message 'ics-connected server)
 807     (set-buffer buf)
 808     (setq chess-ics-server server
 809           chess-ics-handle handle
 810           chess-ics-password
 811           (if (and password-or-filename
 812                    (file-readable-p password-or-filename))
 813               (with-temp-buffer
 814                 (insert-file-contents password-or-filename)
 815                 (buffer-string))
 816             password-or-filename)
 817           chess-ics-handling-login t
 818           chess-engine-regexp-alist (copy-alist chess-ics-matcher-alist)
 819           comint-prompt-regexp "^[^%\n]*% *"
 820           comint-scroll-show-maximum-output t)
 821     (add-hook 'comint-output-filter-functions 'chess-engine-filter t t)
 822     (setq comint-preoutput-filter-functions
 823           '(chess-ics-ads-removed chess-ics-seeking))
 824     (let ((ntimes 50))
 825       (while (and chess-ics-handling-login
 826                   (> (setq ntimes (1- ntimes)) 0))
 827         (accept-process-output (get-buffer-process (current-buffer)) 0 100)))
 828     (switch-to-buffer buf)))
 829
 830 ;;;###autoload
 831 (define-key menu-bar-games-menu [chess-ics] '(menu-item "Internet Chess Servers" chess-ics :help "Play Chess on the Internet"))
 832
 833 ;;; ICC datagrams
 834
 835 ;; See http://www.chessclub.com/resources/formats/formats.txt
 836
 837 (defvar chess-icc-unprocessed nil)
 838
 839 (defun chess-icc-datagram-handler (string)
 840   (if (not (string-match "^\\([0-9]+\\) \\(.*\\)$" string))
 841       (format "\nUnknown datagram format: %s\n" string)
 842     (let ((chess-engine-handling-event t)
 843           (dg (string-to-number (match-string 1 string)))
 844           (args (match-string 2 string)))
 845       (cond
 846        ((and (or (= dg 22) (= dg 23))
 847              (string-match "\\([0-9]+\\) \\([1-9][0-9]*\\)" args))
 848         (chess-game-undo (chess-ics-game (string-to-number (match-string 1 args)))
 849                          (string-to-number (match-string 2 args)))
 850         "")
 851        ((and (or (= dg 101) (= dg 110))
 852              (string-match "\\([0-9]+\\) {\\(.+\\) \\(?:[0-9]+\\) \\(?:[0-9]+\\)} \\([0-9]+\\)" args))
 853         (let ((pos (chess-fen-to-pos (match-string 2 args))))
 854           (chess-game-set-start-position
 855            (chess-ics-game (string-to-number (match-string 1 args))) pos))
 856         "")
 857        ((and (or (= dg 24) (= dg 111))
 858              (string-match "^\\([0-9]+\\) \\(.+\\)$" args))
 859         (let* ((move (match-string 2 args))
 860                (game (chess-ics-game (string-to-number (match-string 1 args))))
 861                (pos (chess-game-pos game))
 862                (ply (chess-algebraic-to-ply pos move)))
 863           (chess-game-move game ply)
 864           ""))
 865        ((and (= dg 26)
 866              (string-match "^\\([0-9]+\\) \\(\\S-+\\) {\\([^}]*\\)} \\([01]\\) \19{\\(.*\\)\19}"
 867                            args))
 868         (let ((game-number (match-string 1 args))
 869               (action (if (string= (match-string 4 args) "1")
 870                           "kibitzes" "whispers"))
 871               (name (match-string 2 args))
 872               (titles (match-string 3 args))
 873               (text (match-string 5 args)))
 874           (setq name
 875                 (concat name
 876                         (mapconcat (lambda (title)
 877                                      (concat "(" title ")"))
 878                                    (split-string titles " ") "")))
 879           (format "\n%s[%s] %s: %s\n" name game-number action text)))
 880        ((and (= dg 56)
 881              (string-match "^\\([0-9]+\\) \\([WB]\\) \\([0-9]+\\) \\([01]\\)"
 882                            args))
 883         (let ((sec (/ (string-to-number (match-string 3 args)) 1000))
 884               (color (if (string= (match-string 2 args) "W")
 885                          'white-remaining 'black-remaining))
 886               (game (chess-ics-game (string-to-number (match-string 1 args)))))
 887           (chess-game-set-data game color sec))
 888         "")
 889        ((and (= dg 50)
 890              (string-match "^\\([0-9]+\\) \\(\\S-+\\) {\\([^}]*\\)} \\([0-9]+\\) \\([0-2]\\) \\([0-9]+\\) \\(\\S-+\\) \\([0-9]+\\) \\([0-9]+\\) \\([01]\\) \\(-?[01]\\) \\([0-9]+\\) \\([0-9]+\\) \\([01]\\) \\([01]\\) {\\([^}]*\\)}" args))
 891         (chess-ics-sought-add
 892          (string-to-number (match-string 1 args))
 893          (concat (match-string 2 args)
 894                  (if (not (string= (match-string 3 args) ""))
 895                      (format "(%s)" (match-string 3 args))
 896                    ""))
 897          (string-to-number (match-string 4 args))
 898          (if (string= (match-string 10 args) "1") "yes" "no")
 899          (string-to-number (match-string 8 args))
 900          (string-to-number (match-string 9 args))
 901          (concat (match-string 7 args)
 902                  (if (not (string= (match-string 6 args) "0"))
 903                      (concat " " (match-string 6 args)) "")
 904                  (if (string= (match-string 14 args) "0")
 905                      " m" "")
 906                  (if (string= (match-string 15 args) "1")
 907                      " f" ""))
 908          (current-buffer)
 909          (concat "play " (match-string 1 args)))
 910         "")
 911        ((= dg 51)
 912         (let ((id (string-to-number (car (split-string args " +"))))
 913               (buf (get-buffer chess-ics-sought-buffer-name)))
 914           (when (buffer-live-p buf)
 915             (with-current-buffer buf
 916               (setq tabulated-list-entries
 917                     (cl-remove-if (lambda (entry) (equal (car entry) id))
 918                                   tabulated-list-entries))
 919               (tabulated-list-revert))))
 920         "")
 921        (t
 922         (format "\nIgnoring unhandled datagram DG%03d: %s\n" dg args))))))
 923
 924 (defun chess-icc-preoutput-filter (string)
 925   (if chess-icc-unprocessed
 926       (let ((string (concat chess-icc-unprocessed string)))
 927         (if (string-match "\19)" string)
 928             (let ((newstr (unwind-protect
 929                               (chess-icc-datagram-handler
 930                                (substring string 0 (match-beginning 0)))
 931                             (setq chess-icc-unprocessed nil))))
 932               (chess-icc-preoutput-filter (concat (or newstr "")
 933                                                   (substring string
 934                                                              (match-end 0)))))
 935           (setq chess-icc-unprocessed string)
 936           ""))
 937     (if (string-match "\19(" string)
 938         (let ((pre (substring string 0 (match-beginning 0)))
 939               (substr (substring string (match-end 0))))
 940           (if (string-match "\19)" substr)
 941               (let ((post (substring substr (match-end 0)))
 942                     (newstr (chess-icc-datagram-handler
 943                              (substring substr 0 (match-beginning 0)))))
 944                 (chess-icc-preoutput-filter (concat pre newstr post)))
 945             (setq chess-icc-unprocessed substr)
 946             pre))
 947       string)))
 948
 949 (defun chess-ics-icc-preoutput-filter (string)
 950   (while (string-match "\19(\\([0-9]+\\) \\(.*?\\)\19)" string)
 951     (let ((dg (string-to-number (match-string 1 string)))
 952           (args (match-string 2 string))
 953           (pre (substring string 0 (match-beginning 0)))
 954           (post (substring string (match-end 0))))
 955       (cond
 956        ((and (or (= dg 101) (= dg 110))
 957              (string-match "\\([0-9]+\\) {\\(.+\\) \\(?:[0-9]+\\) \\(?:[0-9]+\\)} \\([0-9]+\\)" args))
 958         (let ((pos (chess-fen-to-pos (match-string 2 args))))
 959           (chess-game-set-start-position
 960            (chess-ics-game (string-to-number (match-string 1 args))) pos))
 961         (setq string (concat pre post)))
 962        ((and (or (= dg 24) (= dg 111))
 963              (string-match "\\([0-9]+\\) \\(.+\\)$" args))
 964         (let* ((chess-engine-handling-event t)
 965                (move (match-string 2 args))
 966                (game (chess-ics-game (string-to-number (match-string 1 args))))
 967                (pos (chess-game-pos game))
 968                (ply (chess-algebraic-to-ply pos move)))
 969           (if ply
 970               (chess-game-move game ply)
 971             (setq pre (format "%s\nunable to apply move %s\n" pre move))))
 972         (setq string (concat pre post)))
 973        ((and (= dg 26)
 974              (string-match "\\([0-9]+\\) \\(\\S-+\\) {\\([^}]*\\)} \\([01]\\) \19{\\(.*\\)\19}"
 975                            args))
 976         (let ((game-number (match-string 1 args))
 977               (action (if (string= (match-string 4 args) "1")
 978                           "kibitzes" "whispers"))
 979               (name (match-string 2 args))
 980               (titles (match-string 3 args))
 981               (text (match-string 5 args)))
 982           (setq name
 983                 (concat name
 984                         (mapconcat (lambda (title)
 985                                      (concat "(" title ")"))
 986                                    (split-string titles " ") "")))
 987           (setq string
 988                 (format "%s\n%s[%s] %s: %s\n%s"
 989                         pre name game-number action text post))))
 990        ((and (= dg 56)
 991              (string-match "\\([0-9]+\\) \\([WB]\\) \\([0-9]+\\) \\([01]\\)"
 992                            args))
 993         (let ((sec (/ (string-to-number (match-string 3 args)) 1000))
 994               (color (if (string= (match-string 2 args) "W")
 995                          'white-remaining 'black-remaining))
 996               (game (chess-ics-game (string-to-number (match-string 1 args)))))
 997           (chess-game-set-data game color sec))
 998         (setq string (concat pre post)))
 999        ((and (= dg 50)
1000              (string-match "\\([0-9]+\\) \\(\\S-+\\) {\\([^}]*\\)} \\([0-9]+\\) \\([0-2]\\) \\([0-9]+\\) \\(\\S-+\\) \\([0-9]+\\) \\([0-9]+\\) \\([01]\\) \\(-?[01]\\) \\([0-9]+\\) \\([0-9]+\\) \\([01]\\) \\([01]\\) {\\([^}]*\\)}" args))
1001         (chess-ics-sought-add
1002          (match-string 1 args)
1003          (concat (match-string 2 args)
1004                  (if (not (string= (match-string 3 args) ""))
1005                      (format "(%s)" (match-string 3 args))
1006                    ""))
1007          (string-to-number (match-string 4 args))
1008          (if (string= (match-string 10 args) "1")
1009              "yes" "no")
1010          (string-to-number (match-string 8 args))
1011          (string-to-number (match-string 9 args))
1012          (concat (match-string 7 args)
1013                  (if (not (string= (match-string 6 args) "0"))
1014                      (concat " " (match-string 6 args)) "")
1015                  (if (string= (match-string 14 args) "0")
1016                      " m" "")
1017                  (if (string= (match-string 15 args) "1")
1018                      " f" ""))
1019          (current-buffer)
1020          (concat "play " (match-string 1 args)))
1021         (setq string (concat pre post)))
1022        ((= dg 51)
1023         (let ((id (car (split-string args " ")))
1024               (buf (get-buffer chess-ics-sought-buffer-name)))
1025           (when (buffer-live-p buf)
1026             (with-current-buffer buf
1027               (let ((here (point)))
1028                 (goto-char (point-min))
1029                 (when (re-search-forward (concat "^" id " ") nil t)
1030                   (delete-region (line-beginning-position)
1031                                  (1+ (line-end-position))))
1032                 (goto-char here)))))
1033         (setq string (concat pre post)))
1034        (t
1035         (message "Ignoring Datagram %03d: %s" dg args)
1036         (setq string (concat pre post))))))
1037   string)
1038
1039 (defun chess-ics-handler (game event &rest args)
1040   (unless chess-engine-handling-event
1041     (cond
1042      ((eq event 'initialize))
1043
1044      ((eq event 'ready)
1045       (chess-game-run-hooks game 'announce-autosave))
1046
1047      ((eq event 'busy))                 ; ICS will inform them
1048
1049      ((eq event 'match)
1050       (setq chess-engine-pending-offer 'match)
1051       (chess-engine-send
1052        nil (format "match %s\n"
1053                    (read-string (chess-string 'challenge-whom)))))
1054
1055      ;; we need to send long algebraic notation to the ICS server, not short
1056      ((eq event 'move)
1057       (let ((ply (car args)))
1058         (chess-ics-send
1059          (if (chess-ply-any-keyword ply :castle :long-castle)
1060              (chess-ply-to-algebraic ply)
1061            (concat (chess-index-to-coord (chess-ply-source ply))
1062                    "-"
1063                    (chess-index-to-coord (chess-ply-target ply))
1064                    (if (characterp (chess-ply-keyword ply :promote))
1065                        (format "=%c" (chess-ply-keyword ply :promote))
1066                      "")))
1067          (chess-game-data game 'ics-buffer)))
1068       (if (chess-game-over-p game)
1069           (chess-game-set-data game 'active nil)))
1070
1071      ((eq event 'flag-fell)
1072       (chess-common-handler game 'flag-fell))
1073
1074      ((eq event 'forward)
1075       (chess-ics-send "forward" (chess-game-data game 'ics-buffer)))
1076
1077      ((eq event 'undo)
1078       (chess-ics-send (format "takeback %d" (car args))
1079                       (chess-game-data game 'ics-buffer)))
1080
1081      ((eq event 'abort)
1082       (chess-ics-send "abort" (chess-game-data game 'ics-buffer)))
1083
1084      ((eq event 'call-flag)
1085       (chess-ics-send "flag" (chess-game-data game 'ics-buffer)))
1086
1087      ((eq event 'draw)
1088       (chess-ics-send "draw" (chess-game-data game 'ics-buffer)))
1089
1090      ((eq event 'resign)
1091       (chess-ics-send "resign" (chess-game-data game 'ics-buffer)))
1092
1093      (t
1094       (apply 'chess-network-handler game event args)))))
1095
1096 (provide 'chess-ics)
1097
1098 ;;; chess-ics.el ends here