Major speed improvement and efficiency work. chess-legal-plies is

much more memory conservative now.  Reduced recursion in
chess-search-position by a slight bit.

8 files changed, 201 insertions, 178 deletions

diff --git a/TODO b/TODO
index 9f92beb..cee0c67 100644
--- a/TODO
+++ b/TODO
@@ -13,6 +13,9 @@
   chess-coord needs to be applied to a larger area, and also the way
   highlight locations are found needs to be recalculated.
 
+- Move keyboard shortcutting and mouse selection into their own
+  modules
+
 - the game should go inactive once I lose by stalemate/checkmate
 
 - when a clock runs down, indicate this in the modeline, and all the
@@ -30,7 +33,10 @@
 
 - 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
+  after every move; use BBDB if available
+
+- Allow databases to return a game moniker, which can be used to
+  reference that game again
 
 - There needs to be much more robustness; it's too easy to get the
   game into an unplayable state right now
diff --git a/chess-algebraic.el b/chess-algebraic.el
index 17d4fcc..62ccf0f 100644
--- a/chess-algebraic.el
+++ b/chess-algebraic.el
@@ -113,12 +113,10 @@ This regexp handles both long and short form.")
 	  (if promotion
 	      (nconc changes (list :promote (aref promotion 0))))))
 
-      (when trust
-	(if mate
-	    (nconc changes (list (if (equal mate "#") :checkmate :check))))
-	(nconc changes (list :valid)))
+      (if (and trust mate)
+	  (nconc changes (list (if (equal mate "#") :checkmate :check))))
 
