;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XAM
;;;                       Module: Initialization
;;;                       Version: 1.0
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/xam/init.lisp
;;; File Creation Date: 10/09/92 11:29:08
;;; Last Modification Time: 12/10/92 09:10:05
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________

(in-package :xit)              

;(pushnew (system-pathname :xam "bitmaps/") *bitmap-directory*)

(define-resources
  (* meta-identifier x) 200
  (* meta-identifier y) 5
  (* meta-identifier border-width) 2
  (* meta-identifier inside-border) 5
  (* meta-identifier background) "gray88"
  (* meta-identifier cursor) "dot"
  (* meta-identifier font) '(:face :italic)

  (* meta-property-sheet part-label-value-distance) 10

  (* window-pallete bitmap-menu background) 0.12
  (* window-pallete bitmap-menu * background) "white"

  (* :catalog background) "white"
  (* :catalog x) 150
  (* :catalog y) 150
  (* :catalog width) 500
  (* :catalog height) 400
  (* :catalog :work-area :client background) 0.12

  (* :gio-graph-window :object :foreground) "black"
  (* :gio-graph-window :object :background) "white"
  (* :gio-graph-window :object :border-width) 0

  (* :gio-graph-window :window :foreground) "black"
  (* :gio-graph-window :window :background) "white"
  (* :gio-graph-window :window :inside-border) 2
  (* :gio-graph-window :window :border-width) 1
  (* :gio-graph-window :window :border) "black"

  (* :gio-graph-window :text-dispel :foreground) "black"
  (* :gio-graph-window :text-dispel :background) "white"
  (* :gio-graph-window :text-dispel :border-width) 1
  (* :gio-graph-window :text-dispel :border) "black"

  (* :gio-graph-window :bitmap-dispel :foreground) "black"
  (* :gio-graph-window :bitmap-dispel :background) "white"
  (* :gio-graph-window :bitmap-dispel :border-width) 0

  (* :gio-graph-window :layouter :foreground) "black"
  (* :gio-graph-window :layouter :background) "white"
  (* :gio-graph-window :layouter :border-width) 0
  
  (* :gio-graph-window :link :foreground) "black"
  (* :gio-graph-window :part-link :foreground) "black"
  (* :gio-graph-window :part-of-link :foreground) "black"
  (* :gio-graph-window :view-of-link :foreground) "black"
  (* :gio-graph-window :layouter-link :foreground) "black"
  (* :gio-graph-window :icon-link :foreground) "black"
  (* :gio-graph-window :popup-part-link :foreground) "black"
  )

(when (color-display-p *display*)
  (load (system-pathname :xam "color-resources")))

(defparameter *meta-pool*
    (make-instance 'window-pool-manager
      :window-creation-function #'(lambda (key) (make-meta-sheet-named key))
      :key-transformation #'contact-name
      :before-enter-function
      #'(lambda (window view-of)
	  (setf (contact-state window) :withdrawn))))

(defparameter *meta-sheet-pool*
    (make-instance 'window-pool-manager
      :window-creation-function #'(lambda (key) (make-meta-sheet key))
      :key-transformation #'view-of
;      :key-transformation #'(lambda (window)
;			      (view-of (part window :property-sheet)))
      :internal-key-transformation #'meta-sheet-pool-internal-key-transformation
;      :internal-key-transformation #'class-of
      :before-enter-function
      #'(lambda (window view-of)
	  (setf (contact-state window) :withdrawn))
      :after-leave-function
;      #'(setf view-of) ;; new ansi-cl
      #'(lambda (window view-of) (setf (view-of window) view-of))
;      #'(lambda (window view-of)
;	  (setf (view-of (part window :property-sheet)) view-of))
      ))
 
(defparameter *meta-property-sheet-pool*
    (make-instance 'window-pool-manager
      :window-creation-function #'(lambda (key) (make-meta-property-sheet key))
      :key-transformation #'view-of 
      :internal-key-transformation #'class-of
      :before-enter-function
      #'(lambda (window view-of)
	  (setf (contact-state window) :withdrawn))
      :after-leave-function
      #'(lambda (window view-of) (setf (view-of window) view-of))))
  
(defparameter *meta-operation-sheet-pool*
    (make-instance 'window-pool-manager
      :window-creation-function #'(lambda (key) (make-meta-operation-sheet key))
      ;:internal-key-transformation #'null
      :key-transformation #'view-of
      :internal-key-transformation #'class-of
      :before-enter-function
      #'(lambda (window view-of)
	  (setf (contact-state window) :withdrawn))
      :after-leave-function
      #'(lambda (window view-of) (setf (view-of window) view-of))))
 
(defparameter *meta-layout-sheet-pool*
    (make-instance 'window-pool-manager
      :window-creation-function #'(lambda (key) (make-layout-meta-sheet key))
      :key-transformation #'view-of
      :internal-key-transformation #'class-of
      :before-enter-function
      #'(lambda (window view-of)
	  (declare (ignore view-of))
	  (setf (contact-state window) :withdrawn))
      :after-leave-function
      #'(lambda (window view-of)
	  (setf (view-of window) view-of))))
 
(defparameter *meta-add-part-sheet-pool*
    (make-instance 'window-pool-manager
      :window-creation-function #'(lambda (key) (make-meta-add-part-sheet key))
      :key-transformation #'view-of 
      :internal-key-transformation #'class-of
      :before-enter-function
      #'(lambda (window view-of)
	  (setf (contact-state window) :withdrawn))
      :after-leave-function
      #'(lambda (window view-of) (setf (view-of window) view-of))))
  
;(defparameter *meta-identifier*
;    (make-window 'identifier-for-meta-system))

(defparameter *meta-identifier*
    (make-window 'window-identifier
		 :name :meta-identifier
		 :label "Select Metasystem"
		 :action #'select-meta-system))

;#+xbrowse
;(load (system-pathname :xam "meta-browse"))

#+xbrowse
(load (system-pathname :xam "init-meta-browse"))

