*** no comment ***

5 files changed, 113 insertions, 80 deletions

diff --git a/TODO b/TODO
index b577645..17b7e55 100644
--- a/TODO
+++ b/TODO
@@ -1,28 +1,10 @@
-delYsid: I knew there had to be a way.  The old keyboard shortcutting
-code (which uses chess-legal-plies) was just to slow.  On modern
-machines you wouldn't notice it, but on my 300 MHz laptop in battery
-saving mode, even with byte-compiled files, I spent 1/4 of my time
-looking at the hourglass cursor.  So I kept cleaning the algorithm,
-dropping the number of calls to chess-search-position (the biggest and
-slowest function in chess.el) from 5400 calls down to 4300 calls.  But
-still it was too slow.  Then I thought about it long and hard, and
-realized chess-legal-plies was going about its whole job backwards.  I
-found a way to optimize it that resulted in dropping the number of
-calls to chess-search-position down to 797!!  That's 5000 fewer calls.
-The new code is so fast I that when it's byte-compiled, I never see an
-hourglass cursor, rarely even when un-byte-compiled in my slowest
-configuration!
-
 - Feature work remaining:
 
   annotations
   chatting
   clocks
-  bughouse/crazyhouse
   analysis/highlight tools
-  database interaction (chess-file.el, chess-scid.el)
-
-----------------------------------------------------------------------
+  bughouse/crazyhouse
 
 - undoing a single move (my move) and moving again, causes
   chess-algebraic to get a little screwed up
@@ -37,8 +19,6 @@ configuration!
 - SPACE to pass, then try to move (against an engine) fails saying
   it's not our turn to move
 
-----------------------------------------------------------------------
-
 - Add support for adjournments; also, implement this is such a way
   that an e-mail or postal game is basically a game that's adjourned
   after every move
diff --git a/chess-crafty.el b/chess-crafty.el
index 72b866e..be1e25b 100644
--- a/chess-crafty.el
+++ b/chess-crafty.el
@@ -17,6 +17,10 @@
   :type 'file
   :group 'chess-crafty)
 