-      (or ply (apply 'chess-ply-create position changes)))))
+      (or ply (apply 'chess-ply-create position trust changes)))))
 
 (defun chess-ply-to-algebraic (ply &optional long)
   "Convert the given PLY to algebraic notation.
diff --git a/chess-display.el b/chess-display.el
index 8105664..d19a434 100644
--- a/chess-display.el
+++ b/chess-display.el
@@ -124,8 +124,8 @@ See `mode-line-format' for syntax details."
   (chess-with-current-buffer display
     (chess-display-set-index* nil 1)
     (chess-game-set-plies chess-module-game
-			  (list ply (chess-ply-create
-				     (chess-ply-next-pos ply))))))
+			  (list ply (chess-ply-create*
+				     (chess-ply-next-pos ply) t)))))
 
 (defun chess-display-ply (display)
   (chess-with-current-buffer display
@@ -920,7 +920,7 @@ Clicking once on a piece selects it; then click on the target location."
 				     (and (> t-piece ?a)
 					  (> s-piece ?a))))
 			    (throw 'message (chess-string 'cannot-mount)))
-			(unless (setq ply (chess-ply-create position
+			(unless (setq ply (chess-ply-create position nil
 							    (cadr last-sel)
 							    coord))
 			  (throw 'message (chess-string 'move-not-legal)))
diff --git a/chess-game.el b/chess-game.el
index 2697aec..0bdc76a 100644
--- a/chess-game.el
+++ b/chess-game.el
@@ -136,7 +136,7 @@ matches."
 
 (defsubst chess-game-set-start-position (game position)
   "Return the tags alist associated with GAME."
-  (chess-game-set-plies game (list (chess-ply-create position))))
+  (chess-game-set-plies game (list (chess-ply-create* position))))
 
 (defsubst chess-game-pos (game &optional index)
   "Return the position related to GAME's INDEX position."
@@ -207,8 +207,9 @@ Optionally use the given starting POSITION.
 TAGS is the starting set of game tags (which can always be changed
 later using the various tag-related methods)."
   (let ((game (list nil tags nil
-		    (list (chess-ply-create (or position
-						(chess-pos-create)))))))
+		    (list (chess-ply-create* (or position
+						 (chess-pos-create))
+					     (null position))))))
     (dolist (tag (cons (cons "Date" (format-time-string "%Y.%m.%d"))
 		       chess-game-default-tags))
       (unless (chess-game-tag game (car tag))
@@ -227,8 +228,8 @@ progress (nil), if it is drawn, resigned, mate, etc."
 	(chess-error 'add-to-completed))
     (assert (equal position (chess-ply-pos current-ply)))
     (chess-ply-set-changes current-ply changes)
-    (chess-game-add-ply game (chess-ply-create
-			      (chess-ply-next-pos current-ply)))
+    (chess-game-add-ply game (chess-ply-create*
+			      (chess-ply-next-pos current-ply) t))
     (cond
      ((chess-ply-any-keyword ply :draw :perpetual :repetition :stalemate)
       (chess-game-set-tag game "Result" "1/2-1/2")
diff --git a/chess-pgn.el b/chess-pgn.el
index 91b9832..162d640 100644
--- a/chess-pgn.el
+++ b/chess-pgn.el
@@ -38,8 +38,8 @@
 	  (goto-char (match-end 0))
 	  (chess-game-set-tag game "Result" (match-string-no-properties 0))
 	  (unless (eq t (car (last plies)))
-	    (nconc plies (list (chess-ply-create
-				(chess-ply-next-pos (car (last plies)))))))
+	    (nconc plies (list (chess-ply-create*
+				(chess-ply-next-pos (car (last plies))) t))))
 	  (throw 'done t))
 
 	 ((looking-at "{")
@@ -61,8 +61,8 @@
 	  (throw 'done t))
 
 	 (t
-	  (nconc plies (list (chess-ply-create
-			      (chess-ply-next-pos (car (last plies))))))
+	  (nconc plies (list (chess-ply-create*
+			      (chess-ply-next-pos (car (last plies))) t)))
 	  (throw 'done t)))
 	(skip-chars-forward " \t\n")))
     (cdr plies)))
@@ -92,9 +92,9 @@
 			    (chess-fen-to-pos fen)
 			  (chess-pos-copy chess-starting-position)) t)
 		  ;; set the starting position to the FEN string
-		  (list (chess-ply-create (if fen
-					      (chess-fen-to-pos fen)
-					    chess-starting-position))))))
+		  (list (chess-ply-create* (if fen
+					       (chess-fen-to-pos fen)
+					     chess-starting-position) fen)))))
       game)))
 
 (defun chess-pgn-insert-annotations (game index ply)
diff --git a/chess-ply.el b/chess-ply.el
index 9830ed1..829510c 100644
--- a/chess-ply.el
+++ b/chess-ply.el
@@ -71,13 +71,9 @@
 (defun chess-ply-keyword (ply keyword)
   (let ((item (memq keyword (chess-ply-changes ply))))
     (if item
-	;; these are special keywords which use a value argument;
-	;; `which' is for disambiguating algebraic moves, `promote'
-	;; indicates the piece to promote to, `white' is white's
-	;; remaining time in seconds, and similarly for `black'
-	(if (memq keyword '(:which :promote :white :black))
-	    (cadr item)
-	  t))))
+	(if (eq item (last (chess-ply-changes ply)))
+	    t
+	  (cadr item)))))
 
 (defsubst chess-ply-source (ply)
   (let ((changes (chess-ply-changes ply)))
@@ -99,10 +95,11 @@
     ("knight" . ?n)
     ("bishop" . ?b)))
 
