*** no comment ***

9 files changed, 112 insertions, 114 deletions

diff --git a/TODO b/TODO
index 5149b2a..897fef2 100644
--- a/TODO
+++ b/TODO
@@ -10,13 +10,14 @@
 
 ----------------------------------------------------------------------
 
-- Detect draw/resign/abort/retract, etc., from ICS and common engines
-
-- Make use of the my-color and active data in chess-game.el to ensure
-  that I only do what I should be doing
+- detect draw/resign/abort/retract, etc., from ICS and common engines
 
 - Why doesn't S-b produce [B] in the keyboard shortcutting?
 
+- chess-sound announcements are broken
+
+- the game should go inactive once I lose by stalemate/checkmate
+
 ----------------------------------------------------------------------
 
 - Read-only mode needs to be a bit more vigorous.  There's nothing
diff --git a/chess-algebraic.el b/chess-algebraic.el
index ed6f020..a1bc1e6 100644
--- a/chess-algebraic.el
+++ b/chess-algebraic.el
@@ -82,25 +82,28 @@ This regexp handles both long and short form.")
 		      ;; we must use our knowledge of how pieces can
 		      ;; move, to determine which piece is meant by the
 		      ;; piece indicator
-		      (when (setq candidates
-				  (chess-search-position position target
-							 (if color piece
-							   (downcase piece))))
-			(if (= (length candidates) 1)
-			    (list (car candidates) target)
-			  (if (null source)
-			      (error "Clarify piece to move by rank or file")
-			    (while candidates
-			      (if (if (>= source ?a)
-				      (eq (chess-index-file (car candidates))
-					  (- source ?a))
-				    (eq (chess-index-rank (car candidates))
-					(- 7 (- source ?1))))
-				  (setq which (car candidates) candidates nil)
-				(setq candidates (cdr candidates))))
-			    (if (null which)
-				(error "Could not determine which piece to use")
-			      (list which target)))))))))
+		      (if (setq candidates
+				(chess-search-position position target
+						       (if color piece
+							 (downcase piece))))
+			  (if (= (length candidates) 1)
+			      (list (car candidates) target)
+			    (if (null source)
+				(error "Clarify piece to move by rank or file")
+			      (while candidates
+				(if (if (>= source ?a)
+					(eq (chess-index-file (car candidates))
+					    (- source ?a))
+				      (eq (chess-index-rank (car candidates))
+					  (- 7 (- source ?1))))
+				    (setq which (car candidates)
+					  candidates nil)
+				  (setq candidates (cdr candidates))))
+			      (if (null which)
+				  (error "Could not determine which piece to use")
+				(list which target))))
+			(error "There are no candidate moves for '%s'"
+			       move))))))
 	  (if promotion
 	      (nconc changes (list :promote (aref promotion 0))))))
 
@@ -155,7 +158,7 @@ If LONG is non-nil, render the move into long notation."
 	   (if (/= ?  (chess-pos-piece pos to))
 	       "x" (if long "-"))
 	   (chess-index-to-coord to)
