code.delx.au - gnu-emacs-elpa/blob - chess-display.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Code shared by all chess displays
   4 ;;
   5
   6 (require 'chess-module)
   7 (require 'chess-var)
   8 (require 'chess-input)
   9
  10 (defgroup chess-display nil
  11   "Common code used by chess displays."
  12   :group 'chess)
  13
  14 (defcustom chess-display-popup t
  15   "If non-nil (the default), popup displays whenever a significant event
  16 occurs."
  17   :type 'boolean
  18   :group 'chess-display)
  19
  20 (make-variable-buffer-local 'chess-display-popup)
  21
  22 (defcustom chess-display-highlight-legal nil
  23   "If non-nil, highlight legal target squares when a piece is selected."
  24   :type 'boolean
  25   :group 'chess-display)
  26
  27 (chess-message-catalog 'english
  28   '((mode-white     . "White")
  29     (mode-black     . "Black")
  30     (mode-start     . "START")
  31     (mode-checkmate . "CHECKMATE")
  32     (mode-aborted   . "ABORTED")
  33     (mode-resigned  . "RESIGNED")
  34     (mode-stalemate . "STALEMATE")
  35     (mode-flag-fell . "FLAG FELL")
  36     (mode-drawn     . "DRAWN")
  37     (mode-edit      . "EDIT")))
  38
  39 (defcustom chess-display-mode-line-format
  40   '("  " chess-display-side-to-move "  "
  41     chess-display-move-text "   "
  42     (:eval (chess-display-clock-string))
  43     "(" (:eval (chess-game-tag chess-module-game "White")) "-"
  44     (:eval (chess-game-tag chess-module-game "Black")) ", "
  45     (:eval (chess-game-tag chess-module-game "Site"))
  46     (:eval (let ((date (chess-game-tag chess-module-game "Date")))
  47              (and (string-match "\\`\\([0-9]\\{4\\}\\)" date)
  48                   (concat " " (match-string 1 date))))) ")")
  49   "The format of a chess display's modeline.
  50 See `mode-line-format' for syntax details."
  51   :type 'sexp
  52   :group 'chess-display)
  53
  54 (defface chess-display-black-face
  55   '((t (:background "Black" :foreground "White")))
  56   "*The face used for the word Black in the mode-line."
  57   :group 'chess-display)
  58
  59 (defface chess-display-white-face
  60   '((t (:background "White" :foreground "Black")))
  61   "*The face used for the word White in the mode-line."
  62   :group 'chess-display)
  63
  64 ;;; Code:
  65
  66 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  67 ;;
  68 ;; User interface
  69 ;;
  70
  71 (defvar chess-display-index)
  72 (defvar chess-display-move-text)
  73 (defvar chess-display-side-to-move)
  74 (defvar chess-display-perspective)
  75 (defvar chess-display-event-handler nil)
  76 (defvar chess-display-edit-mode nil)
  77 (defvar chess-display-index-positions nil)
  78
  79 (make-variable-buffer-local 'chess-display-index)
  80 (make-variable-buffer-local 'chess-display-move-text)
  81 (make-variable-buffer-local 'chess-display-side-to-move)
  82 (make-variable-buffer-local 'chess-display-perspective)
  83 (make-variable-buffer-local 'chess-display-event-handler)
  84 (make-variable-buffer-local 'chess-display-edit-mode)
  85 (make-variable-buffer-local 'chess-display-index-positions)
  86
  87 (defvar chess-display-handling-event nil
  88   "If non-nil, chess-display is aleady handling the event.  This variable
  89 is used to avoid reentrancy.")
  90
  91 (defvar chess-display-style)
  92
  93 (chess-message-catalog 'english
  94   '((no-such-style . "There is no such chessboard display style '%s'")
  95     (cannot-yet-add . "Cannot insert moves into a game (yet)")))
  96
  97 (defun chess-display-create (game style perspective)
  98   "Create a chess display, for displaying chess objects.
  99 Where GAME is the chess game object to use, STYLE should be the display
 100 type to use (a symbol) and PERSPECTIVE determines the viewpoint
 101 of the board, if non-nil, the board is viewed from White's perspective."
 102   (interactive (list (if current-prefix-arg
 103                          (chess-game-create (chess-fen-to-pos
 104                                              (read-string "FEN: ")))
 105                        (chess-game-create))
 106                      (intern-soft
 107                       (concat "chess-" (completing-read "Display style: "
 108                                                         '(("ics1")
 109                                                           ("images")
 110                                                           ("plain")))))
 111                      (y-or-n-p "View from White's perspective? ")))
 112   (if (require style nil t)
 113       (let* ((chess-display-style style)
 114              (display (chess-module-create 'chess-display game "*Chessboard*"
 115                              perspective)))
 116         (if (interactive-p)
 117             (progn
 118               (chess-display-update display)
 119               (chess-display-popup display))
 120           display))))
 121
 122 (defalias 'chess-display-destroy 'chess-module-destroy)
 123
 124 (defun chess-display-clone (display style perspective)
 125   (let ((new-display (chess-display-create chess-module-game
 126                                            style perspective)))
 127     ;; the display will have already been updated by the `set-' calls,
 128     ;; it's just not visible yet
 129     (chess-display-popup new-display)
 130     new-display))
 131
 132 (defsubst chess-display-perspective (display)
 133   "Return the current perspective of DISPLAY."
 134   (chess-with-current-buffer display
 135     chess-display-perspective))
 136
 137 (defun chess-display-set-perspective* (display perspective)
 138   (chess-with-current-buffer display
 139     (setq chess-display-perspective perspective
 140           chess-display-index-positions nil)
 141     (erase-buffer)))                    ; force a complete redraw
 142
 143 (defun chess-display-set-perspective (display perspective)
 144   "Set PERSPECTIVE of DISPLAY."
 145   (chess-with-current-buffer display
 146     (chess-display-set-perspective* nil perspective)
 147     (chess-display-update nil)))
 148
 149 (defun chess-display-set-position (display &optional position my-color)
 150   "Set the game associated with DISPLAY to use POSITION and MY-COLOR."
 151   (chess-with-current-buffer display
 152     (if position
 153         (progn
 154           (chess-game-set-start-position chess-module-game position)
 155           (chess-game-set-data chess-module-game 'my-color my-color))
 156       (chess-game-set-start-position chess-module-game
 157                                      chess-starting-position)
 158       (chess-game-set-data chess-module-game 'my-color t))
 159     (chess-display-set-index nil 0)))
 160
 161 (defun chess-display-position (display)
 162   "Return the position currently viewed on DISPLAY."
 163   (chess-with-current-buffer display
 164     (if chess-display-edit-mode
 165         chess-display-edit-position
 166       (chess-game-pos chess-module-game chess-display-index))))
 167
 168 (defun chess-display-set-ply (display ply)
 169   (chess-with-current-buffer display
 170     (let ((chess-game-inhibit-events t))
 171       (chess-display-set-index nil 1))
 172     (chess-game-set-plies chess-module-game
 173                           (list ply (chess-ply-create*
 174                                      (chess-ply-next-pos ply))))))
 175
 176 (defun chess-display-ply (display)
 177   (chess-with-current-buffer display
 178     (chess-game-ply chess-module-game chess-display-index)))
 179
 180 (defun chess-display-set-variation (display variation &optional index)
 181   "Set DISPLAY VARIATION.
 182 If INDEX is not specified, this will cause the first ply in the variation
 183 to be displayed, with the user able to scroll back and forth through the
 184 moves in the variation.  Any moves made on the board will extend/change the
 185 variation that was passed in."
 186   (chess-with-current-buffer display
 187     (let ((chess-game-inhibit-events t))
 188       (chess-display-set-index nil (or index (chess-var-index variation))))
 189     (chess-game-set-plies chess-module-game variation)))
 190
 191 (defun chess-display-variation (display)
 192   (chess-with-current-buffer display
 193     (chess-game-main-var chess-module-game)))
 194
 195 (defun chess-display-set-game* (display game &optional index)
 196   "Set the game associated with the given DISPLAY."
 197   (chess-with-current-buffer display
 198     (chess-module-set-game* display game)
 199     (chess-display-set-index nil (or index (chess-game-index game)))))
 200
 201 (defun chess-display-set-game (display game &optional index)
 202   "Set the given DISPLAY to display the GAME object, optionally at INDEX.
 203 This is the function to call to cause a display to view a game.  It
 204 will also update all of the listening engines and other displays to
 205 also view the same game."
 206   (chess-with-current-buffer display
 207     (chess-game-copy-game chess-module-game game)
 208     (chess-display-set-index nil (or index (chess-game-index game)))))
 209
 210 (defalias 'chess-display-game 'chess-module-game)
 211
 212 (defun chess-display-clock-string ()
 213   (let ((white (chess-game-data chess-module-game 'white-remaining))
 214         (black (chess-game-data chess-module-game 'black-remaining)))
 215     (unless (and white black)
 216       (let ((last-ply (chess-game-ply chess-module-game
 217                                       (1- chess-display-index))))
 218         (setq white (chess-ply-keyword last-ply :white)
 219               black (chess-ply-keyword last-ply :black))))
 220     (if (and white black)
 221         (format "W %s%02d:%02d B %s%02d:%02d   "
 222                 (if (and (< white 0) (= 0 (floor white))) "-" "")
 223                 (/ (floor white) 60) (% (abs (floor white)) 60)
 224                 (if (and (< black 0) (= 0 (floor black))) "-" "")
 225                 (/ (floor black) 60) (% (abs (floor black)) 60)))))
 226
 227 (defun chess-display-set-index (display index)
 228   (chess-with-current-buffer display
 229     (if (not (or (not (integerp index))
 230                  (< index 0)
 231                  (> index (chess-game-index chess-module-game))))
 232         (chess-game-run-hooks chess-module-game 'set-index index)
 233       (when (and (> index (chess-game-index chess-module-game))
 234                  (not (chess-ply-final-p (chess-game-ply chess-module-game))))
 235         (chess-game-run-hooks chess-module-game 'forward)))))
 236
 237 (defun chess-display-set-index* (display index)
 238   (chess-with-current-buffer display
 239     (setq chess-display-index index
 240           chess-display-move-text
 241           (if (= index 0)
 242               (chess-string 'mode-start)
 243             (concat (int-to-string (if (> index 1)
 244                                        (if (= (mod index 2) 0)
 245                                            (/ index 2)
 246                                          (1+ (/ index 2)))
 247                                      1))
 248                     "." (and (= 0 (mod index 2)) "..")
 249                     (chess-ply-to-algebraic
 250                      (chess-game-ply chess-module-game (1- index)))))
 251           chess-display-side-to-move
 252           (let ((status (chess-game-status chess-module-game index)))
 253             (cond
 254              ((eq status :aborted)   (chess-string 'mode-aborted))
 255              ((eq status :resign)    (chess-string 'mode-resigned))
 256              ((eq status :drawn)     (chess-string 'mode-drawn))
 257              ((eq status :checkmate) (chess-string 'mode-checkmate))
 258              ((eq status :stalemate) (chess-string 'mode-stalemate))
 259              ((eq status :flag-fell) (chess-string 'mode-flag-fell))
 260              (t
 261               (let* ((color (or chess-pos-always-white
 262                                 (chess-game-side-to-move chess-module-game
 263                                                          index)))
 264                      (str (format " %s " (if color
 265                                              (chess-string 'mode-white)
 266                                            (chess-string 'mode-black)))))
 267                 (add-text-properties
 268                  0 (length str) (list 'face (if color
 269                                                 'chess-display-white-face
 270                                               'chess-display-black-face)) str)
 271                 str)))))
 272     (force-mode-line-update)))
 273
 274 (defsubst chess-display-index (display)
 275   (chess-with-current-buffer display
 276     chess-display-index))
 277
 278 (defun chess-display-update (display &optional popup)
 279   "Update the chessboard DISPLAY.  POPUP too, if that arg is non-nil."
 280   (chess-with-current-buffer display
 281     (funcall chess-display-event-handler 'draw
 282              (chess-display-position nil) chess-display-perspective)
 283     (if (and popup chess-display-popup
 284              (chess-module-leader-p nil))
 285         (chess-display-popup nil))))
 286
 287 (defun chess-display-redraw (&optional display)
 288   "Just redraw the current display."
 289   (interactive)
 290   (chess-with-current-buffer display
 291     (let ((here (point)))
 292       (erase-buffer)
 293       (chess-display-update nil)
 294       (goto-char here))))
 295
 296 (defun chess-display-index-pos (display index)
 297   (chess-with-current-buffer display
 298     (unless chess-display-index-positions
 299       (setq chess-display-index-positions (make-vector 64 nil))
 300       (let ((pos (next-single-property-change (point-min) 'chess-coord))
 301             pos-index)
 302         (while pos
 303           (if (setq pos-index (get-text-property pos 'chess-coord))
 304               (aset chess-display-index-positions pos-index pos))
 305           (setq pos (next-single-property-change pos 'chess-coord)))
 306         (unless (aref chess-display-index-positions 0)
 307           (aset chess-display-index-positions 0
 308                 (if chess-display-perspective
 309                     (point-min)
 310                   (1- (point-max)))))
 311         (unless (aref chess-display-index-positions 63)
 312           (aset chess-display-index-positions 63
 313                 (if chess-display-perspective
 314                     (1- (point-max))
 315                   (point-min))))))
 316     (aref chess-display-index-positions index)))
 317
 318 (defun chess-display-paint-move (display ply)
 319   (chess-with-current-buffer display
 320     (let ((position (chess-ply-pos ply))
 321           (ch (chess-ply-changes ply)))
 322       (while ch
 323         (if (symbolp (car ch))
 324             (setq ch nil)
 325           (let ((from (car ch))
 326                 (to (cadr ch)))
 327             (funcall chess-display-event-handler 'draw-square
 328                      (chess-display-index-pos nil from) ?  from)
 329             (let ((new-piece (chess-ply-keyword ply :promote)))
 330               (if new-piece
 331                   (funcall chess-display-event-handler 'draw-square
 332                            (chess-display-index-pos nil to)
 333                            (if (chess-pos-side-to-move position)
 334                                new-piece
 335                              (downcase new-piece)) to)
 336                 (funcall chess-display-event-handler 'draw-square
 337                          (chess-display-index-pos nil to)
 338                          (chess-pos-piece position from) to)))
 339             (when (chess-ply-keyword ply :en-passant)
 340               (funcall chess-display-event-handler 'draw-square
 341                        (chess-display-index-pos nil (chess-pos-en-passant position))
 342                        ?  (chess-pos-en-passant position))))
 343           (setq ch (cddr ch)))))))
 344
 345 (chess-message-catalog 'english
 346   '((not-your-move . "It is not your turn to move")
 347     (game-is-over  . "This game is over")))
 348
 349 (defun chess-display-move (display ply &optional prev-pos pos)
 350   "Move a piece on DISPLAY, by applying the given PLY.
 351 The position of PLY must match the currently displayed position.
 352 If only START is given, it must be in algebraic move notation."
 353   (chess-with-current-buffer display
 354     (if (and (chess-display-active-p)
 355              ;; `active' means we're playing against an engine
 356              (chess-game-data chess-module-game 'active)
 357              (not (eq (chess-game-data chess-module-game 'my-color)
 358                       (chess-game-side-to-move chess-module-game))))
 359         (chess-error 'not-your-move)
 360       (if (and (= chess-display-index
 361                   (chess-game-index chess-module-game))
 362                (chess-game-over-p chess-module-game))
 363           (chess-error 'game-is-over)))
 364     (if (= chess-display-index (chess-game-index chess-module-game))
 365         (let ((chess-display-handling-event t))
 366           (chess-display-paint-move nil ply)
 367           (chess-game-move chess-module-game ply)
 368           (chess-display-set-index* nil (chess-game-index chess-module-game)))
 369       ;; jww (2002-03-28): This should beget a variation within the
 370       ;; game, or alter the game, just as SCID allows
 371       (chess-error 'cannot-yet-add))))
 372
 373 (defun chess-display-highlight (display &rest args)
 374   "Highlight the square at INDEX on the current position.
 375 The given highlighting MODE is used, or the default if the style you
 376 are displaying with doesn't support that mode.  `selected' is a mode
 377 that is supported by most displays, and is the default mode."
 378   (chess-with-current-buffer display
 379     (let ((mode :selected))
 380       (dolist (arg args)
 381         (if (or (symbolp arg) (stringp arg))
 382             (setq mode arg)
 383           (funcall chess-display-event-handler 'highlight arg mode))))))
 384
 385 (defun chess-display-highlight-legal (display pos)
 386   "Highlight all legal move targets from POS."
 387   (chess-with-current-buffer display
 388     (dolist (ply (chess-legal-plies (chess-display-position nil)
 389                                     :index pos))
 390       (chess-display-highlight nil "pale green"
 391                                (chess-ply-target ply)))))
 392
 393 (defun chess-display-popup (display)
 394   "Popup the given DISPLAY, so that it's visible to the user."
 395   (chess-with-current-buffer display
 396     (unless (eq (get-buffer-window (current-buffer))
 397                 (selected-window))
 398       (funcall chess-display-event-handler 'popup))))
 399
 400 (defun chess-display-enable-popup (display)
 401   "Popup the given DISPLAY, so that it's visible to the user."
 402   (chess-with-current-buffer display
 403     (setq chess-display-popup nil)))
 404
 405 (defun chess-display-disable-popup (display)
 406   "Popup the given DISPLAY, so that it's visible to the user."
 407   (chess-with-current-buffer display
 408     (setq chess-display-popup t)))
 409
 410 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 411 ;;
 412 ;; Default window and frame popup functions
 413 ;;
 414
 415 (defun chess-display-popup-in-window ()
 416   "Popup the given DISPLAY, so that it's visible to the user."
 417   (unless (get-buffer-window (current-buffer))
 418     (if (> (length (window-list)) 1)
 419         (fit-window-to-buffer (display-buffer (current-buffer)))
 420       (display-buffer (current-buffer)))))
 421
 422 (defun chess-display-popup-in-frame (height width &optional
 423                                             display no-minibuffer)
 424   "Popup the given DISPLAY, so that it's visible to the user."
 425   (let ((window (get-buffer-window (current-buffer) t)))
 426     (if window
 427         (let ((frame (window-frame window)))
 428           (unless (eq frame (selected-frame))
 429             (raise-frame frame)))
 430       (let ((params (list (cons 'name "*Chessboard*")
 431                           (cons 'height height)
 432                           (cons 'width width))))
 433         (if display
 434             (push (cons 'display display) params))
 435         (if no-minibuffer
 436             (push (cons 'minibuffer nil) params))
 437         (select-frame (make-frame params))
 438         (set-window-dedicated-p (selected-window) t)))))
 439
 440 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 441 ;;
 442 ;; Event handler
 443 ;;
 444
 445 (defcustom chess-display-interesting-events
 446   '(set-index)
 447   "Events which will cause a display refresh."
 448   :type '(repeat symbol)
 449   :group 'chess-display)
 450
 451 (defcustom chess-display-momentous-events
 452   '(orient post-undo setup-game pass move resign abort)
 453   "Events that will refresh, and cause 'main' displays to popup.
 454 These are displays for which `chess-display-set-main' has been
 455 called."
 456   :type '(repeat symbol)
 457   :group 'chess-display)
 458
 459 (defun chess-display-handler (game event &rest args)
 460   "This display module presents a standard chessboard.
 461 See `chess-display-type' for the different kinds of displays."
 462   (unless chess-display-handling-event
 463     (if (eq event 'initialize)
 464         (progn
 465           (chess-display-mode)
 466           (setq chess-display-index (chess-game-index game)
 467                 chess-display-side-to-move
 468                 (if (chess-pos-side-to-move (chess-game-pos game))
 469                     (chess-string 'mode-white)
 470                   (chess-string 'mode-black))
 471                 chess-display-move-text (chess-string 'mode-start)
 472                 chess-display-perspective (car args)
 473                 chess-display-event-handler
 474                 (intern-soft (concat (symbol-name chess-display-style)
 475                                      "-handler")))
 476           (and chess-display-event-handler
 477                (funcall chess-display-event-handler 'initialize)))
 478       (cond
 479        ((eq event 'pass)
 480         (let ((my-color (chess-game-data game 'my-color)))
 481           (chess-game-set-data game 'my-color (not my-color))
 482           (chess-display-set-perspective* nil (not my-color))))
 483
 484        ((eq event 'set-index)
 485         (chess-display-set-index* nil (car args)))
 486
 487        ((eq event 'orient)
 488         (let ((my-color (chess-game-data game 'my-color)))
 489           ;; Set the display's perspective to whichever color I'm
 490           ;; playing
 491           (chess-display-set-perspective* nil my-color))))
 492
 493       (if (memq event chess-display-momentous-events)
 494           (progn
 495             (chess-display-set-index* nil (chess-game-index game))
 496             (if (eq event 'move)
 497                 (progn
 498                   (chess-display-paint-move nil (car args))
 499                   (if chess-display-popup
 500                       (chess-display-popup nil)))
 501               (chess-display-update nil chess-display-popup)))
 502         (if (memq event chess-display-interesting-events)
 503             (chess-display-update nil))))))
 504
 505 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 506 ;;
 507 ;; chess-display-mode
 508 ;;
 509
 510 (defvar chess-display-safe-map
 511   (let ((map (make-keymap)))
 512     (suppress-keymap map)
 513     (set-keymap-parent map nil)
 514
 515     (define-key map [(control ?i)] 'chess-display-invert)
 516     (define-key map [tab] 'chess-display-invert)
 517
 518     (define-key map [??] 'describe-mode)
 519     (define-key map [?L] 'chess-display-list-buffers)
 520     ;;(define-key map [?C] 'chess-display-duplicate)
 521     (define-key map [?I] 'chess-display-invert)
 522
 523     (define-key map [?<] 'chess-display-move-first)
 524     (define-key map [?,] 'chess-display-move-backward)
 525     (define-key map [(meta ?<)] 'chess-display-move-first)
 526     (define-key map [?>] 'chess-display-move-last)
 527     (define-key map [?.] 'chess-display-move-forward)
 528     (define-key map [(meta ?>)] 'chess-display-move-last)
 529
 530     (define-key map [(meta ?w)] 'chess-display-kill-board)
 531
 532     (define-key map [(control ?l)] 'chess-display-redraw)
 533
 534     map)
 535   "The mode map used in read-only display buffers.")
 536
 537 (defvar chess-display-mode-map
 538   (let ((map (copy-keymap chess-display-safe-map)))
 539     (define-key map [space] 'chess-display-pass)
 540     (define-key map [? ] 'chess-display-pass)
 541     (define-key map [??] 'describe-mode)
 542     (define-key map [?@] 'chess-display-remote)
 543     (define-key map [?A] 'chess-display-manual-move)
 544     (define-key map [(control ?c) (control ?a)] 'chess-display-abort)
 545     (define-key map [?C] 'chess-display-duplicate)
 546     (define-key map [?D] 'chess-display-decline)
 547     (define-key map [(control ?c) (control ?c)] 'chess-display-force)
 548     (define-key map [(control ?c) (control ?d)] 'chess-display-draw)
 549     (define-key map [?E] 'chess-display-edit-board)
 550     (define-key map [?F] 'chess-display-set-from-fen)
 551     (define-key map [(control ?c) (control ?f)] 'chess-display-call-flag)
 552     (define-key map [?M] 'chess-display-match)
 553     (define-key map [(control ?c) (control ?r)] 'chess-display-resign)
 554     (define-key map [?R] 'chess-display-retract)
 555     (define-key map [?S] 'chess-display-shuffle)
 556     (define-key map [(control ?c) (control ?t)] 'chess-display-undo)
 557     (define-key map [?X] 'chess-display-quit)
 558     (define-key map [?Y] 'chess-display-accept)
 559
 560     (define-key map [?\{] 'chess-display-annotate)
 561     (define-key map [?\"] 'chess-display-chat)
 562     (define-key map [?\'] 'chess-display-chat)
 563     (define-key map [?\~] 'chess-display-check-autosave)
 564
 565     (define-key map [(control ?r)] 'chess-display-search-backward)
 566     (define-key map [(control ?s)] 'chess-display-search-forward)
 567     (define-key map [(control ?y)] 'chess-display-yank-board)
 568
 569     (dolist (key '(?a ?b ?c ?d ?e ?f ?g ?h
 570                    ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8
 571                    ?r ?n ?b ?q ?k
 572                    ?R ?N ?B ?Q ?K
 573                    ?o ?O ?x))
 574       (define-key map (vector key) 'chess-input-shortcut))
 575     (define-key map [backspace] 'chess-input-shortcut-delete)
 576
 577     (define-key map [(control ?m)] 'chess-display-select-piece)
 578     (define-key map [return] 'chess-display-select-piece)
 579     (cond
 580      ((featurep 'xemacs)
 581       (define-key map [(button1)] 'chess-display-mouse-select-piece)
 582       (define-key map [(button2)] 'chess-display-mouse-select-piece)
 583       (define-key map [(button3)] 'ignore))
 584      (t
 585       (define-key map [down-mouse-1] 'chess-display-mouse-select-piece)
 586       (define-key map [drag-mouse-1] 'chess-display-mouse-select-piece)
 587
 588       (define-key map [down-mouse-2] 'chess-display-mouse-select-piece)
 589       (define-key map [drag-mouse-2] 'chess-display-mouse-select-piece)
 590
 591       (define-key map [mouse-3] 'ignore)))
 592
 593     (define-key map [menu-bar files] 'undefined)
 594     (define-key map [menu-bar edit] 'undefined)
 595     (define-key map [menu-bar options] 'undefined)
 596     (define-key map [menu-bar buffer] 'undefined)
 597     (define-key map [menu-bar tools] 'undefined)
 598     (define-key map [menu-bar help-menu] 'undefined)
 599
 600     map)
 601   "The mode map used in a chessboard display buffer.")
 602
 603 (defvar chess-display-move-menu nil)
 604 (unless chess-display-move-menu
 605   (easy-menu-define
 606     chess-display-move-menu chess-display-mode-map ""
 607     '("History"
 608       ["First" chess-display-move-first t]
 609       ["Previous" chess-display-move-backward t]
 610       ["Next" chess-display-move-forward t]
 611       ["Last" chess-display-move-last t])))
 612
 613 (defun chess-display-mode ()
 614   "A mode for displaying and interacting with a chessboard.
 615 The key bindings available in this mode are:
 616 \\{chess-display-mode-map}"
 617   (interactive)
 618   (setq major-mode 'chess-display-mode
 619         mode-name "Chessboard")
 620   (use-local-map chess-display-mode-map)
 621   (buffer-disable-undo)
 622   (setq buffer-auto-save-file-name nil
 623         mode-line-format chess-display-mode-line-format)
 624   (setq chess-input-position-function
 625         (function
 626          (lambda ()
 627            (chess-display-position nil))))
 628   (setq chess-input-move-function 'chess-display-move))
 629
 630 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 631 ;;
 632 ;; Commands used by the keyboard bindings above
 633 ;;
 634
 635 (defsubst chess-display-active-p ()
 636   "Return non-nil if the displayed chessboard reflects an active game.
 637 Basically, it means we are playing, not editing or reviewing."
 638   (and (chess-game-data chess-module-game 'active)
 639        (= chess-display-index
 640           (chess-game-index chess-module-game))
 641        (not (chess-game-over-p chess-module-game))
 642        (not chess-display-edit-mode)))
 643
 644 (defun chess-display-invert ()
 645   "Invert the perspective of the current chess board."
 646   (interactive)
 647   (chess-display-set-perspective nil (not chess-display-perspective)))
 648
 649 (defun chess-display-set-from-fen (fen)
 650   "Send the current board configuration to the user."
 651   (interactive "sSet from FEN string: ")
 652   (chess-display-set-position nil (chess-fen-to-pos fen)))
 653
 654 (defun chess-display-kill-board (&optional arg)
 655   "Send the current board configuration to the user."
 656   (interactive "P")
 657   (let ((x-select-enable-clipboard t)
 658         (game chess-module-game))
 659     (if arg
 660         (kill-new (with-temp-buffer
 661                     (chess-game-to-pgn game)
 662                     (buffer-string)))
 663       (kill-new (chess-pos-to-fen (chess-display-position nil))))))
 664
 665 (defun chess-display-yank-board ()
 666   "Send the current board configuration to the user."
 667   (interactive)
 668   (let ((x-select-enable-clipboard t)
 669         (display (current-buffer))
 670         (text (current-kill 0)))
 671     (with-temp-buffer
 672       (insert text)
 673       (goto-char (point-max))
 674       (while (and (bolp) (not (bobp)))
 675         (delete-backward-char 1))
 676       (goto-char (point-min))
 677       (cond
 678        ((search-forward "[Event " nil t)
 679         (goto-char (match-beginning 0))
 680         (chess-game-copy-game chess-module-game (chess-pgn-to-game)))
 681        ((looking-at (concat chess-algebraic-regexp "$"))
 682         (let ((move (buffer-string)))
 683           (with-current-buffer display
 684             (chess-display-manual-move move))))
 685        (t
 686         (with-current-buffer display
 687           (chess-display-set-from-fen (buffer-string))))))))
 688
 689 (defvar chess-display-search-map
 690   (let ((map (copy-keymap minibuffer-local-map)))
 691     (dolist (key '(?a ?b ?c ?d ?e ?f ?g ?h
 692                       ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8
 693                       ?r ?n ?b ?q ?k
 694                       ?R ?N ?B ?Q ?K
 695                       ?o ?O ?x))
 696       (define-key map (vector key) 'chess-display-search-key))
 697     (define-key map [backspace] 'chess-display-search-delete)
 698     (define-key map [delete] 'chess-display-search-delete)
 699     (define-key map [(control ?h)] 'chess-display-search-delete)
 700     (define-key map [(control ?r)] 'chess-display-search-again)
 701     (define-key map [(control ?s)] 'chess-display-search-again)
 702     map))
 703
 704 (defvar chess-display-search-direction nil)
 705 (defvar chess-current-display nil)
 706 (defvar chess-display-previous-index nil)
 707
 708 (make-variable-buffer-local 'chess-display-previous-index)
 709
 710 (chess-message-catalog 'english
 711   '((san-not-found . "Could not find a matching move")))
 712
 713 (defun chess-display-search (&optional reset again)
 714   (interactive)
 715   (let ((str (concat "\\`" (minibuffer-contents)))
 716         limit index)
 717     (with-current-buffer chess-current-display
 718       (setq index (if reset
 719                       chess-display-previous-index
 720                     chess-display-index))
 721       (if again
 722           (setq index (if chess-display-search-direction
 723                           (1+ index)
 724                         (- index 2))))
 725       (catch 'found
 726         (while (if chess-display-search-direction
 727                    (< index (or limit
 728                                 (setq limit
 729                                       (chess-game-index chess-module-game))))
 730                  (>= index 0))
 731           (let* ((ply (chess-game-ply chess-module-game index))
 732                  (san (chess-ply-keyword ply :san))
 733                  (case-fold-search t))
 734             (when (and san (string-match str san))
 735               (chess-display-set-index nil (1+ index))
 736               (throw 'found t)))
 737           (setq index (funcall (if chess-display-search-direction '1+ '1-)
 738                                index)))
 739         (chess-error 'san-not-found)))))
 740
 741 (defun chess-display-search-again ()
 742   (interactive)
 743   (chess-display-search nil t))
 744
 745 (defun chess-display-search-key ()
 746   (interactive)
 747   (call-interactively 'self-insert-command)
 748   (chess-display-search))
 749
 750 (defun chess-display-search-delete ()
 751   (interactive)
 752   (call-interactively 'delete-backward-char)
 753   (chess-display-search t))
 754
 755 (defun chess-display-search-backward (&optional direction)
 756   (interactive)
 757   (setq chess-display-previous-index chess-display-index)
 758   (condition-case err
 759       (let ((chess-display-search-direction direction)
 760             (chess-current-display (current-buffer)))
 761         (read-from-minibuffer "Find algebraic move: " nil
 762                               chess-display-search-map))
 763     (quit
 764      (chess-display-set-index nil chess-display-previous-index))))
 765
 766 (defun chess-display-search-forward ()
 767   (interactive)
 768   (chess-display-search-backward t))
 769
 770 (chess-message-catalog 'english
 771   '((illegal-notation . "Illegal move notation: %s")
 772     (want-to-quit     . "Do you really want to quit? ")))
 773
 774 (defun chess-display-quit ()
 775   "Quit the game associated with the current display."
 776   (interactive)
 777   (if (or (not (chess-module-leader-p nil))
 778           (yes-or-no-p (chess-string 'want-to-quit)))
 779       (chess-module-destroy nil)))
 780
 781 (defun chess-display-annotate ()
 782   (interactive)
 783   (chess-game-run-hooks chess-module-game 'switch-to-annotations))
 784
 785 (defun chess-display-chat ()
 786   (interactive)
 787   (chess-game-run-hooks chess-module-game 'switch-to-chat))
 788
 789 (defun chess-display-manual-move (move)
 790   "Move a piece manually, using chess notation."
 791   (interactive
 792    (list (read-string
 793           (format "%s(%d): "
 794                   (if (chess-pos-side-to-move (chess-display-position nil))
 795                       "White" "Black")
 796                   (1+ (/ (or chess-display-index 0) 2))))))
 797   (let ((ply (chess-algebraic-to-ply (chess-display-position nil) move)))
 798     (unless ply
 799       (chess-error 'illegal-notation move))
 800     (chess-display-move nil ply)))
 801
 802 (defun chess-display-remote (display)
 803   (interactive "sDisplay this game on X server: ")
 804   (require 'chess-images)
 805   (let ((chess-images-separate-frame display))
 806     (chess-display-clone (current-buffer) 'chess-images
 807                          chess-display-perspective)))
 808
 809 (defun chess-display-duplicate (style)
 810   (interactive
 811    (list (concat "chess-"
 812                  (read-from-minibuffer "Create new display using style: "))))
 813   (chess-display-clone (current-buffer) (intern-soft style)
 814                        chess-display-perspective))
 815
 816 (defun chess-display-pass ()
 817   "Pass the move to your opponent.  Only valid on the first move."
 818   (interactive)
 819   (if (chess-display-active-p)
 820       (chess-game-run-hooks chess-module-game 'pass)
 821     (ding)))
 822
 823 (defun chess-display-shuffle ()
 824   "Generate a shuffled opening position."
 825   (interactive)
 826   (require 'chess-random)
 827   (if (and (chess-display-active-p)
 828            (= 0 chess-display-index))
 829       (chess-game-set-start-position chess-module-game
 830                                      (chess-fischer-random-position))
 831     (ding)))
 832
 833 (defun chess-display-match ()
 834   "Request a match with any listening engine."
 835   (interactive)
 836   (chess-game-run-hooks chess-module-game 'match))
 837
 838 (defun chess-display-accept ()
 839   (interactive)
 840   (if (chess-display-active-p)
 841       (chess-game-run-hooks chess-module-game 'accept)
 842     (ding)))
 843
 844 (defun chess-display-decline ()
 845   (interactive)
 846   (if (chess-display-active-p)
 847       (chess-game-run-hooks chess-module-game 'decline)
 848     (ding)))
 849
 850 (defun chess-display-retract ()
 851   (interactive)
 852   (if (chess-display-active-p)
 853       (chess-game-run-hooks chess-module-game 'retract)
 854     (ding)))
 855
 856 (defun chess-display-call-flag ()
 857   (interactive)
 858   (if (chess-display-active-p)
 859       (chess-game-run-hooks chess-module-game 'call-flag)
 860     (ding)))
 861
 862 (defun chess-display-force ()
 863   (interactive)
 864   (if (chess-display-active-p)
 865       (chess-game-run-hooks chess-module-game 'force)
 866     (ding)))
 867
 868 (defun chess-display-check-autosave ()
 869   (interactive)
 870   (if (chess-display-active-p)
 871       (chess-game-run-hooks chess-module-game 'check-autosave)
 872     (ding)))
 873
 874 (defun chess-display-resign ()
 875   "Resign the current game."
 876   (interactive)
 877   (if (chess-display-active-p)
 878       (chess-game-end chess-module-game :resign)
 879     (ding)))
 880
 881 (defun chess-display-abort ()
 882   "Abort the current game."
 883   (interactive)
 884   (if (chess-display-active-p)
 885       (chess-game-run-hooks chess-module-game 'abort)
 886     (ding)))
 887
 888 (chess-message-catalog 'english
 889   '((draw-offer . "You offer a draw")))
 890
 891 (defun chess-display-draw ()
 892   "Offer to draw the current game."
 893   (interactive)
 894   (if (chess-display-active-p)
 895       (progn
 896         (chess-message 'draw-offer)
 897         (chess-game-run-hooks chess-module-game 'draw))
 898     (ding)))
 899
 900 (defun chess-display-undo (count)
 901   "Abort the current game."
 902   (interactive "P")
 903   (if (chess-display-active-p)
 904       (progn
 905         ;; we can't call `chess-game-undo' directly, because not all
 906         ;; engines will accept it right away!  So we just signal the
 907         ;; desire to undo
 908         (setq count
 909               (if count
 910                   (prefix-numeric-value count)
 911                 (if (eq (chess-pos-side-to-move (chess-display-position nil))
 912                         (chess-game-data chess-module-game 'my-color))
 913                     2 1)))
 914         (chess-game-run-hooks chess-module-game 'undo count))
 915     (ding)))
 916
 917 (defun chess-display-list-buffers ()
 918   "List all buffers related to this display's current game."
 919   (interactive)
 920   (let ((buffer-list-func (symbol-function 'buffer-list)))
 921     (unwind-protect
 922         (let ((chess-game chess-module-game)
 923               (lb-command (lookup-key ctl-x-map [(control ?b)]))
 924               (ibuffer-maybe-show-regexps nil))
 925           (fset 'buffer-list
 926                 (function
 927                  (lambda ()
 928                    (delq nil
 929                          (mapcar (function
 930                                   (lambda (cell)
 931                                     (and (bufferp (cdr cell))
 932                                          (buffer-live-p (cdr cell))
 933                                          (cdr cell))))
 934                                  (chess-game-hooks chess-game))))))
 935           (call-interactively lb-command))
 936       (fset 'buffer-list buffer-list-func))))
 937
 938 (chess-message-catalog 'english
 939   '((return-to-current . "Use '>' to return to the current position")))
 940
 941 (defun chess-display-set-current (dir)
 942   "Change the currently displayed board.
 943 Direction may be - or +, to move forward or back, or t or nil to jump
 944 to the end or beginning."
 945   (let ((index (cond ((eq dir ?-) (1- chess-display-index))
 946                      ((eq dir ?+) (1+ chess-display-index))
 947                      ((eq dir t) nil)
 948                      ((eq dir nil) 0))))
 949     (chess-display-set-index
 950      nil (or index (chess-game-index chess-module-game)))
 951     (unless (chess-display-active-p)
 952       (chess-message 'return-to-current))))
 953
 954 (defun chess-display-move-backward ()
 955   (interactive)
 956   (chess-display-set-current ?-))
 957
 958 (defun chess-display-move-forward ()
 959   (interactive)
 960   (chess-display-set-current ?+))
 961
 962 (defun chess-display-move-first ()
 963   (interactive)
 964   (chess-display-set-current nil))
 965
 966 (defun chess-display-move-last ()
 967   (interactive)
 968   (chess-display-set-current t))
 969
 970 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 971 ;;
 972 ;; chess-display-edit-mode (for editing the position directly)
 973 ;;
 974
 975 (defvar chess-display-edit-position nil)
 976
 977 (make-variable-buffer-local 'chess-display-edit-position)
 978
 979 (defvar chess-display-edit-mode-map
 980   (let ((map (make-keymap)))
 981     (suppress-keymap map)
 982
 983     (define-key map [(control ?l)] 'chess-display-redraw)
 984     (define-key map [(control ?i)] 'chess-display-invert)
 985     (define-key map [tab] 'chess-display-invert)
 986
 987     (define-key map [??] 'describe-mode)
 988     (define-key map [?L] 'chess-display-list-buffers)
 989     ;;(define-key map [?C] 'chess-display-duplicate)
 990     (define-key map [?I] 'chess-display-invert)
 991
 992     (define-key map [?C] 'chess-display-clear-board)
 993     (define-key map [?G] 'chess-display-restore-board)
 994     (define-key map [?S] 'chess-display-send-board)
 995     (define-key map [?X] 'chess-display-quit)
 996
 997     (let ((keys '(?  ?p ?r ?n ?b ?q ?k ?P ?R ?N ?B ?Q ?K)))
 998       (while keys
 999         (define-key map (vector (car keys)) 'chess-display-set-piece)
1000         (setq keys (cdr keys))))
1001
1002     (cond
1003      ((featurep 'xemacs)
1004       (define-key map [(button1)] 'chess-display-mouse-select-piece)
1005       (define-key map [(button2)] 'chess-display-mouse-set-piece)
1006       (define-key map [(button3)] 'chess-display-mouse-set-piece))
1007      (t
1008       (define-key map [down-mouse-1] 'chess-display-mouse-select-piece)
1009       (define-key map [drag-mouse-1] 'chess-display-mouse-select-piece)
1010
1011       (define-key map [mouse-2] 'chess-display-mouse-set-piece)
1012       (define-key map [down-mouse-2] 'chess-display-mouse-set-piece)
1013       (define-key map [mouse-3] 'chess-display-mouse-set-piece)
1014       (define-key map [down-mouse-3] 'chess-display-mouse-set-piece)))
1015
1016     map)
1017   "The mode map used for editing a chessboard position.")
1018
1019 (chess-message-catalog 'english
1020   '((editing-directly
1021      . "Now editing position directly, use S when complete...")
1022     (clear-chessboard-q . "Really clear the chessboard? ")))
1023
1024 (defun chess-display-edit-board ()
1025   "Setup the current board for editing."
1026   (interactive)
1027   (setq chess-display-edit-position
1028         (chess-pos-copy (chess-display-position nil))
1029         chess-display-edit-mode t
1030         chess-display-side-to-move (chess-string 'mode-edit))
1031   (force-mode-line-update)
1032   (use-local-map chess-display-edit-mode-map)
1033   (funcall chess-display-event-handler 'start-edit)
1034   (chess-message 'editing-directly))
1035
1036 (defun chess-display-end-edit-mode ()
1037   (setq chess-display-edit-mode nil)
1038   (funcall chess-display-event-handler 'end-edit)
1039   (use-local-map chess-display-mode-map))
1040
1041 (defun chess-display-send-board ()
1042   "Send the current board configuration to the user."
1043   (interactive)
1044   (chess-display-end-edit-mode)
1045   (chess-game-set-start-position chess-module-game
1046                                  chess-display-edit-position))
1047
1048 (defun chess-display-restore-board ()
1049   "Setup the current board for editing."
1050   (interactive)
1051   (chess-display-end-edit-mode)
1052   ;; reset the modeline
1053   (chess-display-set-index* nil chess-display-index)
1054   (chess-display-update nil))
1055
1056 (defun chess-display-clear-board ()
1057   "Setup the current board for editing."
1058   (interactive)
1059   (when (y-or-n-p (chess-string 'clear-chessboard-q))
1060     (let ((position (chess-display-position nil)))
1061       (dotimes (rank 8)
1062         (dotimes (file 8)
1063           (chess-pos-set-piece position (cons rank file) ? ))))
1064     (chess-display-update nil)))
1065
1066 (defun chess-display-set-piece (&optional piece)
1067   "Set the piece under point to command character, or space for clear."
1068   (interactive)
1069   (if (or (null piece) (char-valid-p piece))
1070       (let ((index (get-text-property (point) 'chess-coord)))
1071         (chess-pos-set-piece chess-display-edit-position index
1072                              (or piece last-command-char))
1073         (funcall chess-display-event-handler 'draw-square
1074                  (point) (or piece last-command-char) index))))
1075
1076 (defun chess-display-mouse-set-piece (event)
1077   "Select the piece the user clicked on."
1078   (interactive "e")
1079   (if (fboundp 'event-window)           ; XEmacs
1080       (progn
1081         (set-buffer (window-buffer (event-window event)))
1082         (and (event-point event) (goto-char (event-point event))))
1083     (set-buffer (window-buffer (posn-window (event-start event))))
1084     (goto-char (posn-point (event-start event))))
1085   (let ((pieces (if (memq (car event) '(down-mouse-3 mouse-3))
1086                     '("Set black piece"
1087                       ("Pieces"
1088                        ("Pawn"   . ?p)
1089                        ("Knight" . ?n)
1090                        ("Bishop" . ?b)
1091                        ("Queen"  . ?q)
1092                        ("King"   . ?k)))
1093                   '("Set white piece"
1094                     ("Pieces"
1095                      ("Pawn"   . ?P)
1096                      ("Knight" . ?N)
1097                      ("Bishop" . ?B)
1098                      ("Queen"  . ?Q)
1099                      ("King"   . ?K))))))
1100     (chess-display-set-piece (x-popup-menu t pieces))))
1101
1102 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1103 ;;
1104 ;; Mousing around on the chess-display
1105 ;;
1106
1107 (defvar chess-display-last-selected nil)
1108
1109 (make-variable-buffer-local 'chess-display-last-selected)
1110
1111 (chess-message-catalog 'english
1112   '((cannot-mount   . "You cannot move pieces on top of each other")
1113     (move-not-legal . "That is not a legal move")
1114     (not-your-move  . "It is not your turn to move")
1115     (wrong-color    . "You cannot move your opponent's pieces")
1116     (selected-empty . "You cannot select an empty square")
1117     (piece-immobile . "That piece cannot move now")))
1118
1119 (defun chess-display-select-piece ()
1120   "Select the piece under the cursor.
1121 Clicking once on a piece selects it; then click on the target location."
1122   (interactive)
1123   (let ((coord (get-text-property (point) 'chess-coord))
1124         (position (chess-display-position nil))
1125         message)
1126     (when coord
1127       (setq message
1128             (catch 'message
1129               (if chess-display-last-selected
1130                   (let ((last-sel chess-display-last-selected))
1131                     ;; if they select the same square again, just deselect
1132                     ;; it by redrawing the display and removing all
1133                     ;; highlights
1134                     (if (= (point) (car last-sel))
1135                         (funcall chess-display-event-handler 'draw-square
1136                                  (car last-sel)
1137                                  (chess-pos-piece position (cdr last-sel))
1138                                  (cdr last-sel))
1139                       (let ((s-piece (chess-pos-piece position (cdr last-sel)))
1140                             (t-piece (chess-pos-piece position coord)) ply)
1141                         (if chess-display-edit-mode
1142                             (progn
1143                               (chess-pos-set-piece position (cdr last-sel) ? )
1144                               (chess-pos-set-piece position coord s-piece)
1145                               (chess-display-update nil))
1146                           (if (and (/= t-piece ? )
1147                                    (or (and (< t-piece ?a)
1148                                             (< s-piece ?a))
1149                                        (and (> t-piece ?a)
1150                                             (> s-piece ?a))))
1151                               (throw 'message (chess-string 'cannot-mount)))
1152                           (unless (setq ply (chess-ply-create position nil
1153                                                               (cdr last-sel)
1154                                                               coord))
1155                             (throw 'message (chess-string 'move-not-legal)))
1156                           (condition-case err
1157                               (chess-display-move nil ply
1158                                                   (car last-sel) (point))
1159                             (error
1160                              (throw 'message (error-message-string err)))))))
1161                     (setq chess-display-last-selected nil))
1162                 (let ((piece (chess-pos-piece position coord)))
1163                   (cond
1164                    ((eq piece ? )
1165                     (throw 'message (chess-string 'selected-empty)))
1166                    ((not (or chess-display-edit-mode
1167                              (not (chess-display-active-p))
1168                              (eq (chess-pos-side-to-move position)
1169                                  (chess-game-data chess-module-game
1170                                                   'my-color))))
1171                     (throw 'message (chess-string 'not-your-move)))
1172                    ((and (not chess-display-edit-mode)
1173                          (if (chess-pos-side-to-move position)
1174                              (> piece ?a)
1175                            (< piece ?a)))
1176                     (throw 'message (chess-string 'wrong-color)))
1177                    ((and (not chess-display-edit-mode)
1178                          chess-display-highlight-legal
1179                          (null (chess-legal-plies position :any :index coord)))
1180                     (throw 'message (chess-string 'piece-immobile))))
1181                   (setq chess-display-last-selected (cons (point) coord))
1182                   (chess-display-highlight nil coord)
1183                   (if (and (not chess-display-edit-mode)
1184                            chess-display-highlight-legal)
1185                       (chess-display-highlight-legal nil coord))))))
1186       (when message
1187         (when chess-display-last-selected
1188           (funcall chess-display-event-handler 'draw-square
1189                    (car chess-display-last-selected)
1190                    (chess-pos-piece position
1191                                     (cdr chess-display-last-selected))
1192                    (cdr chess-display-last-selected))
1193           (setq chess-display-last-selected nil))
1194         (message message)))))
1195
1196 (defun chess-display-mouse-select-piece (event)
1197   "Select the piece the user clicked on."
1198   (interactive "e")
1199   (if (fboundp 'event-window)           ; XEmacs
1200       (progn
1201         (set-buffer (window-buffer (event-window event)))
1202         (and (event-point event) (goto-char (event-point event))))
1203     (if (equal (event-start event) (event-end event))
1204         (progn
1205           (set-buffer (window-buffer (posn-window (event-start event))))
1206           (goto-char (posn-point (event-start event))))
1207       (goto-char (posn-point (event-end event)))))
1208   (chess-display-select-piece))
1209
1210 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1211 ;;
1212 ;; Maintain a face cache for given color strings
1213 ;;
1214
1215 (defvar chess-display-face-cache '((t . t)))
1216
1217 (defun chess-display-get-face (color)
1218   (or (cdr (assoc color chess-display-face-cache))
1219       (let ((face (make-face 'chess-display-highlight)))
1220         (set-face-attribute face nil :background color)
1221         (add-to-list 'chess-display-face-cache (cons color face))
1222         face)))
1223
1224 (provide 'chess-display)
1225
1226 ;;; chess-display.el ends here