Popping up of chess display has been entirely reworked.

4 files changed, 194 insertions, 87 deletions

diff --git a/chess-display.el b/chess-display.el
index c7cd835..9439649 100644
--- a/chess-display.el
+++ b/chess-display.el
@@ -53,8 +53,8 @@
 (defvar chess-display-ply)
 (defvar chess-display-position)
 (defvar chess-display-perspective)
-(defvar chess-display-draw-function nil)
-(defvar chess-display-highlight-function nil)
+(defvar chess-display-event-handler nil)
+(defvar chess-display-no-popup nil)
 (defvar chess-display-edit-mode nil)
 (defvar chess-display-mode-line "")
 
@@ -64,8 +64,8 @@
 (make-variable-buffer-local 'chess-display-ply)
 (make-variable-buffer-local 'chess-display-position)
 (make-variable-buffer-local 'chess-display-perspective)
-(make-variable-buffer-local 'chess-display-draw-function)
-(make-variable-buffer-local 'chess-display-highlight-function)
+(make-variable-buffer-local 'chess-display-event-handler)
+(make-variable-buffer-local 'chess-display-no-popup)
 (make-variable-buffer-local 'chess-display-edit-mode)
 (make-variable-buffer-local 'chess-display-mode-line)
 
@@ -79,18 +79,14 @@
 (defun chess-display-create (style perspective)
   "Create a chess display, for displaying chess objects."
   (let* ((name (symbol-name style))
-	 (draw (intern-soft (concat name "-draw")))
-	 (highlight (intern-soft (concat name "-highlight")))
-	 (initialize (intern-soft (concat name "-initialize"))))
-    (unless draw
-      (error "There is no known chessboard display style '%s'" name))
+	 (handler (intern-soft (concat name "-handler"))))
+    (unless handler
+      (error "There is no such chessboard display style '%s'" name))
     (with-current-buffer (generate-new-buffer "*Chessboard*")
-      (setq chess-display-draw-function draw
-	    chess-display-highlight-function highlight
-	    chess-display-perspective perspective)
       (chess-display-mode)
-      (if initialize
-	  (funcall initialize))
+      (funcall handler 'initialize)
+      (setq chess-display-event-handler handler
+	    chess-display-perspective perspective)
       (current-buffer))))
 
 (defsubst chess-display-destroy (display)
@@ -125,7 +121,7 @@ that was passed in."
 	  chess-display-index nil
 	  chess-display-ply nil
 	  chess-display-position position)
-    (chess-display-update nil)))
+    (chess-display-update nil t)))
 
 (defun chess-display-position (display)
   "Return the position currently viewed."
@@ -151,7 +147,7 @@ the modeline."
 	  chess-display-index nil
 	  chess-display-ply ply
 	  chess-display-position nil)
-    (chess-display-update display)))
+    (chess-display-update display t)))
 
 (defun chess-display-ply (display)
   (chess-with-current-buffer display
@@ -175,7 +171,7 @@ variation that was passed in."
 	  chess-display-index (or index 0)
 	  chess-display-ply nil
 	  chess-display-position nil)
-    (chess-display-update nil)))
+    (chess-display-update nil t)))
 
 (defun chess-display-variation (display)
   (chess-with-current-buffer display
@@ -197,7 +193,7 @@ modeline."
 	  chess-display-ply nil
 	  chess-display-position nil)
     (chess-game-add-hook game 'chess-display-event-handler display)
-    (chess-display-update nil)))
+    (chess-display-update nil t)))
 
 (defun chess-display-detach-game (display)
   "Set the display game.
@@ -229,15 +225,15 @@ modeline."
   (chess-with-current-buffer display
     chess-display-index))
 