-	   (let ((promote (chess-ply-has-keyword ply :promote)))
+	   (let ((promote (memq :promote (chess-ply-changes ply))))
 	     (if promote
 		 (concat "=" (char-to-string
 			      (upcase (cadr promote))))))
diff --git a/chess-announce.el b/chess-announce.el
index 95cf40c..2da0486 100644
--- a/chess-announce.el
+++ b/chess-announce.el
@@ -43,7 +43,7 @@ See `chess-display-type' for the different kinds of displays."
    ((eq event 'shutdown)
     (funcall (nth 2 chess-announce-functions)))
 
-   ((memq event '(move game-over))
+   ((eq event 'move)
     (let* ((ply (chess-game-ply game (1- (chess-game-index game))))
 	   (pos (chess-ply-pos ply)))
       (unless (eq (chess-game-data game 'my-color)
diff --git a/chess-display.el b/chess-display.el
index 464c9df..3fe2023 100644
--- a/chess-display.el
+++ b/chess-display.el
@@ -359,7 +359,7 @@ that is supported by most displays, and is the default mode."
   :group 'chess-display)
 
 (defcustom chess-display-momentous-events
-  '(orient setup-game pass move game-over resign)
+  '(orient update setup-game pass move resign)
   "Events that will refresh, and cause 'main' displays to popup.
 These are displays for which `chess-display-set-main' has been
 called."
@@ -384,12 +384,11 @@ See `chess-display-type' for the different kinds of displays."
 
      ((eq event 'orient)
       ;; Set the display's perspective to whichever color I'm
-      ;; playing; also set the index just to be sure
-      (chess-display-set-index* nil (chess-game-index game))
+      ;; playing
       (chess-display-set-perspective*
        nil (chess-game-data game 'my-color))))
 
-    (if (memq event '(orient setup-game move game-over resign))
+    (if (memq event '(orient update setup-game move resign))
 	(chess-display-set-index* nil (chess-game-index game)))
 
     (let ((momentous (memq event chess-display-momentous-events)))
@@ -527,14 +526,10 @@ The key bindings available in this mode are:
 		   "   "
 		   (let ((final (chess-ply-final-p ply)))
 		     (cond
-		      ((eq final :checkmate)
-		       "CHECKMATE")
-		      ((eq final :resign)
-		       "RESIGNED")
-		      ((eq final :stalemate)
-		       "STALEMATE")
-		      ((eq final :draw)
-		       "DRAWN")
+		      ((eq final :checkmate) "CHECKMATE")
+		      ((eq final :resign)    "RESIGNED")
+		      ((eq final :stalemate) "STALEMATE")
+		      ((eq final :draw)      "DRAWN")
 		      (t
 		       (if color "White" "Black"))))
 		   (if index
@@ -980,7 +975,7 @@ Clicking once on a piece selects it; then click on the target location."
 	      (let ((last-sel chess-display-last-selected))
 		;; if they select the same square again, just deselect it
 		(if (= (point) (car last-sel))
-		    (throw 'invalid t)
+		    (error "")
 		  (let ((s-piece (chess-pos-piece position (cadr last-sel)))
 			(t-piece (chess-pos-piece position coord)) ply)
 		    (if (and (/= t-piece ? )
diff --git a/chess-engine.el b/chess-engine.el
index afa80d8..86916a1 100644
--- a/chess-engine.el
+++ b/chess-engine.el
@@ -420,10 +420,10 @@ function in all cases; this is merely a bandwidth-saver."
 (defun chess-engine-event-handler (game engine event &rest args)
   "Handle any commands being sent to this instance of this module."
   (unless chess-engine-handling-event
-    (if (buffer-live-p engine)
-	(with-current-buffer engine
-	  (assert (eq game (chess-engine-game nil)))
-	  (apply chess-engine-event-handler event args)))
+    (chess-with-current-buffer engine
+      (assert (eq game (chess-engine-game nil)))
+      (apply chess-engine-event-handler event args))
+
     (cond
      ((eq event 'shutdown)
       (chess-engine-destroy engine))
diff --git a/chess-game.el b/chess-game.el
index f81f888..138fc36 100644
--- a/chess-game.el
+++ b/chess-game.el
@@ -128,7 +128,7 @@ matches."
 (defsubst chess-game-set-plies (game plies)
   "Return the tags alist associated with GAME."
   (setcdr (nthcdr 2 game) (list plies))
-  (chess-game-run-hooks game 'setup-game))
+  (chess-game-run-hooks game 'setup-game game))
 
 (defsubst chess-game-set-start-position (game position)
   "Return the tags alist associated with GAME."
@@ -160,15 +160,14 @@ matches."
   (let ((plies (chess-game-plies game)))
     (if plies
 	(nconc plies (list ply))
-      (chess-game-set-plies game (list ply)))))
+      (let ((chess-game-inhibit-events t))
+	(chess-game-set-plies game (list ply))))))
 
 (defun chess-game-undo (game count)
   "Undo the last COUNT plies of GAME."
   (if (> count (chess-game-index game))
       (error "Cannot undo further")
-    (chess-game-set-plies game (nbutlast (chess-game-plies game) count))
-    ;;(chess-game-run-hooks game 'undo count)
-    ))
+    (chess-game-set-plies game (nbutlast (chess-game-plies game) count))))
 
 
 (defsubst chess-game-over-p (game)
@@ -223,7 +222,7 @@ progress (nil), if it is drawn, resigned, mate, etc."
 	(chess-game-set-tag game "Result" (if color "0-1" "1-0"))
 	(if (chess-ply-has-keyword ply :resign)
 	    (chess-game-run-hooks game 'resign color)
-	  (chess-game-run-hooks game 'game-over))))
+	  (chess-game-run-hooks game 'move current-ply))))
 
      (t
       (chess-game-run-hooks game 'move current-ply)))))
diff --git a/chess-ics.el b/chess-ics.el
index 6b93559..908d42a 100644
--- a/chess-ics.el
+++ b/chess-ics.el
@@ -11,6 +11,21 @@
   "Engine for interacting with Internet Chess Servers."
   :group 'chess-engine)
 
+(defcustom chess-ics-server "freechess.org"
+  "The default ICS server to connect to."
+  :type 'string
+  :group 'chess-ics)
+
+(defcustom chess-ics-port 5000
+  "The port to use when connecting to `chess-ics-server'."
+  :type 'integer
+  :group 'chess-ics)
+
+(defcustom chess-ics-handle "jwiegley"
+  "The default handle used when logging into `chess-ics-server'."
+  :type 'string
+  :group 'chess-ics)
+
 (defvar chess-ics-ensure-ics12 nil)
 (make-variable-buffer-local 'chess-ics-ensure-ics12)
 
@@ -29,7 +44,7 @@ who is black."
 	(position (chess-pos-create t))
 	white black ply)
 
-    (assert (= (length parts) 31))
+    (assert (= (length parts) 32))
 
     ;; first, handle the layout of the position
     (dotimes (i 8)
@@ -90,15 +105,14 @@ who is black."
     (setq parts (cdr parts))
 
     ;; move in elaborated notation
-    (setq ply (if (string= (car parts) "none")
-		  (chess-ply-create position)
-		(chess-algebraic-to-ply position (substring (car parts) 2))))
     (setq parts (cdr parts))
 
     ;; time elapsed
     (setq parts (cdr parts))
 
     ;; move in algebraic notation
+    (setq move (unless (string= (car parts) "none")
+		 (car parts)))
     (setq parts (cdr parts))
 
     ;; unknown
@@ -106,25 +120,39 @@ who is black."
     (setq parts (cdr parts))
     (setq parts (cdr parts))
 
-    (list ply white black)))
+    (list position move white black)))
 
 (defun chess-ics-handle-move ()
-  (let ((begin (match-beginning 1))
+  (let ((chess-engine-handling-event t)
+	(begin (match-beginning 1))
 	(end (match-end 1))
-	(info (chess-ics12-parse (match-string 2)))
+	(info (chess-ics12-parse (match-string 3)))
 	(game (chess-engine-game nil)))
     (assert game)
-    (if (> (chess-game-index game) 0)
-	(if (eq (chess-pos-side-to-move (chess-ply-pos (car info)))
-		(chess-pos-side-to-move (chess-engine-position nil)))
-	    (chess-engine-do-move (car info)))
-      (chess-engine-set-start-position nil (chess-ply-pos (car info))
-				       (string= (cadr info) ics-handle)))
-    (delete-region begin end)
+    (unwind-protect
+	(if (and (chess-game-data game 'active)
+		 (> (chess-game-index game) 0))
+	    (if (and (cadr info)
+		     (eq (chess-pos-side-to-move (car info))
+			 (chess-game-data game 'my-color)))
+		(let ((last-ply (last (chess-game-plies game))))
+		  (setcar last-ply
+			  (chess-algebraic-to-ply (chess-ply-pos (car last-ply))
+						  (cadr info) t))
+		  (chess-game-add-ply game (chess-ply-create (car info)))
+		  (chess-game-run-hooks game 'update)))
+	  (let ((chess-game-inhibit-events t) plies)
+	    (chess-game-set-data game 'my-color (string= (nth 2 info)
+							 chess-ics-handle))
+	    (chess-game-set-data game 'active t)
+	    (chess-game-set-start-position game (car info)))
+	  (chess-game-run-hooks game 'orient))
+      (delete-region begin end))
     t))
 
 (defvar chess-ics-regexp-alist
-  (list (cons "\\(<12> \\(.+\\)\\)" 'chess-ics-handle-move)
+  (list (cons "\\(\\(\n*fics%\n*\\)?<12> \\(.+\\)\\)\n"
+	      'chess-ics-handle-move)
 	(cons "Challenge: \\(\\S-+\\) \\S-+ \\S-+ \\S-+ .+"
 	      (function
 	       (lambda ()
@@ -134,50 +162,20 @@ who is black."
 (defun chess-ics-handler (event &rest args)
   (cond
    ((eq event 'initialize)
-    (let* ((old-buffer (current-buffer))
-	   (address-or-alias (read-from-minibuffer
-			      "ICS Server address or alias: "))
-	   (server-info-list (cdr (assoc address-or-alias
-					 ics-servers-alist)))
-	   (ics-address (or (car (cdr server-info-list))
-			    address-or-alias))
-	   (ics-connect-method (or (car (nthcdr 3 server-info-list))
-				   ics-default-connect-method))
-	   (server-name (or (car server-info-list)
-			    address-or-alias))
-	   (ics-port (or (car (nthcdr 2 server-info-list))
-			 (read-from-minibuffer "ICS port: "
-					       ics-default-port)))
-	   (handle (read-from-minibuffer "ICS Handle: "
-					 ics-default-handle))
-	   (proc (concat server-name ":" handle))
-	   (buffer (concat "*" proc "*")))
-
-      (setq ics-handle handle)
-
-      (if (comint-check-proc buffer)
-	  (set-buffer buffer)
-	(run-hooks 'ics-pre-connect-hook)
-	(set-buffer (make-comint proc (cons ics-address ics-port)))
-	(run-hooks 'ics-post-connect-hook)
-	(ics-mode))
-
-      (set (make-variable-buffer-local 'ics-last-command-time)
-	   (ics-current-time))
-      (set (make-variable-buffer-local 'ics-idle-p) nil)
-      (set (make-variable-buffer-local 'ics-interface-variable-set) nil)
-      (set (make-variable-buffer-local 'ics-wakeup-last-alarm-time)
-	   (ics-current-time))
-      (set (make-variable-buffer-local 'ics-last-highlight-end) nil)
-      (set (make-variable-buffer-local 'ics-last-add-buttons-end) nil)
+    (kill-buffer (current-buffer))
+    (message "Connecting to Internet Chess Server '%s'..." chess-ics-server)
 
-      (add-hook 'comint-output-filter-functions 'chess-ics-filter t t)
-      (set (make-local-variable 'comint-preoutput-filter-functions)
-	   '(chess-ics-strip-cr))
+    (let ((buf (make-comint "chess-ics"
+			    (cons chess-ics-server chess-ics-port))))
+      (message "Connecting to Internet Chess Server '%s'...done"
+	       chess-ics-server)
 
-      (display-buffer buffer)
-      (kill-buffer old-buffer)
+      (display-buffer buf)
+      (set-buffer buf)
 
+      (add-hook 'comint-output-filter-functions 'chess-ics-filter t t)
+      (set (make-local-variable 'comint-preoutput-filter-functions)
+	   '(chess-ics-strip))
       nil))
 
    ((eq event 'match)
@@ -187,12 +185,12 @@ who is black."
 
    ((eq event 'move)
     (unless chess-ics-ensure-ics12
-      (comint-send-string (get-buffer-process (current-buffer))
-			  "set style 12\n")
+      (chess-engine-send nil "set style 12\n")
       (setq chess-ics-ensure-ics12 t))
     (chess-network-handler 'move (car args)))
 
    ((eq event 'send)
+    (message "sending string: %s" (car args))
     (comint-send-string (get-buffer-process (current-buffer))
 			(car args)))
 
@@ -204,12 +202,12 @@ who is black."
     (if chess-engine-last-pos
 	(goto-char chess-engine-last-pos)
       (goto-char (point-min)))
-    (beginning-of-line)
-    (while (not (eobp))
+    (while (and (not (eobp))
+		(/= (line-end-position) (point-max)))
       (let ((triggers chess-ics-regexp-alist))
 	(while triggers
-	  ;; this could be accelerated by joining together the
-	  ;; regexps
+	  ;; this could be accelerated by joining
+	  ;; together the regexps
 	  (if (and (looking-at (concat "[^\n\r]*" (caar triggers)))
 		   (funcall (cdar triggers)))
 	      (setq triggers nil)
@@ -217,8 +215,8 @@ who is black."
       (forward-line))
     (setq chess-engine-last-pos (point))))
 
-(defun chess-ics-strip-cr (string)
-  (while (string-match "\r" string)
+(defun chess-ics-strip (string)
+  (while (string-match "[\r\a]" string)
     (setq string (replace-match "" t t string)))
   string)
 
diff --git a/chess-network.el b/chess-network.el
index 237ba43..dee0647 100644
--- a/chess-network.el
+++ b/chess-network.el
@@ -111,7 +111,9 @@
     (chess-engine-send nil (format "chess match %s\n" chess-full-name)))
 
    ((eq event 'resign)
-    (chess-engine-send nil "resign\n"))
+    (chess-engine-send nil "resign\n")
+    (and (chess-engine-game nil)
+	 (chess-game-set-data (chess-engine-game nil) 'active nil)))
 
    ((eq event 'draw)
     (if chess-engine-pending-offer
diff --git a/chess-sound.el b/chess-sound.el
index 1854679..666be6c 100644
--- a/chess-sound.el
+++ b/chess-sound.el
@@ -67,7 +67,7 @@
   "This display module presents a standard chessboard.
 See `chess-display-type' for the different kinds of displays."
   (cond
-   ((memq event '(move game-over))
+   ((eq event 'move)
     (let* ((ply (chess-game-ply game (1- (chess-game-index game))))
 	   (pos (chess-ply-pos ply)))
       (if (eq (chess-game-data game 'my-color)