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