-(defun chess-ply-create-castle (position &optional long)
+(defun chess-ply-create-castle (position &optional long king-index)
   "Create castling changes; this function supports Fischer Random castling."
   (let* ((color (chess-pos-side-to-move position))
-	 (king (car (chess-pos-search position (if color ?K ?k))))
+	 (king (or king-index
+		   (car (chess-pos-search position (if color ?K ?k)))))
 	 (king-target (chess-rf-to-index (if color 7 0)
 					 (if long 2 6)))
 	 (king-file (chess-index-file king))
@@ -113,8 +110,8 @@
 	(if (chess-pos-piece-p position index (if color ?R ?r))
 	    (setq rook index file king-file)
 	  (setq file (funcall (if long '1+ '1-) file)))))
-    (if (and rook (chess-search-position position king-target
-					 (if color ?K ?k)))
+    (if (and rook (chess-legal-plies position :any :index king
+				     :target king-target))
 	(list king king-target rook
 	      (chess-rf-to-index (if color 7 0) (if long 3 5))
 	      (if long :long-castle :castle)))))
@@ -122,9 +119,13 @@
 (chess-message-catalog 'english
   '((pawn-promote-query . "Promote pawn to queen/rook/knight/bishop? ")))
 
-(defvar chess-ply-no-promotions nil)
+(defvar chess-ply-checking-mate nil)
 
-(defun chess-ply-create (position &rest changes)
+(defsubst chess-ply-create* (position &optional direct)
+  (list (if direct position
+	  (chess-pos-copy position))))
+
+(defun chess-ply-create (position &optional valid-p &rest changes)
   "Create a ply from the given POSITION by applying the suppiled CHANGES.
 This function will guarantee the resulting ply is legal, and will also
 annotate the ply with :check or other modifiers as necessary.  It will
@@ -132,9 +133,7 @@ also extend castling, and will prompt for a promotion piece.
 
 Note: Do not pass in the rook move if CHANGES represents a castling
 maneuver."
-  (let* ((valid-p (memq :valid changes))
-	 (ply (cons (chess-pos-copy position)
-		    (delq :valid changes)))
+  (let* ((ply (cons (chess-pos-copy position) changes))
 	 (color (chess-pos-side-to-move position))
 	 piece)
     (if (or (null changes) (symbolp (car changes)))
@@ -142,91 +141,82 @@ maneuver."
       ;; validate that `changes' can be legally applied to the given
       ;; position
       (when (or valid-p
-		(member (car changes)
-			(chess-search-position position (cadr changes)
-					       (chess-pos-piece position
-								(car changes)))))
-	(setq piece (chess-pos-piece position (car changes)))
-
-	;; is this a castling maneuver?
-	(if (and (= piece (if color ?K ?k))
-		 (not (or (memq :castle changes)
-			  (memq :long-castle changes))))
-	    (let* ((target (cadr changes))
-		   (file (chess-index-file target))
-		   (long (= 2 file))
-		   new-changes)
-	      (if (and (or (and (= file 6)
-				(chess-pos-can-castle position
-						      (if color ?K ?k)))
-			   (and long
-				(chess-pos-can-castle position
-						      (if color ?Q ?q))))
-		       (setq new-changes
-			     (chess-ply-create-castle position long)))
-		  (setcdr ply new-changes))))
-
-	(when (= piece (if color ?P ?p))
-	  ;; is this a pawn move to the ultimate rank?  if so, and we
-	  ;; haven't already been told, ask for the piece to promote
-	  ;; it to
-	  (if (and (not (memq :promote changes))
-		   (not chess-ply-no-promotions)
-		   (= (if color 0 7) (chess-index-rank (cadr changes))))
-	      (let ((new-piece (completing-read
-				(chess-string 'pawn-promote-query)
-				chess-piece-name-table nil t "queen")))
-		(setq new-piece
-		      (cdr (assoc new-piece chess-piece-name-table)))
-		(if color
-		    (setq new-piece (upcase new-piece)))
-		(nconc changes (list :promote new-piece))))
-
-	  ;; is this an en-passant capture?
-	  (if (= (or (chess-pos-en-passant position) 100)
-		 (or (chess-incr-index (cadr changes) (if color 1 -1) 0) 200))
-	      (nconc changes (list :en-passant))))
-
-	(unless (or (memq :check changes)
-		    (memq :checkmate changes)
-		    (memq :stalemate changes))
-	  (let* ((next-pos (chess-ply-next-pos ply))
-		 (next-color (not color)))
-	    ;; is the opponent's king in check/mate or stalemate now, as
-	    ;; a result of the changes?
-	    (let ((can-move
-		   (catch 'can-move
-		     ;; find out if any of `color's pieces can move.  We
-		     ;; start the search on the home row for that color,
-		     ;; as it's likier to find a legal move faster.
-		     (let ((rank (if next-color 7 0))
-			   (file 0))
-		       (while (funcall (if next-color '>= '<) rank
-				       (if next-color 0 8))
-			 (while (< file 8)
-			   (let* ((to (chess-rf-to-index rank file))
-				  (piece (chess-pos-piece next-pos to)))
-			     (when (or (eq piece ? )
-				       (if next-color
-					   (> piece ?a)
-					 (< piece ?a)))
-			       (if (chess-search-position next-pos to next-color)
-				   (throw 'can-move t))))
-			   (setq file (1+ file)))
-			 (setq file 0 rank (funcall (if next-color '1- '1+)
-						    rank)))))))
-
-	      ;; see if anyone from the other side is attacking the king
-	      ;; in the new position
-	      (if (chess-search-position next-pos
-					 (car (chess-pos-search
-					       next-pos (if next-color ?K ?k)))
-					 (not next-color))
-		  (nconc changes (list (if can-move :check :checkmate)))
-		;; no, but is he in stalemate?
-		(unless can-move
-		  (nconc changes (list :stalemate)))))))
-
+		(chess-legal-plies position :any :index (car changes)
+				   :target (cadr changes)))
+	(unless chess-ply-checking-mate
+	  (setq piece (chess-pos-piece position (car changes)))
+
+	  ;; is this a castling maneuver?
+	  (if (and (= piece (if color ?K ?k))
+		   (not (or (memq :castle changes)
+			    (memq :long-castle changes))))
+	      (let* ((target (cadr changes))
+		     (file (chess-index-file target))
+		     (long (= 2 file))
+		     new-changes)
+		(if (and (or (and (= file 6)
+				  (chess-pos-can-castle position
+							(if color ?K ?k)))
+			     (and long
+				  (chess-pos-can-castle position
+							(if color ?Q ?q))))
+			 (setq new-changes
+			       (chess-ply-create-castle position long
+							(car changes))))
+		    (setcdr ply new-changes))))
+
+	  (when (= piece (if color ?P ?p))
+	    ;; is this a pawn move to the ultimate rank?  if so, and
+	    ;; we haven't already been told, ask for the piece to
+	    ;; promote it to
+	    (if (and (not (memq :promote changes))
+		     (= (if color 0 7) (chess-index-rank (cadr changes))))
+		(let ((new-piece (completing-read
+				  (chess-string 'pawn-promote-query)
+				  chess-piece-name-table nil t "queen")))
+		  (setq new-piece
+			(cdr (assoc new-piece chess-piece-name-table)))
+		  (if color
+		      (setq new-piece (upcase new-piece)))
+		  (nconc changes (list :promote new-piece))))
+
+	    ;; is this an en-passant capture?
+	    (if (= (or (chess-pos-en-passant position) 100)
+		   (or (chess-incr-index (cadr changes)
+					 (if color 1 -1) 0) 200))
+		(nconc changes (list :en-passant))))
+
+	  ;; we must determine whether this ply results in a check,
+	  ;; checkmate or stalemate
+	  (unless (or (memq :check changes)
+		      (memq :checkmate changes)
+		      (memq :stalemate changes))
+	    (let* ((chess-ply-checking-mate t)
+		   (next-pos (chess-ply-next-pos ply))
+		   (next-color (not color))
+		   (king (car (chess-pos-search next-pos
+						(if next-color ?K ?k))))
+		   in-check)
+	      ;; first, see if the moves leaves the king in check.
+	      ;; This is tested by seeing if any of the opponent's
+	      ;; pieces can reach the king in the position that will
+	      ;; result from this ply.  If the king is in check, we
+	      ;; will then test for checkmate by seeing if any of his
+	      ;; subjects can move or not.  That test will also
+	      ;; confirm stalemate for us.
+	      (if (or (setq in-check
+			    (catch 'in-check
+			      (chess-search-position next-pos king
+						     (not next-color) t)))
+		      (null (chess-legal-plies next-pos :any :index king)))
+		  ;; is the opponent's king in check/mate or stalemate
+		  ;; now, as a result of the changes?
+		  (if (chess-legal-plies next-pos :any :color next-color)
+		      (if in-check
+			  (nconc changes (list :check)))
+		    (nconc changes (list (if in-check
+					     :checkmate
+					   :stalemate))))))))
 	;; return the annotated ply
 	ply))))
 
@@ -235,22 +225,26 @@ maneuver."
   (chess-ply-any-keyword ply :draw :perpetual :repetition :stalemate
 			 :resign :checkmate))
 
-(defvar chess-ply-throw-if-any nil)
-
 (eval-when-compile
   (defvar position)
   (defvar candidate)
   (defvar color)
-  (defvar plies))
+  (defvar plies)
+  (defvar specific-target))
+
+(defvar chess-ply-throw-if-any nil)
+
 (defsubst chess-ply--add (rank-adj file-adj &optional pos)
   "This is totally a shortcut."
-  (let ((ply (chess-ply-create position candidate
-			       (or pos (chess-incr-index candidate
-							 rank-adj file-adj)))))
-    (when ply
-      (if chess-ply-throw-if-any
-	  (throw 'any-found t))
-      (push ply plies))))
+  (let ((target (or pos (chess-incr-index candidate rank-adj file-adj))))
+    (if (and (or (not specific-target)
+		 (= target specific-target))
+	     (chess-pos-legal-moves position color target candidate))
+	(if chess-ply-throw-if-any
+	    (throw 'any-found t)
+	  (let ((ply (chess-ply-create position t candidate target)))
+	    (if ply
+		(push ply plies)))))))
 
 (defun chess-legal-plies (position &rest keywords)
   "Return a list of all legal plies in POSITION.
@@ -261,6 +255,7 @@ KEYWORDS allowed are:
   :piece <piece character>
   :file <number 0 to 7> [can only be used if :piece is present]
   :index <coordinate index>
+  :target <specific target index>
 
 These will constrain the plies generated to those matching the above
 criteria."
@@ -286,11 +281,11 @@ criteria."
     (let* ((piece (cadr (memq :piece keywords)))
 	   (color (if piece (< piece ?a)
 		    (chess-pos-side-to-move position)))
+	   (specific-target (cadr (memq :target keywords)))
 	   (test-piece
 	    (upcase (or piece
 			(chess-pos-piece position
 					 (cadr (memq :index keywords))))))
-	   (chess-ply-no-promotions t)
 	   pos plies file)
       ;; since we're looking for moves of a particular piece, do a
       ;; more focused search
diff --git a/chess-pos.el b/chess-pos.el
index fb8516c..3585e06 100644
--- a/chess-pos.el
+++ b/chess-pos.el
@@ -335,7 +335,15 @@ trying to move a blank square."
 (chess-message-catalog 'english
   '((piece-unrecognized . "Unrecognized piece identifier")))
 
-(defun chess-search-position (position target piece)
+(eval-when-compile
+  (defvar candidates)
+  (defvar check-only))
+(defsubst chess--add-candidate (candidate)
+  (if check-only
+      (throw 'in-check t)
+    (push candidate candidates)))
+
+(defun chess-search-position (position target piece &optional check-only)
   "Look on POSITION from TARGET for a PIECE that can move there.
 This routine looks along legal paths of movement for PIECE.  It
 differs from `chess-pos-search', which is a more basic function that
@@ -359,12 +367,12 @@ indices which indicate where a piece may have moved from."
      ;; from any piece movement.  This is useful for testing whether a
      ;; king is in check, for example.
      ((memq piece '(t nil))
-      (setq candidates (list t))
-      (dolist (p '(?P ?R ?N ?B ?K ?Q))
-	(nconc candidates
-	       (chess-search-position position target
-				      (if piece p (downcase p)))))
-      (setq candidates (cdr candidates)))
+      (dolist (p (if check-only
+		     '(?P ?R ?N ?B ?Q)
+		   '(?P ?R ?N ?B ?Q ?K)))
+	(mapc 'chess--add-candidate
+	      (chess-search-position position target
+				     (if piece p (downcase p))))))
 
      ;; skip erroneous space requests
      ((= test-piece ? ))
@@ -388,30 +396,26 @@ indices which indicate where a piece may have moved from."
 			      (chess-pos-piece-p position pos
 						 (if color ?P ?p)))))
 	      (if color (> p ?a) (< p ?a)))
-	    (let ((cands (list t)))
+	    (progn
 	      (setq pos (chess-incr-index target (- bias) -1))
 	      (if (and pos (chess-pos-piece-p position pos piece))
-		  (nconc cands (list pos)))
+		  (chess--add-candidate pos))
 	      (setq pos (chess-incr-index target (- bias) 1))
 	      (if (and pos (chess-pos-piece-p position pos piece))
-		  (nconc cands (list pos)))
-	      (if candidates
-		  (nconc candidates (cdr cands))
-		(setq candidates (cdr cands))))
+		  (chess--add-candidate pos)))
 	  (if (setq pos (chess-incr-index target (- bias) 0))
 	      (if (chess-pos-piece-p position pos piece)
-		  (setq candidates (list pos))
+		  (chess--add-candidate pos)
 		(when (and (chess-pos-piece-p position pos ? )
 			   (= (if color 4 3)
 			      (chess-index-rank target)))
 		  (setq pos (chess-incr-index pos (- bias) 0))
 		  (if (and pos (chess-pos-piece-p position pos piece))
-		      (setq candidates (list pos)))))))))
+		      (chess--add-candidate pos))))))))
 
      ;; the rook, bishop and queen are the easiest; just look along
      ;; rank and file and/or diagonal for the nearest pieces!
      ((memq test-piece '(?R ?B ?Q))
-      (setq candidates (list t))
       (dolist (dir (cond
 		    ((= test-piece ?R)
 		     '(        (-1 0)
@@ -432,12 +436,11 @@ indices which indicate where a piece may have moved from."
 	(while pos
 	  (if (chess-pos-piece-p position pos piece)
 	      (progn
-		(nconc candidates (list pos))
+		(chess--add-candidate pos)
 		(setq pos nil))
 	    (if (not (chess-pos-piece-p position pos ? ))
 		(setq pos nil)
-	      (setq pos (apply 'chess-incr-index pos dir))))))
-      (setq candidates (cdr candidates)))
+	      (setq pos (apply 'chess-incr-index pos dir)))))))
 
      ;; the king is a trivial case of the queen, except when castling
      ((= test-piece ?K)
@@ -448,7 +451,9 @@ indices which indicate where a piece may have moved from."
 	  ;; up the current file
 	  (setq pos (apply 'chess-incr-index target (car dirs)))
 	  (if (and pos (chess-pos-piece-p position pos piece))
-	      (setq candidates (list pos) dirs nil)
+	      (progn
+		(chess--add-candidate pos)
+		(setq dirs nil))
 	    (setq dirs (cdr dirs)))))
 
       (let ((rank (if color 7 0)))
@@ -474,12 +479,11 @@ indices which indicate where a piece may have moved from."
 		    (setq legal nil)
 		  (setq file (funcall (if long '1+ '1-) file))))
 	      (if legal
-		  (setq candidates (list (chess-rf-to-index rank 4))))))))
+		  (chess--add-candidate (chess-rf-to-index rank 4)))))))
 
      ;; the knight is a zesty little piece; there may be more than
      ;; one, but at only one possible square in each direction
      ((= test-piece ?N)
-      (setq candidates (list t))
       (dolist (dir '((-2 -1) (-2 1)
 		     (-1 -2) (-1 2)
 		      (1 -2)  (1 2)
@@ -487,8 +491,7 @@ indices which indicate where a piece may have moved from."
 	;; up the current file
 	(if (and (setq pos (apply 'chess-incr-index target dir))
 		 (chess-pos-piece-p position pos piece))
-	    (nconc candidates (list pos))))
-      (setq candidates (cdr candidates)))
+	    (chess--add-candidate pos))))
 
      (t (chess-error 'piece-unrecognized)))
 
@@ -496,28 +499,47 @@ indices which indicate where a piece may have moved from."
     ;; leave the king in check; castling through check has already
     ;; been eliminated.
     (if (char-valid-p piece)
-	(let ((cand candidates) last-cand pos king-pos)
-	  (while cand
-	    ;; determine the resulting position
-	    (setq pos (chess-pos-move (chess-pos-copy position)
-				      (car cand) target))
-	    ;; find the king (only once if the king isn't moving)
-	    (if (or (null king-pos)
-		    (eq (downcase piece) ?k))
-		(setq king-pos (chess-pos-search pos (if color ?K ?k))))
-	    ;; can anybody from the opposite side reach him?  if so,
-	    ;; drop the candidate
-	    (if (or (null king-pos)
-		    (chess-search-position pos (car king-pos) (not color)))
-		(if last-cand
-		    (setcdr last-cand (cdr cand))
-		  (setq candidates (cdr candidates)))
-	      (setq last-cand cand))
-	    (setq cand (cdr cand)))))
+	(setq candidates
+	      (apply 'chess-pos-legal-moves
+		     position color target candidates)))
 
     ;; return the final list of candidate moves
     candidates))
 
+(defun chess-pos-legal-moves (position color target &rest candidates)
+  "Test if TARGET can legally be reached by any of CANDIDATES.
+Return the list of candidates that can reach it.
+
+CANDIDATES is a list of position indices which indicate the piece to
+be moved, and TARGET is the index of the location to be moved to.
+
+Note: All of the pieces specified by CANDIDATES must be of the same
+type."
+  (let ((cand candidates)
+	(test-piece (if (boundp 'test-piece)
+			test-piece	; a performance hack for above
+		      (upcase (chess-pos-piece position (car candidates)))))
+	last-cand pos king-pos)
+    (while cand
+      ;; determine the resulting position
+      (setq pos (chess-pos-move (chess-pos-copy position)
+				(car cand) target))
+      ;; find the king (only once if the king isn't moving)
+      (if (or (null king-pos)
+	      (= test-piece ?K))
+	  (setq king-pos (chess-pos-search pos (if color ?K ?k))))
+      ;; can anybody from the opposite side reach him?  if so,
+      ;; drop the candidate
+      (if (catch 'in-check
+	    (chess-search-position pos (car king-pos) (not color) t))
+	  (if last-cand
+	      (setcdr last-cand (cdr cand))
+	    (setq candidates (cdr candidates)))
+	(setq last-cand cand))
+      (setq cand (cdr cand)))
+    candidates))
+
+
 (provide 'chess-pos)
 
 ;;; chess-pos.el ends here
diff --git a/chess-var.el b/chess-var.el
index f5c789a..55be268 100644
--- a/chess-var.el
+++ b/chess-var.el
@@ -48,7 +48,8 @@ Optionally use the given starting POSITION.
 SEARCH-FUNC specifies the function used to test the legality of moves.
 TAGS is the starting set of var tags (which can always be changed
 later using the various tag-related methods)."
-  (list (chess-ply-create (or position (chess-pos-create)))))
+  (list (chess-ply-create* (or position (chess-pos-create))
+			   (null position))))
 
 (defun chess-var-move (var ply)
   "Make a move in the current VAR, from FROM to TO.
@@ -62,8 +63,8 @@ progress (nil), if it is drawn, resigned, mate, etc."
 	(chess-error 'add-to-completed))
     (assert (equal position (chess-ply-pos current-ply)))
     (chess-ply-set-changes current-ply changes)
-    (chess-var-add-ply var (chess-ply-create
-			    (chess-ply-next-pos current-ply)))))
+    (chess-var-add-ply var (chess-ply-create*
+			    (chess-ply-next-pos current-ply) t))))
 
 (provide 'chess-var)