;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: Containers
;;;                       Version: 1.0
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/kernel/containers.lisp
;;; File Creation Date: 04/10/92 15:11:41
;;; Last Modification Time: 07/24/92 11:31:25
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________

(in-package :xit)

;;;___________________________________________________________________________
;;;
;;;                      Layouter for Containers
;;;___________________________________________________________________________


(defclass container-layouter (layouter)
  ())

(defmethod layout ((self container-layouter) window)
  (with-slots (parent adjust-size? width height border-width) window
    (with-slots ((parent-adjust-size? adjust-size?)
		 (parent-width width)
		 (parent-height height)) parent
	(if parent-adjust-size?
	    (values (x-margin parent)
		    (y-margin parent)
		    width
		    height
		    border-width)
	  (values (x-margin parent)
		  (y-margin parent)
		  (- parent-width (x-margins parent))
		  (- parent-height (x-margins parent))
		  border-width)))))

;;;___________________________________________________________________________
;;;
;;;                             Containers
;;;___________________________________________________________________________

(defcontact container-window (intel)
  ((layouter :initform 'container-layouter))
  (:resources
   (border-width :initform 0)
   (inside-border :initform 0))
  (:documentation "Intels which are composed of just one part, the client 
                   window"))


(defmethod initialize-instance :after ((self container-window) &rest initargs
				       &key client-window)
  (assert (not (null client-window)) nil
    "A client-window must be specified for containers!")
  (unless (eq client-window :none) (add-client self client-window)))

(defmethod add-client ((self container-window) (client-specs symbol)
		       &rest override-initargs)
  (apply #'add-part self :class client-specs override-initargs))

(defmethod add-client ((self container-window) (client-specs cons)
		       &rest override-initargs)
  (apply #'add-part self
	 :class (car client-specs)
	 (append override-initargs (cdr client-specs))))

(defmethod client-window ((self container-window))
  (or (car (parts self))
      (error "A client-window is missing.")))

(defmethod identification ((self container-window))
  (value (client-window self)))

(defmethod (setf identification) (value (self container-window))
  (setf (value (client-window self)) value))

;;;___________________________________________________________________________
;;;
;;;                        Special Containers
;;;___________________________________________________________________________

(defcontact popup-container (popup-window container-window)
  ()
  (:resources
   (border-width :initform 0)
   (inside-border :initform 0)))

#||
;; Example:
(popup
(make-window 'popup-container
	     :destroy-after? t
	     :client-window '(text-dispel
			      :inside-border 10
			      :border-width 1
			      :background "white"
			      :text "popup text"
			      :font (:size 18)))
)
||#

(defcontact popup-part-container (popup-part-connection container-window)
  ())

#||
;; Example:
(make-window 'popup-part-container
	     :popup-part :default
	     :reactivity '((:menu))
	     :client-window '(text-dispel
			      :inside-border 10
			      :border-width 1
			      :background "white"
			      :text "text with popup"
			      :font (:size 18)))
||#

(defcontact window-icon-container (window-icon-mixin container-window)
  ())

#||
;; Example:
(make-window 'window-icon-container
	     :window-icon :default
	     :reactivity '((:double-left-button "Shrink"
						(call :self shrink)))
	     :client-window '(text-dispel
			      :inside-border 10
			      :border-width 1
			      :background "white"
			      :text "text with icon"
			      :font (:size 18)))
||#

(defcontact shadow-borders-container (shadow-borders-mixin container-window)
  ())

#||
;; Example:
(make-window 'shadow-borders-container
	     :client-window '(text-dispel
			      :inside-border 10
			      :border-width 1
			      :background "white"
			      ;:adjust-size? nil
			      :text "text with shadow"
			      :font (:size 18)))
||#

(defcontact shadow-borders-popup-container (shadow-borders-mixin
					    popup-container)
  ())

(defcontact window-icon-popup-part-container (window-icon-mixin popup-part-container)
  ())