+(defvar chess-crafty-evaluation nil)
+
+(make-variable-buffer-local 'chess-crafty-evaluation)
+
 (defvar chess-crafty-regexp-alist
   (list
    (cons (concat "\\(White\\|Black\\)\\s-*([0-9]+):\\s-+\\("
@@ -25,6 +29,11 @@
 	  (lambda ()
 	    (funcall chess-engine-response-handler 'move
 		     (chess-engine-convert-algebraic (match-string 2) t)))))
+   (cons "total evaluation\\.+\\s-+\\([-+0-9.]+\\)"
+	 (function
+	  (lambda ()
+	    (setq chess-crafty-evaluation
+		  (string-to-number (match-string 1))))))
    (cons "\\(Illegal move\\|unrecognized/illegal command\\):\\s-*\\(.*\\)"
 	 (function
 	  (lambda ()
@@ -52,6 +61,15 @@
     (chess-engine-send nil (format "setboard %s\n"
 				   (chess-pos-to-string (car args)))))
 
+   ((eq event 'evaluate)
+    (setq chess-crafty-evaluation nil)
+    (chess-engine-send nil "display general\nscore\ndisplay nogeneral\n")
+    (let ((limit 50))
+      (while (and (null chess-crafty-evaluation)
+		  (> (setq limit (1- limit)) 0))
+	(sit-for 0 100 t))
+      chess-crafty-evaluation))
+
    ((eq event 'setup-game)
     (let ((file (chess-with-temp-file
 		    (insert (chess-game-to-string (car args)) ?\n))))
diff --git a/chess-display.el b/chess-display.el
index 838e67d..67eaa84 100644
--- a/chess-display.el
+++ b/chess-display.el
@@ -13,20 +13,28 @@
   "Common code used by chess displays."
   :group 'chess)
 
-(defcustom chess-display-separate-frame (display-multi-frame-p)
-  "If non-nil, chessboard display use their own frame."
-  :type 'boolean
-  :group 'chess-images)
-
 (defcustom chess-display-popup t
   "If non-nil, popup displays whenever a significant event occurs."
   :type 'boolean
-  :group 'chess-ics1)
+  :group 'chess-display)
 
 (defcustom chess-display-highlight-legal nil
   "If non-nil, highlight legal target squares when a piece is selected."
   :type 'boolean
-  :group 'chess-ics1)
+  :group 'chess-display)
+
+(defcustom chess-display-mode-line-format "   %C   %N. %M"
+  "The format of a chess display's modeline.
+Special characters include:
+
+    %C  The color to move, White or Black; if the game is finished,
+	this will instead be the completion string
+    %N  Current game sequence
+    %M  Current algebraic move text (prefixed by ... when White)
+    %E  Current position evaluation, if engine supports it
+	(negative numbers favor black) [NOT WORKING YET]"
+  :type 'string
+  :group 'chess-display)
 
 ;;; Code:
 
@@ -236,7 +244,6 @@ modeline."
     (funcall chess-display-event-handler 'draw
 	     (chess-display-position nil)
 	     (chess-display-perspective nil))
-    (chess-display-set-modeline)
     (if (and popup (not chess-display-no-popup)
 	     (chess-display-main-p nil))
 	(chess-display-popup nil))))
@@ -328,6 +335,9 @@ See `chess-display-type' for the different kinds of displays."
      ((eq event 'destroy)
       (chess-display-detach-game nil))
 
+     ((eq event 'post-move)
+      (chess-display-update-modeline))
+
      ((eq event 'pass)
       (let ((my-color (chess-game-data game 'my-color)))
 	(chess-game-set-data game 'my-color (not my-color))
@@ -459,36 +469,54 @@ The key bindings available in this mode are:
     (mode-stalemate . "STALEMATE")
     (mode-drawn     . "DRAWMN")))
 
-(defun chess-display-set-modeline ()
+(defun chess-display-update-modeline ()
   "Set the modeline to reflect the current game position."
-  (let ((color (chess-pos-side-to-move (chess-display-position nil)))
-	(index chess-display-index))
-    (if (= index 0)
-	(setq chess-display-mode-line
-	      (format "   %s   %s" (if color (chess-string 'mode-white)
-				     (chess-string 'mode-black))
-		      (chess-string 'mode-start)))
-      (let ((ply (chess-game-ply chess-display-game (1- index))))
-	(setq chess-display-mode-line
-	      (concat
-	       "   "
-	       (let ((final (chess-ply-final-p ply)))
-		 (cond
-		  ((eq final :checkmate) (chess-string 'mode-checkmate))
-		  ((eq final :resign)    (chess-string 'mode-resigned))
-		  ((eq final :stalemate) (chess-string 'mode-stalemate))
-		  ((eq final :draw)      (chess-string 'mode-drawn))
-		  (t
-		   (if color (chess-string 'mode-white)
-		     (chess-string 'mode-black)))))
-	       (if index
-		   (concat "   " (int-to-string
-				  (if (> index 1)
-				      (/ index 2) (1+ (/ index 2))))))
-	       (if ply
-		   (concat ". " (if color "... ")
-			   (or (chess-ply-to-algebraic ply)
-			       "???")))))))))
+  (let* ((mode-line (concat chess-display-mode-line-format))
+	 (color (chess-pos-side-to-move (chess-display-position nil)))
+	 (index chess-display-index)
+	 (ply (chess-game-ply chess-display-game (1- index)))
+	 (case-fold-search nil))
+    (while (string-match "%\\([A-Za-z0-9]\\|([^)]+)\\)" mode-line)
+      (let ((code (match-string-no-properties 1 mode-line)))
+	(if (= ?\( (aref code 0))
+	    (setq code (eval code))
+	  (cond
+	   ((string= code "C")
+	    (setq code
+		  (let ((final (chess-ply-final-p ply)))
+		    (cond
+		     ((eq final :checkmate) (chess-string 'mode-checkmate))
+		     ((eq final :resign)    (chess-string 'mode-resigned))
+		     ((eq final :stalemate) (chess-string 'mode-stalemate))
+		     ((eq final :draw)      (chess-string 'mode-drawn))
+		     (t
+		      (if color (chess-string 'mode-white)
+			(chess-string 'mode-black)))))))
+
+	   ((string= code "N")
+	    (if (= index 0)
+		"START"
+	      (setq code (int-to-string
+			  (chess-game-seq chess-display-game)))))
+
+	   ((string= code "M")
+	    (setq code (concat (if color "... ")
+			       (or (chess-ply-to-algebraic ply) "???"))))
+
+	   ((string= code "E")
+	    ;; jww (2002-04-14): This code is encountering some nasty
+	    ;; race conditions
+	    (let ((evaluation (save-match-data
+				(chess-game-run-hooks chess-display-game
+						      'evaluate))))
+	      (setq code (if evaluation
+			     (concat "(" (number-to-string evaluation) ")")
+			   "(thinking)"))))
+
+	   (t
+	    (setq code ""))))
+	(setq mode-line (replace-match code t t mode-line))))
+    (setq chess-display-mode-line mode-line)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -499,7 +527,8 @@ The key bindings available in this mode are:
   "Just redraw the current display."
   (interactive)
   (erase-buffer)
-  (chess-display-update nil))
+  (chess-display-update nil)
+  (chess-display-update-modeline))
 
 (defsubst chess-display-active-p ()
   "Return non-nil if the displayed chessboard reflects an active game.
diff --git a/chess-engine.el b/chess-engine.el
index d0a9951..4d9613b 100644
--- a/chess-engine.el
+++ b/chess-engine.el
@@ -144,14 +144,14 @@
    ((eq event 'setup-game)
     (when (car args)
       ;; we don't want the `setup-game' event coming back to us
-      (let ((chess-engine-handling-event t))
-	(let ((chess-game-inhibit-events t))
-	  (chess-engine-set-game nil (car args))
-	  (chess-game-set-data chess-engine-game 'active t)
-	  (if (string= chess-full-name
-		       (chess-game-tag chess-engine-game "White"))
-	      (chess-game-set-data chess-engine-game 'my-color t)
-	    (chess-game-set-data chess-engine-game 'my-color nil))))
+      (let ((chess-engine-handling-event t)
+	    (chess-game-inhibit-events t))
+	(chess-engine-set-game nil (car args))
+	(chess-game-set-data chess-engine-game 'active t)
+	(if (string= chess-full-name
+		     (chess-game-tag chess-engine-game "White"))
+	    (chess-game-set-data chess-engine-game 'my-color t)
+	  (chess-game-set-data chess-engine-game 'my-color nil)))
       t))
 
    ((eq event 'quit)
@@ -406,15 +406,16 @@
 (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
-    (chess-with-current-buffer engine
-      (apply chess-engine-event-handler event args))
-
-    (cond
-     ((eq event 'shutdown)
-      (chess-engine-destroy engine))
+    (let (result)
+      (chess-with-current-buffer engine
+	(setq result (apply chess-engine-event-handler event args)))
+      (cond
+       ((eq event 'shutdown)
+	(chess-engine-destroy engine))
 
-     ((eq event 'destroy)
-      (chess-engine-detach-game engine)))))
+       ((eq event 'destroy)
+	(chess-engine-detach-game engine)))
+      result)))
 
 (defun chess-engine-sentinal (proc event)
   (when (buffer-live-p (process-buffer proc))
diff --git a/chess-game.el b/chess-game.el
index c3d281a..9832372 100644
--- a/chess-game.el
+++ b/chess-game.el
@@ -59,8 +59,9 @@ matches."
 (defsubst chess-game-run-hooks (game &rest args)
   "Return the tags alist associated with GAME."
   (unless chess-game-inhibit-events
-    (dolist (hook (chess-game-hooks game))
-      (apply (car hook) game (cdr hook) args))))
+    (let (result)
+      (dolist (hook (chess-game-hooks game) result)
+	(setq result (apply (car hook) game (cdr hook) args))))))
 
 
 (defsubst chess-game-tags (game)
@@ -142,9 +143,12 @@ matches."
   "Return the GAME's current position index."
   (1- (length (chess-game-plies game))))
 
-(defsubst chess-game-seq (game)
+(defun chess-game-seq (game)
   "Return the current GAME sequence."
-  (1+ (/ (chess-game-index game) 2)))
+  (let ((index (chess-game-index game)))
+    (if (> index 1)
+	(/ index 2)
+      (1+ (/ index 2)))))
 
 (defsubst chess-game-side-to-move (game)
   (chess-pos-side-to-move (chess-game-pos game)))
@@ -230,7 +234,8 @@ progress (nil), if it is drawn, resigned, mate, etc."
 	  (chess-game-run-hooks game 'move current-ply))))
 
      (t
-      (chess-game-run-hooks game 'move current-ply)))))
+      (chess-game-run-hooks game 'move current-ply)
+      (chess-game-run-hooks game 'post-move)))))
 
 (defsubst chess-game-end (game keyword)
   "End the current game, by resignation, draw, etc."