-(defun chess-display-update (display)
-  "This should be called if any object passed in has been changed.
-That is, if you call `chess-display-set-position', and then later
-change that position object, the display can be updated by calling
-`chess-display-update'."
+(defun chess-display-update (display &optional popup)
+  "Update the chessboard DISPLAY.  POPUP too, if that arg is non-nil."
   (chess-with-current-buffer display
-    (if chess-display-draw-function
-	(funcall chess-display-draw-function))
-    (chess-display-set-modeline)))
+    (funcall chess-display-event-handler 'draw
+	     (chess-display-position nil)
+	     (chess-display-perspective nil))
+    (chess-display-set-modeline)
+    (if popup
+	(chess-display-popup nil))))
 
 (defun chess-display-move (display ply)
   "Move a piece on DISPLAY, by applying the given PLY.
@@ -267,12 +263,28 @@ The given highlighting MODE is used, or the default if the style you
 are displaying with doesn't support that mode.  `selected' is a mode
 that is supported by most displays, and is the default mode."
   (chess-with-current-buffer display
-    (if chess-display-highlight-function
-	(let ((mode :selected))
-	  (dolist (arg args)
-	    (if (symbolp arg)
-		(setq mode arg)
-	      (funcall chess-display-highlight-function arg mode)))))))
+    (let ((mode :selected))
+      (dolist (arg args)
+	(if (symbolp arg)
+	    (setq mode arg)
+	  (funcall chess-display-event-handler
+		   'highlight arg mode))))))
+
+(defun chess-display-popup (display)
+  "Popup the given DISPLAY, so that it's visible to the user."
+  (chess-with-current-buffer display
+    (unless chess-display-no-popup
+      (funcall chess-display-event-handler 'popup))))
+
+(defun chess-display-enable-popup (display)
+  "Popup the given DISPLAY, so that it's visible to the user."
+  (chess-with-current-buffer display
+    (setq chess-display-no-popup nil)))
+
+(defun chess-display-disable-popup (display)
+  "Popup the given DISPLAY, so that it's visible to the user."
+  (chess-with-current-buffer display
+    (setq chess-display-no-popup t)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -301,11 +313,15 @@ See `chess-display-type' for the different kinds of displays."
      ((memq event '(move game-over resign))
       (chess-display-set-index nil (chess-game-index
 				    (chess-display-game nil)))))
+
     (if (eq event 'resign)
 	(message-box "%s resigns" (if (car args) "White" "Black")))
 
     (unless (eq event 'shutdown)
-      (chess-display-update nil))))
+      (chess-display-update nil))
+
+    (if (memq event '(pass move game-over resign))
+	(chess-display-popup nil))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -359,9 +375,27 @@ See `chess-display-type' for the different kinds of displays."
      (t
       (define-key map [mouse-1] 'chess-display-mouse-select-piece)
       (define-key map [mouse-2] 'chess-display-mouse-select-piece)))
+
+    (define-key map [menu-bar files] 'undefined)
+    (define-key map [menu-bar edit] 'undefined)
+    (define-key map [menu-bar options] 'undefined)
+    (define-key map [menu-bar buffer] 'undefined)
+    (define-key map [menu-bar tools] 'undefined)
+    (define-key map [menu-bar help-menu] 'undefined)
+
     map)
   "The mode map used in a chessboard display buffer.")
 
+(defvar chess-display-move-menu nil)
+(unless chess-display-move-menu
+  (easy-menu-define
+    chess-display-move-menu chess-display-mode-map ""
+    '("History"
+      ["First" chess-display-move-first t]
+      ["Previous" chess-display-move-backward t]
+      ["Next" chess-display-move-forward t]
+      ["Last" chess-display-move-last t])))
+
 (defun chess-display-redraw ()
   "Just redraw the current display."
   (interactive)
@@ -697,6 +731,31 @@ to the end or beginning."
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
+;; Default window and frame popup functions
+;;
+
+(defun chess-display-popup-in-window ()
+  "Popup the given DISPLAY, so that it's visible to the user."
+  (unless (get-buffer-window (current-buffer))
+    (fit-window-to-buffer (display-buffer (current-buffer)))))
+
+(defun chess-display-popup-in-frame (display height width)
+  "Popup the given DISPLAY, so that it's visible to the user."
+  (let ((window (get-buffer-window (current-buffer) t)))
+    (if window
+	(let ((frame (window-frame window)))
+	  (unless (eq frame (selected-frame))
+	    (select-frame-set-input-focus frame)))
+      (let ((params (list (cons 'name "*Chessboard*")
+			  (cons 'height height)
+			  (cons 'width width))))
+	(if display
+	    (push (cons 'display display) params))
+	(select-frame (make-frame params))
+	(set-window-dedicated-p (selected-window) t)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
 ;; Mousing around on the chess-display
 ;;
 
diff --git a/chess-ics1.el b/chess-ics1.el
index ef001f2..8a6e24d 100644
--- a/chess-ics1.el
+++ b/chess-ics1.el
@@ -6,26 +6,39 @@
 
 (require 'chess-display)
 
+(defgroup chess-ics1 nil
+  "The ICS1 style ASCII display."
+  :group 'chess-display)
+
+(defcustom chess-ics1-popup t
+  "If non-nil, popup the chessboard display whenever the opponent moves."
+  :type 'boolean
+  :group 'chess-ics1)
+
+(defcustom chess-ics1-popup-function 'chess-display-popup-in-window
+  "The function used to popup a chess-ics1 display."
+  :type 'function
+  :group 'chess-ics1)
+
 ;;; Code:
 
-(defun chess-debug-position (&optional position)
-  "This is a debugging function, and not meant from general use."
-  (interactive)
-  (let ((pos (or position (chess-engine-position nil))))
-    (with-current-buffer (get-buffer-create "*scratch*")
-      (chess-ics1-draw pos))))
+(defun chess-ics1-handler (event &rest args)
+  (cond
+   ((eq event 'popup)
+    (if chess-ics1-popup
+	(funcall chess-ics1-popup-function)))
+   ((eq event 'draw)
+    (apply 'chess-ics1-draw args))
+   ((eq event 'highlight)
+    (apply 'chess-ics1-highlight args))))
 
-(defun chess-ics1-draw (&optional disppos)
+(defun chess-ics1-draw (position perspective)
   "Draw the given POSITION from PERSPECTIVE's point of view.
 PERSPECTIVE is t for white or nil for black."
-  (if (null (get-buffer-window (current-buffer) t))
-      (pop-to-buffer (current-buffer)))
   (let ((inhibit-redisplay t)
 	(pos (point)))
     (erase-buffer)
-    (let* ((position (or disppos (chess-display-position nil)))
-	   (inverted (and (null disppos)
-			  (not (chess-display-perspective nil))))
+    (let* ((inverted (not perspective))
 	   (rank (if inverted 7 0))
 	   (file (if inverted 7 0))
 	   beg)
@@ -59,8 +72,8 @@ PERSPECTIVE is t for white or nil for black."
 	      rank (if inverted (1- rank) (1+ rank))))
       (insert "      +---+---+---+---+---+---+---+---+\n")
       (if inverted
-	  (insert "        h   g   f   e   d   c   b   a\n")
-	(insert "        a   b   c   d   e   f   g   h\n")))
+	  (insert "        h   g   f   e   d   c   b   a\n\n")
+	(insert "        a   b   c   d   e   f   g   h\n\n")))
     (set-buffer-modified-p nil)
     (goto-char pos)))
 
@@ -80,6 +93,13 @@ PERSPECTIVE is t for white or nil for black."
       (skip-chars-forward "^|")
       (put-text-property beg (point) 'face 'chess-display-highlight-face))))
 
+(defun chess-debug-position (&optional position)
+  "This is a debugging function, and not meant from general use."
+  (interactive)
+  (let ((pos (or position (chess-engine-position nil))))
+    (with-current-buffer (get-buffer-create "*scratch*")
+      (chess-ics1-draw pos t))))
+
 (provide 'chess-ics1)
 
 ;;; chess-ics1.el ends here
diff --git a/chess-images.el b/chess-images.el
index d3ac937..ec07b79 100644
--- a/chess-images.el
+++ b/chess-images.el
@@ -44,8 +44,9 @@
 (defcustom chess-images-directory
   (if (file-directory-p "/usr/share/games/xboard/pixmaps")
       "/usr/share/games/xboard/pixmaps"
-    (expand-file-name "pieces" (file-name-directory
-				(or load-file-name buffer-file-name))))
+    (expand-file-name "pieces/xboard"
+		      (file-name-directory
+		       (or load-file-name buffer-file-name))))
   "Directory containing the chess piece bitmap images.
 You are free to use your own chess pieces, of any size.  By default, I
 assume you have xboard installed, or can go get the pixmaps that come
@@ -132,8 +133,32 @@ that specialized squares may be used such as marble tiles, etc."
   :set 'chess-images-clear-image-cache
   :group 'chess-images)
 
+(defcustom chess-images-popup t
+  "If non-nil, popup the chessboard display whenever the opponent moves."
+  :type 'boolean
+  :group 'chess-images)
+
+(defcustom chess-images-popup-function 'chess-images-popup
+  "The function used to popup a chess-images display.
+The current-buffer is set to the display buffer when this function is
+called."
+  :type 'function
+  :group 'chess-images)
+
 ;;; Code:
 
+(defun chess-images-handler (event &rest args)
+  (cond
+   ((eq event 'initialize)
+    (chess-images-initialize))
+   ((eq event 'popup)
+    (if chess-images-popup
+	(funcall chess-images-popup-function)))
+   ((eq event 'draw)
+    (apply 'chess-images-draw args))
+   ((eq event 'highlight)
+    (apply 'chess-images-highlight args))))
+
 (defconst chess-images-piece-names
   '((?r "rook"   0)
     (?n "knight" 1)
@@ -161,36 +186,24 @@ that specialized squares may be used such as marble tiles, etc."
 				    (x-display-pixel-width display)
 				  (display-pixel-width)) 20)))))
 
-(defun chess-images-popup-board ()
+(defun chess-images-popup ()
   (unless chess-images-size
     (error "Cannot find any piece images; check `chess-images-directory'"))
-
-  (let* ((size (float (+ (* (or chess-images-border-width 0) 8)
-			 (* chess-images-size 8))))
-	 (max-char-height (ceiling (/ size (frame-char-height))))
-	 (max-char-width  (ceiling (/ size (frame-char-width)))))
-
-    (if chess-images-separate-frame
-	;; make room for the possible title bar and other
-	;; decorations
-	(let ((params (list (cons 'name "*Chessboard*")
-			    (cons 'height (+ max-char-height 2))
-			    (cons 'width max-char-width))))
-	  (if (stringp chess-images-separate-frame)
-	      (push (cons 'display chess-images-separate-frame) params))
-	  (select-frame (make-frame params))
-	  (set-window-dedicated-p (selected-window) t))
-      (pop-to-buffer (current-buffer))
-      (set-window-text-height (get-buffer-window (current-buffer))
-			      max-char-height))))
-
-(defun chess-images-draw ()
+  (if chess-images-separate-frame
+      (let* ((size (float (+ (* (or chess-images-border-width 0) 8)
+			     (* chess-images-size 8))))
+	     (max-char-height (ceiling (/ size (frame-char-height))))
+	     (max-char-width  (ceiling (/ size (frame-char-width))))
+	     (display (and (stringp chess-images-separate-frame)
+			   chess-images-separate-frame)))
+	(chess-display-popup-in-frame display (+ max-char-height 2)
+				      max-char-width))
+    (chess-display-popup-in-window)))
+
+(defun chess-images-draw (position perspective)
   "Draw the current chess display position."
-  (if (null (get-buffer-window (current-buffer) t))
-      (chess-images-popup-board))
   (let* ((inhibit-redisplay t)
-	 (board (chess-display-position nil))
-	 (inverted (not (chess-display-perspective nil)))
+	 (inverted (not perspective))
 	 (rank (if inverted 7 0))
 	 (file (if inverted 7 0))
 	 (pos (point)) new beg)
@@ -201,7 +214,7 @@ that specialized squares may be used such as marble tiles, etc."
       (goto-char (point-min)))
     (while (if inverted (>= rank 0) (< rank 8))
       (while (if inverted (>= file 0) (< file 8))
-	(let* ((piece (chess-pos-piece board (chess-rf-to-index rank file)))
+	(let* ((piece (chess-pos-piece position (chess-rf-to-index rank file)))
 	       (image
 		(if (= piece ? )
 		    (aref chess-images-cache
@@ -237,12 +250,10 @@ that specialized squares may be used such as marble tiles, etc."
     (goto-char pos)))
 
 (defun chess-images-highlight (index &optional mode)
-  "Highlight the piece on BOARD at INDEX, using the given MODE.
+  "Highlight the piece on the board at INDEX, using the given MODE.
 Common modes are:
   `selected'    show that the piece has been selected for movement.
   `unselected'  show that the piece has been unselected."
-  (if (null (get-buffer-window (current-buffer) t))
-      (chess-images-popup-board))
   (let* ((inverted (not (chess-display-perspective nil)))
 	 (pos (save-excursion
 		(goto-char (point-min))
diff --git a/chess-plain.el b/chess-plain.el
index 6b70e63..fdcf522 100644
--- a/chess-plain.el
+++ b/chess-plain.el
@@ -10,7 +10,7 @@
 
 (defgroup chess-plain nil
   "A minimal, customizable ASCII display."
-  :group 'chess-ascii)
+  :group 'chess-display)
 
 (defcustom chess-plain-draw-border nil
   "*Non-nil if a border should be drawn (using `chess-plain-border-chars')."
@@ -61,16 +61,35 @@ modify `chess-plain-piece-chars' to avoid real confusion.)"
   :type '(choice (const 'color) (const 'square-color)))
 	 ;; fails somehow
 
-(defun chess-plain-draw ()
+(defcustom chess-plain-popup t
+  "If non-nil, popup the chessboard display whenever the opponent moves."
+  :type 'boolean
+  :group 'chess-plain)
+
+(defcustom chess-plain-popup-function 'chess-display-popup-in-window
+  "The function used to popup a chess-plain display."
+  :type 'function
+  :group 'chess-plain)
+
+;;; Code:
+
+(defun chess-plain-handler (event &rest args)
+  (cond
+   ((eq event 'popup)
+    (if chess-plain-popup
+	(funcall chess-plain-popup-function)))
+   ((eq event 'draw)
+    (apply 'chess-plain-draw args))
+   ((eq event 'highlight)
+    (apply 'chess-plain-highlight args))))
+
+(defun chess-plain-draw (position perspective)
   "Draw the given POSITION from PERSPECTIVE's point of view.
 PERSPECTIVE is t for white or nil for black."
-  (if (null (get-buffer-window (current-buffer) t))
-      (pop-to-buffer (current-buffer)))
   (let ((inhibit-redisplay t)
 	(pos (point)))
     (erase-buffer)
-    (let* ((position (chess-display-position nil))
-	   (inverted (not (chess-display-perspective nil)))
+    (let* ((inverted (not perspective))
 	   (rank (if inverted 7 0))
 	   (file (if inverted 7 0))
 	   beg)
@@ -117,8 +136,6 @@ PERSPECTIVE is t for white or nil for black."
       (goto-char pos))))
 
 (defun chess-plain-highlight (index &optional mode)
-  (if (null (get-buffer-window (current-buffer) t))
-      (pop-to-buffer (current-buffer)))
   (let ((inverted (not (chess-display-perspective nil))))
     (save-excursion
       (beginning-of-line)