;;; scid-browser.el --- Sophisticated example of `tree-widget' usage

;; Copyright (C) 2004 FSF

;; Author: Mario Lang <mlang@delysid.org>
;; Created: 25 Jan 2004
;; Keywords: extensions, games

(defconst scid-browser-version "1.0")

;; This file is not part of Emacs

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;;
;; This library is a sophisticated example of usage of the
;; `tree-widget' library.
;;
;; It defines the command `dir-tree' which displays a directory tree.
;; A directory content is read when unfolding the corresponding node
;; and reused later.  To refresh a directory content just click on the
;; corresponding node name.  Also, you can change the select/unselect
;; state of a file entry by clicking on it.
;;
;; To install and use, put this file on your Emacs-Lisp load path and
;; add the following into your ~/.emacs startup file:
;;
;; (require 'dir-tree)
;;

;;; Code:

(require 'chess-database)
(require 'tree-widget)


;;; Variables
;;
(defvar scid-browser-database nil)
(make-variable-buffer-local 'scid-browser-database)


;;; Widgets
;;
(define-widget 'scid-browser-ply-widget 'tree-widget
  "Chess ply widget."
  :dynargs      'scid-browser-expand-ply
  :has-children t)

(defun scid-browser-refresh-ply (widget &rest ignore)
  "Refresh WIDGET parent tree children.
IGNORE other arguments."
  (let ((tree (widget-get widget :parent)))
    ;; Clear the tree children cache.
    (widget-put tree :args nil)
    ;; Redraw the tree node.
    (widget-value-set tree (widget-value tree))))

(defun scid-browser-widget (plies)
  "Return a widget to display file or directory E."
  (assert (stringp plies))
  `(scid-browser-ply-widget
    :node (push-button
	   :tag ,(if (string= plies "")
		     "Starting Position"
		   (car (last (split-string plies " "))))
	   :format "%[%t%]\n"
	   :notify scid-browser-refresh-ply)
    :game ,(let ((game (chess-game-create)))
	     (mapc
	      (lambda (move)
		(chess-game-move
		 game (chess-algebraic-to-ply (chess-game-pos game) move)))
	      (split-string plies " "))
	     game)
    :plies ,plies))

(defun scid-browser-expand-ply (tree)
  "Return TREE widget children.
Reuse :args cache if exists."
  (or
   (widget-get tree :args)
   (let ((game (widget-get tree :game))
	 (plies (widget-get tree :plies)))
;        (condition-case err
            (prog1
                (mapcar 'scid-browser-widget (scid-browser-list plies game))
;              (message "Reading directory '%s'...done" dir)
	      )
          ;(error
          ; (message "%s" (error-message-string err))
          ; nil)
	  )))

(defun scid-browser-list (plies game &optional database)
  (let ((vars (cdddr (chess-database-query
		      (or database scid-browser-database) 'tree-search game))))
    (mapcar
     (lambda (info)
       (concat plies
	       (if (string= plies "")
		   "" " ")
	       (car info)))
     vars)))


;;; Command
;;
(defun scid-browser (database)
  "Display a tree of all games in DATABASE."
  (interactive "fScid database: ")
  (unless (and (bufferp database) (buffer-live-p database))
    (unless (setq database (chess-database-open database))
      (error "Unable to open database %s" database)))
  (switch-to-buffer
   (format "*scid-browser for %s*" (chess-database-filename database)))
  (kill-all-local-variables)
  (let ((inhibit-read-only t))
    (erase-buffer))
  (let ((all (overlay-lists)))
    (mapcar 'delete-overlay (car all))
    (mapcar 'delete-overlay (cdr all)))
  (tree-widget-set-theme "folder")
  (widget-insert
   (format "scid database %s, %d games. \n\n"
	   (chess-database-filename database)
	   (chess-database-count database)))
  (setq scid-browser-database database)
  (widget-create (scid-browser-widget ""))
  (use-local-map widget-keymap)
  (widget-setup)
  (goto-char (point-min)))

(provide 'scid-browser)

;;; scid-browser.el ends here
