;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: debug
;;;                       Version: 1.0
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/utilities/debug.lisp
;;; File Creation Date: 06/22/92 11:23:36
;;; Last Modification Time: 08/04/92 10:55:41
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________

(in-package :xit)

(defvar it nil)

(defun all-windows ()
  (declare (special *toplevel*))
  (composite-children *toplevel*))

(defun last-window ()
  (first (last (all-windows))))

(defun bind-it ()
  (declare (special *))
  (setq it *))

(defmethod get-uninitialized ((window basic-contact))
  (unless (or (realized-p window)
	      (eq (contact-state window) :withdrawn))
    window))

(defmethod get-uninitialized ((window composite))
  (or (call-next-method)
      (let ((found nil))
	(dolist (win (composite-children window))
	  (setq found (get-uninitialized win))
	  (when found (return found))))))

(defun find-uninitialized (&optional (window *toplevel*))
  (get-uninitialized window))

(defun bind-uninitialized (&optional (window *toplevel*))
  (setq it (get-uninitialized window)))

(defun destroy-uninitialized (&optional (window *toplevel*))
  (let ((win (get-uninitialized window)))
    (when win (destroy win) win)))

(defmethod init-geometry ((window basic-contact))
  (with-slots (width height) window
      (setf width 16
	    height 16)))

(defmethod init-children ((window composite))
  (with-slots (children) window
      (setf children nil)))

(defmethod init-parent ((window basic-contact))
  (with-slots (parent) window
      (setf parent *toplevel*)))
