rewrite this module such that it does not act as an engine, rather it invoked chess-sessions as needed. You need to use M-x chess-ics RET instead of C-u M-x chess RET ics RET now. Additionally, rewrite chess-ics-handle-ics12 such that it can handle the refresh command, and moves entered manually in the ICS buffer

1 files changed, 397 insertions, 257 deletions

diff --git a/chess-ics.el b/chess-ics.el
index 265cebb..7cd5bf4 100644
--- a/chess-ics.el
+++ b/chess-ics.el
@@ -1,9 +1,25 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; An engine for interacting with Internet Chess Servers
-;;
-;; jww (2002-04-23): This module has only been tested on FICS.
-;;
+;;; chess-ics.el --- An engine for interacting with Internet Chess Servers
+
+;; Copyright (C) 2002, 2003, 2004  Free Software Foundation, Inc.
+
+;; Author: John Wiegley
+;; Maintainer: Mario Lang <mlang@delysid.org>
+;; Keywords: games, processes
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This file is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 (eval-when-compile (require 'cl))
 
@@ -15,11 +31,10 @@
   "Engine for interacting with Internet Chess Servers."
   :group 'chess-engine)
 
-(defcustom chess-ics-server-list
-  '(("freechess.org" 5000)
-    ("chess.unix-ag.uni-kl.de" 5000)
-    ("chess.mds.mdh.se" 5000)
-    ("chessclub.com" 5000))
+(defcustom chess-ics-server-list '(("freechess.org" 5000)
+				   ("chess.unix-ag.uni-kl.de" 5000)
+				   ("chess.mds.mdh.se" 5000)
+				   ("chessclub.com" 5000))
   "A list of servers to connect to.
 The format of each entry is:
 
@@ -38,7 +53,7 @@ The format of each entry is:
   :group 'chess-ics)
 
 (defvar chess-ics-server nil
-  "The `chess-ics-server-list' entry used for this connection.")
+  "The ICS server name of this connection.")
 (make-variable-buffer-local 'chess-ics-server)
 
 (defvar chess-ics-handle nil
@@ -49,22 +64,50 @@ The format of each entry is:
   "Password to use to identify to the server.")
 (make-variable-buffer-local 'chess-ics-password)
 
-(defvar chess-ics-regexp-alist
+(defvar chess-ics-handling-login nil
+  "Non-nil if we are currently handling the ICS login sequence.")
+(make-variable-buffer-local 'chess-ics-handling-login)
+
+(defvar chess-ics-movelist-game-number nil
+  "If we are about to receive a movelist, this variable is set to the
+game number.")
+(make-variable-buffer-local 'chess-ics-movelist-game-number)
+
+(defvar chess-ics-movelist-game nil
+  "If we are receiving a movelist, this variable is set to the game object.")
+(make-variable-buffer-local 'chess-ics-movelist-game)
+
+(defsubst chess-ics-send (string &optional buffer)
+  "Send STRING to the ICS server."
+  (comint-send-string (get-buffer-process (or buffer (current-buffer)))
+		      (concat string "\n")))
+
+(chess-message-catalog 'english
+  '((ics-server-prompt . "Connect to chess server: ")
+    (ics-connecting    . "Connecting to Internet Chess Server '%s'...")
+    (ics-connected     . "Connecting to Internet Chess Server '%s'...done")
+    (ics-anon-login    . "Logging in on Internet Chess Server '%s' as anonymous user...")
+    (ics-logging-in    . "Logging in on Internet Chess Server '%s' as '%s'...")
+    (ics-logged-in     . "Logging in on Internet Chess Server '%s' as '%s'...done")
+    (challenge-whom    . "Whom would you like challenge? ")
+    (failed-ics-parse  . "Failed to parse ICS move string (%s): %s")))
+
+(defvar chess-ics-matcher-alist
   (list
    (cons "\\(ogin\\|name\\):"
 	 (function
 	  (lambda ()
-	    (chess-engine-send nil (concat chess-ics-handle "\n"))
+	    (if (string= "guest" chess-ics-handle)
+		(chess-message 'ics-anon-login chess-ics-server)
+	      (chess-message
+	       'ics-logging-in chess-ics-server chess-ics-handle))
+	    (chess-ics-send chess-ics-handle)
 	    'once)))
    (cons "[Pp]assword:"
 	 (function
 	  (lambda ()
-	    (chess-engine-send nil (concat chess-ics-password "\n"))
-	    'once)))
-   (cons "%"
-	 (function
-	  (lambda ()
-	    (chess-engine-send nil "set style 12\nset bell 0\n")
+	    (when chess-ics-handling-login
+	      (chess-ics-send chess-ics-password))
 	    'once)))
    (cons "\\(Logging you in as\\|Your name for this session will be\\) \"\\([^\"]+\\)\""
 	 (function
@@ -74,39 +117,95 @@ The format of each entry is:
    (cons "Press return to enter the server as"
 	 (function
 	  (lambda ()
-	    (chess-engine-send nil "\n")
+	    (chess-ics-send "")
 	    'once)))
-   (cons "The game has been aborted on move [^.]+\\."
+   (cons "%\\s-*$"
 	 (function
 	  (lambda ()
-	    (let ((chess-engine-pending-offer 'abort))
-	      (funcall chess-engine-response-handler 'accept)))))
+	    (chess-ics-send "set style 12\nset bell 0")
+	    (setq chess-ics-handling-login nil)
+	    (chess-message 'ics-logged-in chess-ics-server chess-ics-handle)
+	    'once)))
    (cons "{Game \\([0-9]+\\) (\\(\\S-+\\) vs\\. \\(\\S-+\\)) Creating [^ ]+ \\([^ ]+\\).*}"
 	 (function
 	  (lambda ()
 	    (let ((game-number (string-to-int (match-string 1)))
 		  (white (match-string-no-properties 2))
 		  (black (match-string-no-properties 3)))
-	      ;(chess-game-set-tag game "White" white)
-	      ;(chess-game-set-tag game "Black" black)
-	      ;(chess-game-set-tag game "Site" (car chess-ics-server))
-	      ))))
-   (cons "<12>\\s-+\\(\\([BKNPQRbknpqr-]\\{8\\}\\s-\\)\\{8\\}[BW].+\\)"
+	      (message "Creating game %d (%s vs. %s)" game-number white black)
+	      (chess-ics-game game-number :White white :Black black)))))
+   (cons "^<10>$" (function (lambda () (chess-ics-send "style 12\nrefresh"))))
+   (cons "^Game \\([0-9]+\\): \\S-+ backs up \\([0-9]+\\) moves.$"
+	 (function
+	  (lambda ()
+	    (chess-game-undo (chess-ics-game (string-to-int (match-string 1)))
+			     (string-to-int (match-string 2))))))
+   (cons "<12>\\s-+\\(\\([BKNPQRbknpqr-]\\{8\\} \\)\\{8\\}[BW] .+\\)$"
 	 #'chess-ics-handle-ics12)
+   (cons "Removing game \\([0-9]+\\) from observation list.$"
+	 (function
+	  (lambda ()
+	    (chess-game-run-hooks
+	     (chess-ics-game (string-to-int (match-string 1))) 'destroy))))
+   (cons "^Movelist for game \\([0-9]+\\):$"
+	 (function
+	  (lambda ()
+	    (if (or chess-ics-movelist-game-number
+		    chess-ics-movelist-game)
+		(message "[movelist] left-over movelist-game[-number]")
+	      (setq chess-ics-movelist-game-number
+		    (string-to-int (match-string 1)))))))
+   (cons "^Move\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-*$"
+	 (function
+	  (lambda ()
+	    (if (not chess-ics-movelist-game-number)
+		(message "[movelist] no gamenumber but header seen")
+	      (setq chess-ics-movelist-game
+		    (chess-ics-game chess-ics-movelist-game-number
+				    :White (match-string 1)
+				    :Black (match-string 2)))
+	      (chess-game-set-start-position
+	       chess-ics-movelist-game chess-starting-position))
+	    t)))
+   ;; Movelist item
+   (cons (concat "^\\s-*\\([0-9]+\\)\\.\\s-+\\(" chess-algebraic-regexp "\\)"
+		 "\\s-+\\(([0-9][0-9]?:[0-9][0-9])\\)\\s-*"
+		 "\\(\\(" chess-algebraic-regexp "\\)\\s-+"
+		 "\\(([0-9][0-9]?:[0-9][0-9])\\)\\s-*\\)?$")
+	 #'chess-ics-handle-movelist-item)
+   (cons "\\s-+{Still in progress}\\s-+\\*$"
+	 (function
+	  (lambda ()
+	    (if (integerp chess-ics-movelist-game-number)
+		(setq chess-ics-movelist-game-number nil
+		      chess-ics-movelist-game nil)
+	      (message "[movelist] end of movelist seen where no game known about")))))
    (cons "\\S-+ would like to take back \\([0-9]+\\) half move(s)."
 	 (function
 	  (lambda ()
 	    (funcall chess-engine-response-handler 'undo
 		     (string-to-int (match-string 1))))))
+   (cons "The game has been aborted on move [^.]+\\."
+	 (function
+	  (lambda ()
+	    (let ((chess-engine-pending-offer 'abort))
+	      (funcall chess-engine-response-handler 'accept)))))
    (cons "\\S-+ accepts the takeback request\\."
 	 (function
 	  (lambda ()
 	    (funcall chess-engine-response-handler 'accept))))
-   (cons "\\(\\S-+\\) resigns}"
+   (cons "{Game \\([0-9]+\\) (\\(\\S-+\\) vs\\. \\(\\S-+\\)) \\(\\S-+\\) resigns}"
 	 (function
 	  (lambda ()
-	    (if (string= (match-string 1) chess-engine-opponent-name)
-		(funcall chess-engine-response-handler 'resign)))))
+	    (when (not (string= (match-string 4) chess-ics-handle))
+	      (with-current-buffer (chess-game-data
+				    (chess-ics-game
+				     (string-to-int (match-string 1))
+				     :White (match-string 2)
+				     :Black (match-string 3))
+				    'engine)
+		(funcall chess-engine-response-handler 'resign)))
+	    t)))
    (cons "\\(\\S-+\\) forfeits on time}"
 	 (function
 	  (lambda ()
@@ -121,231 +220,284 @@ The format of each entry is:
    (cons "Challenge: \\(\\S-+\\) \\S-+ \\S-+ \\S-+ .+"
 	 (function
 	  (lambda ()
-	    (funcall chess-engine-response-handler 'match
-		     (match-string 1))))))
+	    (let ((opponent (match-string 1)))
+	      (if (y-or-n-p (chess-string 'want-to-play opponent))
+		  (chess-ics-send (concat "accept " opponent))
+		(chess-ics-send "decline match")))))))
   "An alist of regular expressions to use to scan ICS server output.
 The car of each element is the regexp to try, and the cdr is a function
 to run whenever the regexp matches.")
 
-(chess-message-catalog 'english
-  '((ics-server-prompt . "Connect to chess server: ")
-    (ics-connecting    . "Connecting to Internet Chess Server '%s'...")
-    (ics-connected     . "Connecting to Internet Chess Server '%s'...done")
-    (challenge-whom    . "Whom would you like challenge? ")
-    (failed-ics-parse  . "Failed to parse ICS move string (%s): %s")))
+(defvar chess-ics-sessions nil
+  "A list of chess-sessions spawned from an Internet Chess Server connection.
+See `chess-ics-game'.")
+(make-variable-buffer-local 'chess-ics-sessions)
+
+(defun chess-ics-game (game-number &rest tags)
+  "Either create, or retrieve an existing game object with GAME-NUMBER."
+  (assert (integerp game-number))
+  (assert (or (evenp (length tags)) (eq (car tags) t)))
+  (or
+   ;; First try to find a game which matches the constraints in TAGS
+   (catch 'ics-game
+     (mapc
+      (lambda (session)
+	(if (not (buffer-live-p (car session)))
+	    (message "Found dead engine session in `chess-ics-sessions'")
+	  (let ((game (chess-engine-game (car session)))
+		(tag-pairs tags))
+	    (when (= game-number (chess-game-data game 'ics-game-number))
+	      (if (or (null tags) (eq (car tags) t))
+		  (throw 'ics-game game)
+		(while tag-pairs
+		  (assert (symbolp (car tag-pairs)))
+		  (let ((tag (substring (symbol-name (car tag-pairs)) 1))
+			(val (cadr tag-pairs)))
+		    (assert (stringp val))
+		    (if (string= (chess-game-tag game tag) val)
+			(setq tag-pairs (cddr tag-pairs))
+		      (if (not (string= (chess-game-tag game tag) "?"))
+			  (error "Game %d %s %s != %s"
+				 game-number tag (chess-game-tag game tag) val)
+			;; Update tag and proceed
+			(chess-game-set-tag game tag val)
+			(setq tags (cddr tags))))))
+		(throw 'ics-game game)))))) chess-ics-sessions))
+   ;; No matching game was found, create a new one unless TAGS is t
+   (unless (eq (car tags) t)
+     (push (let (chess-engine-handling-event)
+	     (chess-session 'chess-ics))
+	   chess-ics-sessions)
+     (assert (caar chess-ics-sessions))
+     (let ((game (chess-engine-game (caar chess-ics-sessions))))
+       (chess-game-set-data game 'ics-game-number game-number)
+       (chess-game-set-data game 'ics-buffer (current-buffer))
+       (chess-game-set-tag game "Site" chess-ics-server)
+       (while tags
+	 (assert (keywordp (car tags)))
+	 (chess-game-set-tag
+	  game (substring (symbol-name (car tags)) 1) (cadr tags))
+	 (setq tags (cddr tags)))
+       game))))
+
+(defun chess-ics-handle-movelist-item ()
+  ;; TBD: time taken per ply
+  (let ((chess-engine-handling-event t)
+	(seq (string-to-int (match-string 1)))
+	(wmove (match-string 2))
+	(bmove (match-string 14))
+	(game chess-ics-movelist-game))
+    (when (and game
+	       (chess-pos-side-to-move (chess-game-pos game))
+	       (= (chess-game-seq game) seq))
+      (chess-game-set-data game 'my-color nil)
+      (chess-game-move
+       game (chess-algebraic-to-ply (chess-game-pos game) wmove))
+      (when bmove
+	(chess-game-set-data game 'my-color t)
+	(chess-game-move
+	 game (chess-algebraic-to-ply (chess-game-pos game) bmove))))
+    t))
 
 ;; ICS12 format (with artificial line breaks):
 ;;
 ;; <12> rnbqkbnr pppppppp -------- -------- \
-;;      -------- -------- PPPPPPPP RNBQKBNR W \
-;;      -1 1 1 1 1 0 65 jwiegley GuestZYNJ \
-;;      1 5 0 39 39 300 300 1 P/e2-e4 (0:00) e4 0 0 0
+;;      -------- -------- PPPPPPPP RNBQKBNR W -1 1 1 1 1 0 \
+;;      65 jwiegley GuestZYNJ 1 5 0 39 39 300 300 1 P/e2-e4 (0:00) e4 0 0 0
 
 (defun chess-ics-handle-ics12 ()
   "Handle an ICS12 format string."
-  (let ((chess-engine-handling-event t)
-	(begin (match-beginning 0))
-	(end (match-end 0))
-	(parts (split-string (match-string 1) " "))
-	(position (chess-pos-create t))
-	(game (chess-engine-game nil))
-	white black move status time-control error)
-
-    (assert (= (length parts) 32))
-
-    ;; first, handle the layout of the position
-    (dotimes (r 8)
-      (let ((rank (pop parts)))
-	(dotimes (f 8)
-	  (let ((piece (aref rank f)))
-	    (unless (= piece ?-)
-	      (chess-pos-set-piece position (chess-rf-to-index r f) piece))))))
-
-    ;; next, the "side to move"
-    (chess-pos-set-side-to-move position (string= (pop parts) "W"))
-
-    ;; -1 if the previous move was NOT a double pawn push, otherwise
-    ;; the chess board file (numbered 0--7 for a--h) in which the
-    ;; double push was made
-    (let ((file (string-to-number (pop parts))))
-      (when (>= file 0)
-	(chess-pos-set-en-passant
-	 position (chess-rf-to-index
-		   (if (chess-pos-side-to-move position) 3 4) file))))
-
-    ;; can White/Black still castle short/long? (0=no, 1=yes)
-    (mapc (lambda (castle)
-	    (if (string= (pop parts) "1")
-		(chess-pos-set-can-castle position castle t)))
-	  '(?K ?Q ?k ?q))
-
-    ;; the number of moves made since the last irreversible move.  (0
-    ;; if last move was irreversible.  If the value is >= 100, the
-    ;; game can be declared a draw due to the 50 move rule.)
-    (setq parts (cdr parts))
-
-    ;; The game number
-    (setq parts (cdr parts))
-
-    ;; white player, black player
-    (setq white (pop parts)
-	  black (pop parts))
-
-    ;; my relation to this game:
-    ;; -3 isolated position, such as for "ref 3" or the "sposition"
-    ;;    command
-    ;; -2 I am observing game being examined
-    ;;  2 I am the examiner of this game
-    ;; -1 I am playing, it is my opponent's move
-    ;;  1 I am playing and it is my move
-    ;;  0 I am observing a game being played
-    (setq status (string-to-int (pop parts)))
-    (cond ((= status 2)
-	   (chess-game-set-data game 'my-color (chess-pos-side-to-move position))))
-
+  (let* ((chess-engine-handling-event t)
+	 (begin (match-beginning 0))
+	 (end (match-end 0))
+	 (parts (split-string (match-string 1) " "))
+	 (position (let ((pos (chess-pos-create t)))
+		     (assert (= (length parts) 32))
+		     (dotimes (r 8)
+		       (let ((rank (pop parts)))
+			 (dotimes (f 8)
+			   (unless (= (aref rank f) ?-)
+			     (chess-pos-set-piece
+			      pos (chess-rf-to-index r f) (aref rank f))))))
+		     (chess-pos-set-side-to-move pos (string= (pop parts) "W"))
+		     (let ((file (string-to-int (pop parts))))
+		       (when (>= file 0)
+			 (chess-pos-set-en-passant
+			  pos (chess-rf-to-index
+			       (if (chess-pos-side-to-move pos) 3 4) file))))
+		     (mapc (lambda (castle)
+			     (if (string= (pop parts) "1")
+				 (chess-pos-set-can-castle pos castle t)))
+			   '(?K ?Q ?k ?q))
+		     ;; the number of moves made since the last irreversible
+		     ;; move.  (0 if last move was irreversible.  If the value
+		     ;; is >= 100, the game can be declared a draw due to the
+		     ;; 50 move rule.)
+		     (setq parts (cdr parts))
+		     (assert (= (length parts) 17))
+		     pos))
+	 (game (chess-ics-game (string-to-int (pop parts))
+			       :White (pop parts) :Black (pop parts)))
+	 (status
+	  ;; my relation to this game:
+	  ;; -3 isolated position, such as for "ref 3" or the "sposition"
+	  ;;    command
+	  ;; -2 I am observing game being examined
+	  ;;  2 I am the examiner of this game
+	  ;; -1 I am playing, it is my opponent's move
+	  ;;  1 I am playing and it is my move
+	  ;;  0 I am observing a game being played
+	  (string-to-int (pop parts))))
+    (when (or (= status 2) (= status -2) (= status 0))
+      (chess-game-set-data game 'my-color (chess-pos-side-to-move position)))
     ;; initial time and increment (in seconds) of the match
-    (setq time-control (format "%s/%s" (pop parts) (pop parts)))
-
+    (chess-game-set-tag game
+			"TimeControl" (format "%s/%s" (pop parts) (pop parts)))
     ;; material values for each side
     (let ((centipawn (* 100 (- (string-to-int (pop parts))
 			       (string-to-int (pop parts))))))
       (chess-pos-set-epd position 'ce (if (chess-pos-side-to-move position)
-					  centipawn
-					(- centipawn))))
-
+					  centipawn (- centipawn))))
     ;; White's and Black's remaining time
-    (chess-game-set-data game 'white-remaining (string-to-number (pop parts)))
-    (chess-game-set-data game 'black-remaining (string-to-number (pop parts)))
-
-    ;; the number of the move about to be made (standard chess
-    ;; numbering -- White's and Black's first moves are both 1, etc.)
-    (setq parts (cdr parts))
-
-    ;; move in long alegebraic notation
-    (setq parts (cdr parts))
-
-    ;; time taken to make previous move "(min:sec)".
-    (setq parts (cdr parts))
-
-    ;; move in short algebraic notation (SAN)
-    (setq move (unless (string= (car parts) "none")
-		 (car parts)))
-    (setq parts (cdr parts))
-
-    ;; checkmate, etc., is stated in the SAN text
-    (when move
-      (cond
-       ((= ?+ (aref move (1- (length move))))
-	(chess-pos-set-status position :check))
-       ((= ?# (aref move (1- (length move))))
-	(chess-pos-set-status position :checkmate)
-	(chess-pos-set-epd position 'ce 32767))
-       (nil
-	;; jww (2002-04-30): what about stalemate?  do I need to
-	;; calculate this each time?
-	(chess-pos-set-status position :stalemate))))
-
-    ;; flip field for board orientation: 1 = Black at bottom, 0 =
-    ;; White at bottom.
-    (setq parts (cdr parts))
-
-    ;; jww (2002-04-18): what do these two mean?
-    (setq parts (cdr parts))
-    (setq parts (cdr parts))
-
-    (unwind-protect
-	(if move
-	    ;; each move gives the _position occurring after the ply_,
-	    ;; which means that if the move says W, it is telling us
-	    ;; what our opponents move was
-	    (if (progn (setq error 'comparing-colors)
-		       (eq (chess-pos-side-to-move position)
-			   (chess-game-data game 'my-color)))
-		(let ((ign (setq error 'converting-ply))
-		      (ply (chess-engine-convert-algebraic move t)))
-		  (setq error 'applying-move)
-		  ;; save us from generating a position we already have
-		  (chess-ply-set-keyword ply :next-pos position)
-		  (chess-pos-set-preceding-ply position ply)
-		  (chess-game-move game ply)
-		  (setq error nil))
-	      (setq error nil))
-	  (let ((chess-game-inhibit-events t)
-		(color (chess-pos-side-to-move position))
-		plies)
-	    (when (or (= 1 status) (= -1 status))
-	      (chess-game-set-data game 'my-color (if (= 1 status)
-						      color
-						    (not color)))
-	      (setq chess-engine-opponent-name (if (= 1 status) black white))
-	      (chess-game-set-data game 'active t))
-	    (chess-game-set-tag game "White" white)
-	    (chess-game-set-tag game "Black" black)
-	    (chess-game-set-tag game "Site" (car chess-ics-server))
-	    (chess-game-set-tag game "TimeControl" time-control)
-	    (setq error 'setting-start-position)
-	    (chess-game-set-start-position game position))
-	  (setq error 'orienting-board)
-	  (chess-game-run-hooks game 'orient)
-	  (setq error nil))
-      (if error
-	  (chess-message 'failed-ics-parse error
-			 (buffer-substring-no-properties begin end)))
-      (when nil
-	(goto-char begin)
-	(delete-region begin end)
-	(save-excursion
-	  (while (and (forward-line -1)
-		      (or (looking-at "^[ \t]*$")
-			  (looking-at "^[^% \t\n\r]+%\\s-*$")))
-	    (delete-region (match-beginning 0) (1+ (match-end 0)))))
-	;; we need to counter the forward-line in chess-engine-filter
-	(unless error
-	  (forward-line -1))))
-    t))
+    (mapc (lambda (d) (chess-game-set-data game d (string-to-int (pop parts))))
+	  '(white-remaining black-remaining))
+    (let* ((seq (prog1 (string-to-int (pop parts))
+		  ;; move in long alegebraic notation
+		  (setq parts (cdr parts))
+		  ;; time taken to make previous move "(min:sec)".
+		  (setq parts (cdr parts))))
+	   (index (- (* seq 2) (if (chess-pos-side-to-move position) 2 1)))
+	   (move (prog1 (unless (string= (car parts) "none")
+			  (case (aref (car parts) (1- (length (car parts))))
+			    (?+ (chess-pos-set-status position :check))
+			    (?# (chess-pos-set-status position :checkmate)
+				(chess-pos-set-epd position 'ce 32767)))
+			  ;; jww (2002-04-30): what about stalemate?  do I need to
+			  ;; calculate this each time?
+			  (when nil
+			    (chess-pos-set-status position :stalemate))
+			  (car parts))
+		   (setq parts (cdr parts)))))
+      ;; flip field for board orientation: 1 = Black at bottom, 0 =
+      ;; White at bottom.
+      (setq parts (cdr parts))
+
+      ;; jww (2002-04-18): what do these two mean?
+      (setq parts (cdr parts))
+      (setq parts (cdr parts))
+
+      (message "Game %d: [%d,%d] %d. %s%s"
+	       (chess-game-data game 'ics-game-number)
+	       (chess-game-index game) index
+	       seq (if (chess-pos-side-to-move position) "... " "") move)
+      (unless (= seq (chess-game-seq game))
+	(message "WARNING: ics12 seq is %d, game seq is %d"
+		 seq (chess-game-seq game)))
+      (unwind-protect
+	  (if move
+	      ;; each move gives the _position occurring after the ply_,
+	      ;; which means that if the move says W, it is telling us
+	      ;; what our opponents move was
+	      (if (progn (setq error 'comparing-index)
+			 (= (1- index) (chess-game-index game)))
+		  (let ((ply (progn (setq error 'converting-ply)
+				    (chess-algebraic-to-ply
+				     (chess-game-pos game) move t))))
+		    (if (progn (setq error 'comparing-colors)
+			       (eq (chess-pos-side-to-move position)
+				   (chess-game-data game 'my-color)))
+			(setq error 'applying-opponent-move)
+		      (setq error 'applying-my-move))
+		    ;; save us from generating a position we already have
+		    (chess-ply-set-keyword ply :next-pos position)
+		    (chess-pos-set-preceding-ply position ply)
+		    (chess-game-move game ply)
+		    (setq error nil))
+		(if (= index (chess-game-index game))
+		    (progn (message "Redraw detected")
+			   (setq error nil))
+		  (if (and (> seq (1+ (chess-game-seq game)))
+			   (= 1 (chess-game-seq game)))
+		      (chess-ics-send
+		       (format "moves %d"
+			       (chess-game-data game 'ics-game-number))))))
+	    ;; No preceeding ply supplied, so this is a starting position
+	    (let ((chess-game-inhibit-events t)
+		  (color (chess-pos-side-to-move position))
+		  plies)
+	      (when (or (= 1 status) (= -1 status))
+		(chess-game-set-data game 'my-color (if (= 1 status)
+							color
+						      (not color)))
+		(chess-game-set-data game 'active t))
+	      (setq error 'setting-start-position)
+	      (chess-game-set-start-position game position))
+	    (setq error 'orienting-board)
+	    (chess-game-run-hooks game 'orient)
+	    (setq error nil))
+	(if error
+	    (chess-message 'failed-ics-parse error
+			   (buffer-substring-no-properties begin end)))
+	(when nil
+	  (goto-char begin)
+	  (delete-region begin end)
+	  (save-excursion
+	    (while (and (forward-line -1)
+			(or (looking-at "^[ \t]*$")
+			    (looking-at "^[^% \t\n\r]+%\\s-*$")))
+	      (delete-region (match-beginning 0) (1+ (match-end 0)))))
+	  ;; we need to counter the forward-line in chess-engine-filter
+	  (unless error
+	    (forward-line -1))))
+      t)))
+
+(defun chess-ics (server port &optional handle password-or-filename
+			 helper &rest helper-args)
+  (interactive
+   (let ((args (if (= (length chess-ics-server-list) 1)
+		   (car chess-ics-server-list)
+		 (assoc (completing-read (chess-string 'ics-server-prompt)
+					 chess-ics-server-list
+					 nil t (caar chess-ics-server-list))
+			chess-ics-server-list))))
+     (if (and (nth 2 args) (not (nth 3 args)))
+	 (append (list (nth 0 args) (nth 1 args) (nth 2 args)
+		       (read-passwd "Password: ")
+		       (nth 4 args))
+		 (nthcdr 5 args))
+       args)))
+  (unless handle
+    (setq handle "guest"))
+  (chess-message 'ics-connecting server)
+  (let ((buf (if helper
+		 (apply 'make-comint "chess-ics" helper nil helper-args)
+	       (make-comint "chess-ics" (cons server port)))))
+    (chess-message 'ics-connected server)
+    (set-buffer buf)
+    (setq chess-ics-server server
+	  chess-ics-handle handle
+	  chess-ics-password
+	  (if (and password-or-filename
+		   (file-readable-p password-or-filename))
+	      (with-temp-buffer
+		(insert-file-contents password-or-filename)
+		(buffer-string))
+	    password-or-filename)
+	  chess-ics-handling-login t
+	  chess-engine-regexp-alist (copy-alist chess-ics-matcher-alist)
+	  comint-prompt-regexp "^[^%\n]*% *"
+	  comint-scroll-show-maximum-output t)
+    (add-hook 'comint-output-filter-functions 'chess-engine-filter t t)
+    (let ((ntimes 50))
+      (while (and chess-ics-handling-login
+		  (> (setq ntimes (1- ntimes)) 0))
+	(accept-process-output (get-buffer-process (current-buffer)) 0 100)))
+    (switch-to-buffer buf)))
 
 (defun chess-ics-handler (game event &rest args)
   (unless chess-engine-handling-event
     (cond
-     ((eq event 'initialize)
-      (kill-buffer (current-buffer))
-      (chess-game-run-hooks game 'disable-autosave)
-      (let* ((server
-	     (if (= (length chess-ics-server-list) 1)
-		 (car chess-ics-server-list)
-	       (assoc (completing-read (chess-string 'ics-server-prompt)
-				       chess-ics-server-list
-				       nil t (caar chess-ics-server-list))
-		      chess-ics-server-list)))
-	     (handle (or (nth 2 server) "guest"))
-	     (password (when (nth 2 server)
-			 (let ((pass (or (nth 3 server)
-					 (read-passwd "Password: "))))
-			   (if (file-readable-p pass)
-			       (with-temp-buffer
-				 (insert-file-contents pass)
-				 (buffer-string))
-			     pass)))))
-	(chess-message 'ics-connecting (nth 0 server))
-
-	(let ((buf (if (nth 4 server)
-		       (apply 'make-comint "chess-ics"
-			      (nth 4 server) nil (nth 5 server))
-		     (make-comint "chess-ics" (cons (nth 0 server)
-						    (nth 1 server))))))
-	  (chess-message 'ics-connected (nth 0 server))
-
-	  (display-buffer buf)
-	  (set-buffer buf)
-
-	  (setq chess-ics-server server
-		chess-ics-handle handle
-		chess-ics-password password
-		comint-prompt-regexp "^[^%\n]*% *"
-		comint-scroll-show-maximum-output t)
-
-	  (add-hook 'comint-output-filter-functions 'chess-engine-filter t t)))
-      t)
+     ((eq event 'initialize))
 
      ((eq event 'ready)
       (chess-game-run-hooks game 'announce-autosave))
@@ -361,34 +513,22 @@ to run whenever the regexp matches.")
      ;; this handler is taken from chess-common; we need to send long
      ;; algebraic notation to the ICS server, not short
      ((eq event 'move)
-      (when (= 1 (chess-game-index game))
-	(chess-game-set-tag game "White" chess-full-name)
-	(chess-game-set-tag game "Black" chess-engine-opponent-name))
-
-      (chess-engine-send
-       nil
-       (concat (if (chess-ply-any-keyword (car args) :castle :long-castle)
-		   (chess-ply-to-algebraic (car args))
-		 (concat (chess-index-to-coord
-			  (car (chess-ply-changes (car args)))) "-"
-			 (chess-index-to-coord
-			  (cadr (chess-ply-changes (car args))))))
-	       "\n"))
-
+      (with-current-buffer (chess-game-data game 'ics-buffer)
+	(chess-ics-send
+	 (if (chess-ply-any-keyword (car args) :castle :long-castle)
+	     (chess-ply-to-algebraic (car args))
+	   (concat (chess-index-to-coord
+		    (chess-ply-source (car args))) "-"
+		   (chess-index-to-coord
+		    (chess-ply-target (car args)))))))
       (if (chess-game-over-p game)
 	  (chess-game-set-data game 'active nil)))
 
      ((eq event 'flag-fell)
       (chess-common-handler game 'flag-fell))
 
-     ((eq event 'send)
-      (comint-send-string (get-buffer-process (current-buffer))
-			  (car args)))
-
-     ((eq event 'set-index))
-
      ((eq event 'forward)
-      (chess-engine-send nil "forward\n"))
+      (chess-ics-send nil "forward"))
      (t
       (apply 'chess-network-handler game event args)))))