;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XAM
;;;                       Module: Meta System for Layouters
;;;                       Version: 1.0
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/xam/layout-meta.lisp
;;; File Creation Date: 10/18/91 08:22:41
;;; Last Modification Time: 07/30/92 14:10:40
;;; Last Modification By: Juergen Herczeg
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________

(in-package :xit)

(defvar *meta-layouter-menu*)

(defmethod select-meta-layouter-menu ((self layouted-window))
  (declare (special *meta-layouter-menu*))
  (unless (and (boundp '*meta-layouter-menu*) *meta-layouter-menu*)
    (setf *meta-layouter-menu* (make-meta-layouter-menu)))
  (setf (view-of *meta-layouter-menu*) self)
  (popup *meta-layouter-menu*))

(defun destroy-meta-layouter-menu ()
  (declare (special *meta-layouter-menu*))
  (destroy-and-make-unbound *meta-layouter-menu*))

(defun make-meta-layouter-menu ()
  (while-busy nil
    (make-window 'shadow-popup-margined-window
       :name :meta-layouter-menu
       :adjust-size? t
       :destroy-after? nil
       :margins 
       `((standard-margins
	  :label-options
	  (:name :label
	   :inside-border 3
	   :text "Layout")
	  :quad-space-options
	  (:name :space
	   :thickness 1)))
       :client-window 
       `(bitmap-menu
	 :adjust-size? t
	 :inside-border 5
	 :layouter (distance-layouter :distance 5)
	 :reactivity-entries
	 ((:part-event
	   (call :eval (setf (layouter (view-of *self*))
			   (make-gio *part-value*)))
	   (call :self hide-popup-parent)
	   (call :view-of select-layout-meta-sheet-for)))
	 :part-mouse-feedback :inverse
	 :parts
	 ((:view-of basic-layouter
	   :bitmap "basic-layouter"
	   :border-width 1
	   :action-docu "Select class: basic-layouter")
	  (:view-of offset-layouter
	   :bitmap "offset-layouter"
	   :border-width 1
	   :action-docu "Select class: offset-layouter")
	  (:view-of aligning-distance-layouter
	   :bitmap "distance-layouter"
	   :border-width 1
	   :action-docu "Select class: aligning-distance-layouter")
	  (:view-of aligning-multiline-distance-layouter
	   :bitmap "multiline-distance-layouter"
	   :border-width 1
	   :action-docu "Select class: aligning-multiline-layouter")
	  (:view-of indent-distance-layouter
	   :bitmap "indent-distance-layouter"
	   :border-width 1
	   :action-docu "Select class: indent-distance-layouter")
	  (:view-of single-indent-distance-layouter
	   :bitmap "single-indent-distance-layouter"
	   :border-width 1
	   :action-docu "Select class: single-indent-distance-layouter"))))))
		 
(defmethod select-layout-meta-sheet-for ((self layouted-window))
  (with-slots (layouter) self
    (if layouter
      (select-layout-meta-sheet layouter)
      (select-meta-layouter-menu self))))

(defmethod select-layout-meta-sheet ((self layouter))
  (declare (special *meta-layout-sheet-pool*))
  (popup (get-pool-window *meta-layout-sheet-pool* self)))

(defmethod make-layout-meta-sheet ((self layouter))
  (create-meta-property-sheet
   self
   :name :layout-meta-sheet
   :title "Layout Properties"
   :parts
   (remove nil
	   (list
	    (layouter-class-property-sheet-entry self)
	    (layouter-alignment-property-sheet-entry self)
	    (layouter-constraint-property-sheet-entry self)
	    (layouter-orientation-property-sheet-entry self)
	    (layouter-distance-property-sheet-entry self)
	    (layouter-line-offset-property-sheet-entry self)
	    (layouter-indent-property-sheet-entry self)
	    (layouter-x-offset-property-sheet-entry self)
	    (layouter-y-offset-property-sheet-entry self)
	    (layouter-items-per-line-property-sheet-entry self)
	    (layouter-divide-equally-property-sheet-entry self)))))
		  
(defmethod layouter-class-property-sheet-entry ((self layouter))
  `(:label "class" 
    :read-function (lambda (layouter) (class-name (class-of layouter)))
    :read-transformation (lambda (value) 
			   (string-downcase (write-to-string value)))
    :value-part 
    (:class non-active-text-dispel
     :mouse-feedback :border
     :reactivity-entries ((:menu "Change layouter class"
			   (call :self do-hide-popup-parent)
			   (call :eval
				 (select-meta-layouter-menu
				  (window (view-of *self*)))))))))
		  
(defmethod layouter-alignment-property-sheet-entry (ignore)
  nil)

(defmethod layouter-alignment-property-sheet-entry ((self basic-layouter))
  `(:label "alignment"
    :read-function alignment
    :value-part
    (:class single-choice-bitmap-menu
     :layouter (multiline-distance-layouter 
                :orientation :down
                :items-per-line 3
                :line-offset 40
                :distance 0)
     :border-width 1
     :inside-border 0
     :parts ((:view-of :upper-left
              :action-docu "Select upper-left alignment"
              :bitmap "display-pos")
             (:view-of :left-center
              :action-docu "Select left-center alignment"
	      :bitmap "display-pos")
             (:view-of :lower-left
              :action-docu "Select lower-left alignment"
              :bitmap "display-pos")
             (:view-of :upper-center
              :action-docu "Select upper-center alignment"
              :bitmap "display-pos")
             (:view-of :center
              :action-docu "Select center alignment"
              :bitmap "display-pos")
             (:view-of :lower-center
              :action-docu "Select lower-center alignment"
              :bitmap "display-pos")
             (:view-of :upper-right
              :action-docu "Select upper-right alignment"
              :bitmap "display-pos")
             (:view-of :right-center
              :action-docu "Select right-center alignment"
              :bitmap "display-pos")
             (:view-of :lower-right
              :action-docu "Select lower-right alignment"
              :bitmap "display-pos")))))

(defmethod layouter-alignment-property-sheet-entry ((self aligning-distance-layouter))
  `(:label "alignment"
    :read-function alignment
    :value-part
    (:class single-choice-bitmap-menu
     :layouter (multiline-distance-layouter 
                :orientation :down
                :items-per-line 3
                :line-offset 40
                :distance 0)
     :border-width 1
     :inside-border 0
     :parts ((:view-of :upper-left
              :action-docu "Select upper-left alignment"
              :bitmap "display-pos")
             (:view-of :left-center
	      :sensitive :off
              :action-docu "Select left-center alignment"
	      :bitmap "display-pos")
             (:view-of :lower-left
              :sensitive :off
              :action-docu "Select lower-left alignment"
              :bitmap "display-pos")
             (:view-of :upper-center
              :sensitive :off
              :action-docu "Select upper-center alignment"
              :bitmap "display-pos")
             (:view-of :center
              :action-docu "Select center alignment"
              :bitmap "display-pos")
             (:view-of :lower-center
              :sensitive :off
              :action-docu "Select lower-center alignment"
              :bitmap "display-pos")
             (:view-of :upper-right
              :sensitive :off
              :action-docu "Select upper-right alignment"
              :bitmap "display-pos")
             (:view-of :right-center
              :sensitive :off
              :action-docu "Select right-center alignment"
              :bitmap "display-pos")
             (:view-of :lower-right
              :action-docu "Select lower-right alignment"
              :bitmap "display-pos")))))
		  
(defmethod layouter-constraint-property-sheet-entry (ignore)
  nil)

(defmethod layouter-constraint-property-sheet-entry ((self basic-layouter))
  `(:label "constraint"
    :read-function constraint
    :value-part
    (:class single-choice-text-menu
     :layouter (distance-layouter :orientation :right)
     :parts ((:view-of :none  
              :action-docu "Select constraint :none"
              :text ":none")
             (:view-of :x 
              :action-docu "Select constraint :x"
              :text ":x")
             (:view-of :y 
              :action-docu "Select constraint :y"
              :text ":y")))))
		  
(defmethod layouter-orientation-property-sheet-entry (ignore)
  nil)

(defmethod layouter-orientation-property-sheet-entry ((self distance-layouter))
  `(:label "orientation"
    :read-function orientation
    :value-part
    (:class single-choice-text-menu
     :layouter (distance-layouter :orientation :right)
     :parts ((:view-of :down  
              :action-docu "Select orientation :down"
              :text ":down")
             (:view-of :right 
              :action-docu "Select orientation :right"
              :text ":right")))))

(defmethod layouter-distance-property-sheet-entry (ignore)
  nil)

(defmethod layouter-distance-property-sheet-entry ((self distance-layouter))
  `(:class text-property-field
    :label "distance"
    :read-function distance
    :read-transformation write-to-string))

(defmethod layouter-indent-property-sheet-entry (ignore)
  nil)

(defmethod layouter-indent-property-sheet-entry ((self indent-distance-layouter))
  `(:class text-property-field
    :label "indentation"
    :read-function indent
    :read-transformation write-to-string))

(defmethod layouter-divide-equally-property-sheet-entry (ignore)
  nil)

(defmethod layouter-divide-equally-property-sheet-entry ((self aligning-distance-layouter))
  `(:label "divide equally?"
    :read-function divide-equally?
    :write-transformation convert-to-boolean
    :read-transformation convert-from-boolean
    :value-part
    (:class single-choice-text-menu
     :layouter (distance-layouter :orientation :right)
     :parts ((:view-of :yes
	      :text "yes"
	      :action-docu "do divide equally")
             (:view-of :no
	      :text "no"
	      :action-docu "do not divide equally")))))

(defmethod layouter-x-offset-property-sheet-entry (ignore)
  nil)

(defmethod layouter-x-offset-property-sheet-entry ((self offset-layouter))
  `(:class text-property-field
    :label "x-offset"
    :read-function (lambda (view-of) (point-x (offset view-of)))
    :write-function (lambda (view-of value)
		      (setf (offset view-of)
			  (point value (point-y (offset view-of)))))
    :read-transformation write-to-string))

(defmethod layouter-y-offset-property-sheet-entry (ignore)
  nil)

(defmethod layouter-y-offset-property-sheet-entry ((self offset-layouter))
  `(:class text-property-field
    :label "y-offset"
    :read-function (lambda (view-of) (point-y (offset view-of)))
    :write-function (lambda (view-of value)
		      (setf (offset view-of)
			  (point (point-x (offset view-of)) value)))
    :read-transformation write-to-string))

(defmethod layouter-items-per-line-property-sheet-entry (ignore)
  nil)

(defmethod layouter-items-per-line-property-sheet-entry
    ((self multiline-distance-layouter))
  `(:class text-property-field
    :label "items-per-line"
    :read-function items-per-line 
    :read-transformation write-to-string))

(defmethod layouter-line-offset-property-sheet-entry (ignore)
  nil)

(defmethod layouter-line-offset-property-sheet-entry
    ((self multiline-distance-layouter))
  `(:class text-property-field
    :label "line-offset"
    :read-function line-offset
    :read-transformation write-to-string))
