;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: GILT; Base: 10 -*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;         The Garnet User Interface Development Environment.      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This code was written as part of the Garnet project at          ;;;
;;; Carnegie Mellon University, and has been placed in the public   ;;;
;;; domain.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;
;;; Designed and implemented by Brad Myers

#|
============================================================
Change log:
    08/19/92 Andrew Mickish - Bitmap pathnames now use namestring function
      4/4/92 Brad Myers - new specialrun and build forms
                          Add color as a property of the OK gadgets
    03/25/92 Andrew Mickish - Removed :slots-to-copy list from TYPE-BITMAP
               because :image is already copied during copy-gadget; changed
               :properties-slots list of TYPE-BITMAP to add Invalid-Pathname-p.
    03/01/92 Brad Myers - make gadgets in palette window be constant
    02/09/92 Brad Myers - made more constants, and made more props be
               multiple choice; moved common functions to gilt-gadget-utils
    01/06/91 Andrew Mickish - Instead of adding type names to
               opal:*standard-names* with setf in this file, the names now
               appear in the defparameter in save-agg.lisp.
    11/23/91 Andrew Mickish - Added :background-color
    10/08/91 Andrew Mickish - Added fast-redraw to "Selected Object" gadget
    07/18/91 Andrew Mickish - Removed :xor from "Selected Object" field
    05/14/91 Andrew Mickish - Added :text-inter slot to motif-scrolling-
               labeled-boxes
    05/09/91 Andrew Mickish - Added :active-p properties to type schemas
    04/11/91 Brad Myers - Fixed bug in function-for-ok-name for save
    04/02/91 Andrew Mickish - Added comments to :accelerators, :inactive-items
               property slots of type-motif-menu
    03/28/91 Andrew Mickish - Changed :button-diameter property to :button-width
    03/27/91 Andrew Mickish - Removed :fixed-width-size and :fixed-height-size
               from property lists
    03/19/91 Andrew Mickish - Removed :item-to-string-function from
               TYPE-MOTIF-MENU because writing this value out to a file
               causes a "#k<" error when read back in
    03/19/91 Andrew Mickish - Set :function-for-ok-name's :active-p slot
               instead of :export-p's :active-p in Show-Save-Dialog
    03/17/91 Andrew Mickish - Fixed :active-p slots of main-menu labeled boxes
    03/14/91 Andrew Mickish - Changed :filling-style of Gray-Out
    03/13/91 Osamu Hashimoto - Moved Show-Save-Dialog & Show-Read-Dialog here
                               from gilt.lisp
    03/12/91 Osamu Hashimoto - Changed grayout from rect-covering to :active-p
    03/11/91 Osamu Hashimoto - Removed labeled-box and changed scrolling-text-box
                               to motif-scrolling-labeled-box
    03/07/91 Osamu Hashimoto - Moved *prop-sheet* here from gilt.lisp
    03/04/91 Osamu Hashimoto - Moved Make-Main-Menu from gilt.lisp
    03/04/91 Andrew Mickish - Updated properties slots according to manual
    02/28/91 Andrew Mickish - Added :min-width and :min-height to gadgets
               that grow
    02/27/91 Andrew Mickish - Moved *load-file* here from gilt.lisp;
               Moved IB-WINDOW here from gilt.lisp
    01/28/91 Andrew Mickish - Converted to Motif gadgets
    11/13/90 Brad Myers - Split from gilt.lisp
============================================================
|#


(in-package "GILT" :use '("LISP" "KR"))

(proclaim '(special *Selection-Obj* *Run-Build-Obj* *Objs-Agg*
	            *Top-Gadget-Name* *Last-Filename* Linepform
	            RunGadgetActiveForm *Main-Win* *IB-Win*
	            Save-File Read-File))

(create-instance 'gray-out opal:rectangle
   (:obj-over NIL)
   (:line-style NIL)
   (:filling-style (create-instance NIL opal:filling-style
		      (:fill-style :stippled)
		      (:stipple opal::light-gray-fill-bitmap)))
   (:left (o-formula (gvl :obj-over :left)))
   (:top (o-formula (gvl :obj-over :top)))
   (:width (o-formula (gvl :obj-over :width)))
   (:height (o-formula (gvl :obj-over :height)))
   (:visible NIL)) ; usually replace this with a formula

;;; An association list which the save function uses to get the correct
;;; loader file names
(defparameter *load-file*
 '(("V-SCROLL-BAR" "V-SCROLL")("H-SCROLL-BAR" "H-SCROLL")
   ("TEXT-BUTTON-PANEL" "TEXT-BUTTONS")("X-BUTTON-PANEL" "X-BUTTONS")
   ("RADIO-BUTTON-PANEL" "RADIO-BUTTONS")

   ("MOTIF-V-SCROLL-BAR" "MOTIF-V-SCROLL")
   ("MOTIF-H-SCROLL-BAR" "MOTIF-H-SCROLL")
   ("MOTIF-TEXT-BUTTON-PANEL" "MOTIF-TEXT-BUTTONS")
   ("MOTIF-CHECK-BUTTON-PANEL" "MOTIF-CHECK-BUTTONS")
   ("MOTIF-RADIO-BUTTON-PANEL" "MOTIF-RADIO-BUTTONS")))


(defparameter *prop-sheet*
  (create-instance NIL garnet-gadgets:motif-prop-sheet-for-obj-with-OK
     (:Constant '(T :except :obj :slots))
     (:OK-Function 'Prop-Sheet-Finish)
     (:Apply-Function 'Prop-Sheet-Finish)))

(defun Make-Main-Menu ()
  (let* ((win (create-instance NIL inter:interactor-window
		 (:top 25)(:left 550)(:width 365)(:height 200)
		 (:title "Gilt Commands")
		 (:background-color opal:motif-gray)))
	 (agg (create-instance NIL opal:aggregate
		 (:left 0) (:top 0) (:width 490) (:height 175)))
	 (obj (create-instance NIL garnet-gadgets:motif-radio-button-panel
		 (:CONSTANT '(T))
		 (:left 5)(:top 5)(:items '(:Build :Run))
		 (:text-on-left-p T)
		 (:selection-function #'(lambda (gad val)
					  (declare (ignore gad))
					  (if (eq val :Run)
					      (Garnet-Gadgets:Set-Selection
					       *Selection-Obj* NIL))))))
	 (menu (create-instance NIL garnet-gadgets:motif-text-button-panel
		 (:CONSTANT '(T))
		 (:left 100)(:top 5)
		 (:final-feedback-p NIL)
		 (:rank-margin 6)
		 (:font opal:default-font)
		 (:shadow-offset 6)(:text-offset 5)(:gray-width 2)
		 (:active-p (o-formula (eq :build (gv *Run-Build-Obj* :value))))
		 (:items `(("Save..." ,#'Show-Save-Dialog)
			   ("Read..." ,#'Show-Read-Dialog)
			   ("To Top" ,#'To-Top-Func)
			   ("To Bottom" ,#'To-Bottom-Func)
			   ("Duplicate" ,#'Duplicate-Func)
			   ("Select All" ,#'Select-All-Func)
			   ("Delete Selected" ,#'Delete-Func)
			   ("Delete All" ,#'Delete-All-Func)
			   ("Undo Last Delete" ,#'Undo-Delete-Func)
			   ("Properties..." ,#'Properties-Func)
			   ("Align..." ,#'Align-Func)
			   ("Quit" Quit-Func)))))
	 (SCR-BOX
	  (create-instance NIL garnet-gadgets:motif-scrolling-labeled-box
	     (:CONSTANT '(T :EXCEPT :active-p))
	     (:left 5) (:top 65) (:width 90)
	     (:field-offset 2)
	     (:active-p (o-formula
			 (let ((value (gv *Selection-obj* :value)))
			   (and value
				(not (cdr value))
				(eq :build (gv *Run-Build-Obj* :value))))))
	     (:min-frame-width 40)
	     (:text-inter (o-formula (gvl :field-text :text-edit)))
	     (:parts
	      `((:label-text :modify
		 (:fast-redraw-p :rectangle)
		 (:fast-redraw-filling-style ,opal:motif-gray-fill))
		:frame :field-text :sel-box))))
	 (left-number (create-instance NIL SCR-BOX
	     (:CONSTANT '(T :EXCEPT :active-p :label-string))
	     (:line-p (formula LinepForm))
	     (:Label-string (o-formula
			     (if (gvl :line-p) "X1" "  LEFT") "  LEFT"))
	     (:value (o-formula (Sel-Obj-Value (if (gvl :line-p) :x1 :left))))
	     (:selection-function 'LeftX1-Set-Func)))
	 (top-number (create-instance NIL SCR-BOX
		(:top 85)
		(:CONSTANT '(T :EXCEPT :active-p :label-string))
		(:line-p (o-formula (gv left-number :line-p)))
		(:Label-string (o-formula
				(if (gvl :line-p) "Y1" "   TOP") "   TOP"))
		(:value (o-formula (Sel-Obj-Value
				    (if (gvl :line-p) :y1 :top))))
		(:selection-function 'TopY1-Set-Func)))
	 (width-number (create-instance NIL SCR-BOX
	        (:left 4)(:top 105)
		(:CONSTANT '(T :EXCEPT :active-p :label-string))
		(:line-p (o-formula (gv left-number :line-p)))
		(:Label-string (o-formula
				(if (gvl :line-p) "X2" " WIDTH") " WIDTH"))
		(:value (o-formula (Sel-Obj-Value
				    (if (gvl :line-p) :X2 :width))))
		(:selection-function 'WidthX2-Set-Func)))
	 (height-number (create-instance NIL SCR-BOX
		(:top 125)
		(:line-p (o-formula (gv left-number :line-p)))
		(:CONSTANT '(T :EXCEPT :active-p :label-string))
		(:Label-string (o-formula
				(if (gvl :line-p) "Y2" "HEIGHT") "HEIGHT"))
		(:value (o-formula (Sel-Obj-Value
				    (if (gvl :line-p) :y2 :height))))
		(:selection-function 'HeightY2-Set-Func)))
	 (selected (create-instance NIL opal:aggregadget
		      (:left 5) (:top 180)
		      (:parts
		       `((:label ,opal:text (:string "Selected Object: ")
			  (:CONSTANT (:left :string :top :font :parent))
			  (:left ,(o-formula (gvl :parent :left)))
			  (:top ,(o-formula (gvl :parent :top)))
			  (:font ,(g-value
				   garnet-gadgets:motif-scrolling-labeled-box
				   :label-font))
			  (:fast-redraw-p :rectangle)
			  (:fast-redraw-filling-style ,opal:MOTIF-GRAY-FILL))
			 (:value ,opal:text
			  (:left ,(o-formula (+ 3 (opal:gv-right
						   (gvl :parent :label)))))
			  (:top ,(o-formula (gvl :parent :top)))
			  (:string
			   ,(o-formula
			     (let ((objs (gv *selection-obj* :value)) obj)
			       (cond
				 ((cdr objs) "<multiple>")
				 ((setq obj (car objs))
				  (let ((kr::*print-as-structure* NIL))
				    (format NIL "~s" obj)))
				 (T "<none>")))))
			  (:fast-redraw-p :rectangle)
			  (:fast-redraw-filling-style ,opal:MOTIF-GRAY-FILL)))))))
  
    (Init-value obj :build) ; start in Build mode
    (setq *main-win* win)
    (s-value win :aggregate agg)
    (fix-all-interactors menu T NIL)
    (setq *Run-Build-Obj* obj)
    (opal:add-components agg
			 obj menu left-number top-number
			 width-number height-number selected)
    (opal:update win)))



;;; This pops up the save dialog box, after determining the default values 
(defun Show-Save-Dialog (gadget stringsel)
  (declare (ignore gadget stringsel))
  (let ((filename *Last-Filename*)
	(package (g-value *objs-agg* :package-name))
	(window-title (g-value *objs-agg* :window-title))
	(export-p (if (g-value *objs-agg* :export-p)
		      "Export Top-level Gadget?"))
	(gadget-name *Top-Gadget-Name*)
	(function-for-ok-name (or (g-value *objs-agg* :FUNCTION-FOR-OK)
				  ""))
	(function-for-ok-invalid (Check-Ask-OK)))  
    (unless (stringp function-for-ok-name)
      (setq function-for-ok-name (write-to-string function-for-ok-name)))
    (set-initial-value save-file :filename filename)
    (set-initial-value save-file :gadget-name gadget-name)
    (set-initial-value save-file :win-title window-title)
    (set-initial-value save-file :package-name package)
    (set-initial-value save-file :FUNCTION-FOR-OK-NAME function-for-ok-name)
    (set-initial-value save-file :export-p export-p)
		       
    (s-value (g-value save-file :function-for-ok-name)
	     :active-p
	     (not function-for-ok-invalid))

    (show-in-window save-file)))


;;; This pops up the read dialog box, after determining the default values 
(defun Show-Read-Dialog (gadget stringsel)
  (declare (ignore gadget stringsel))
  (let ((filename *Last-Filename*)
	(add-replace-invalid (if (get-values *objs-agg* :components) NIL T)))
    (set-initial-value read-file :filename filename)

    (s-value (g-value read-file :add-replace) :active-p (not add-replace-invalid))

    (set-initial-value read-file :add-replace "Replace existing objects")
    (show-in-window read-file)))


(defparameter *List-Item* (list :items))
(defparameter *aggrelist-slots* (List '(:known-as NIL "(keyword)")
				      :select-function 
				      '(:direction (:Vertical :Horizontal))
				      (list :v-spacing #'num-only)
				      (list :h-spacing #'num-only)
				      '(:fixed-width-p (T NIL))
				      '(:fixed-height-p (T NIL))
				      '(:h-align (:left :center :right))
				      (list :rank-margin #'nil-or-num)
				      (list :pixel-margin #'nil-or-num)
				      (list :indent #'num-only)))
(defparameter *shadow-slots* (List (list :shadow-offset #'num-only)
				   (list :text-offset #'num-only)
				   (list :gray-width #'num-only)))
(defparameter *motif-scroll-slots* (List (list :scr-incr #'num-only)
					 (list :page-incr #'num-only)
					 '(:scr-trill-p (T NIL))
					 '(:scroll-p (T NIL))
					 (list :percent-visible #'num-only)
					 '(:active-p (T NIL))
					 ))
(defparameter *motif-slider-slots* (List '(:known-as NIL "(keyword)")
					 (list :val-1 #'num-only)
					 (list :val-2 #'num-only)
					 :select-function
					 (list :scr-incr #'num-only)
					 (list :page-incr #'num-only)
					 '(:scr-trill-p (T NIL))
					 '(:scroll-p (T NIL))
					 '(:active-p (T NIL))
					 (list :indicator-font (Font-for))
					 ))


(proclaim '(special user::Garnet-Gilt-Bitmap-PathName))

(defparameter leftform (o-formula (first (gvl :box))))
(defparameter topform (o-formula (second (gvl :box))))
(defparameter widthform (o-formula (third (gvl :box))))
(defparameter heightform (o-formula (fourth (gvl :box))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Now define the top-level aggregadget for the gadget menu
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; never run the objects in the gadget selection window
(defparameter RunGadgetActiveForm
  (o-formula (and (not (eq (gvl :window) *Ib-Win*))
		  (eq :run (gv *Run-Build-Obj* :value)))))
(defparameter BuildGadgetActiveForm
  (o-formula (eq :build (gv *Run-Build-Obj* :value))))


;; These are used to make sure the object isn't active if it didn't
;; used to be active.  The old active value is stored in the slot
;;   :gilt-temp-active
;; never run the objects in the gadget selection window
(defparameter SpecialRunGadgetActiveForm
  (o-formula (and (not (eq (gvl :window) *Ib-Win*))
		  (eq :run (gv *Run-Build-Obj* :value))
		  (gvl :gilt-temp-active))))
(defparameter SpecialBuildGadgetActiveForm
  (o-formula (and (gvl :gilt-temp-active)
		  (eq :build (gv *Run-Build-Obj* :value)))))



(create-instance 'IB-OBJS opal:aggregadget
    (:parts
     `((:title-line ,opal:line
	(:x1 2)	
	(:constant (:x1 :line-style))
	(:y1 ,(o-formula (opal:gv-center-y (gvl :parent :title-string))))
	(:x2 ,(o-formula (let ((win (gvl :window)))
			   (- (gv win :width)(gv win :RIGHT-BORDER-WIDTH)
			      (gv win :LEFT-BORDER-WIDTH) 2))))
	(:y2 ,(o-formula (gvl :y1))))
       (:title-string ,opal:text (:string "Motif Gadgets")
	(:font ,title-font)
	(:constant (T :except :left))
	(:fill-background-p T)
	(:line-style ,(o-formula
		       (if (gv opal:color :color-p)
			   (create-instance NIL opal:line-style
			      (:constant T)
			      (:background-color opal:MOTIF-GRAY))
			   opal:default-line-style)))
	(:left ,(o-formula (floor (- (gvl :window  :width)
				     (gvl :width)) 2)))
	(:top 0))
       (:selectable-objs ,opal:aggregate)  ; filled explicitly below
       (:feedback ,opal:rectangle
	(:obj-over NIL)
	(:line-style ,opal:line-2)
	;; visible if obj-over and in build mode
	(:visible ,(o-formula (and (gvl :obj-over)
				   (eq :build (gv *Run-Build-Obj* :value)))))
	(:left ,(o-formula (- (gvl :obj-over :left) 5)))
	(:top ,(o-formula (- (gvl :obj-over :top) 5)))
	(:width ,(o-formula (+ (gvl :obj-over :width) 10)))
	(:height ,(o-formula (+ (gvl :obj-over :height) 10)))
	(:fast-redraw-p :redraw)
	(:fast-redraw-line-style ,(create-instance NIL opal:line-style
				     (:constant T)
				     (:line-thickness 2)
				     (:foreground-color
				      (if (g-value opal:color :color-p)
					  opal:MOTIF-GRAY
					  opal:white)))))
       (:cover-up ,gray-out
	(:obj-over ,(o-formula (gvl :window)))
	(:left 0) ; override left and top, so will be zero
	(:top 0)
	;; visible if in run mode
	(:visible ,(o-formula (eq :run (gv *Run-Build-Obj* :value)))))))
    (:interactors
     `((:select ,inter:button-interactor
	(:window ,(o-formula  (gv-local :self :operates-on :window)))
	(:how-set :set)
	(:continuous NIL)
	(:final-feedback-obj ,(o-formula (gvl :operates-on :feedback)))
	(:active ,(formula BuildGadgetActiveForm))
	(:start-event :any-mousedown)
	(:start-where
	 ,(o-formula (list :element-of
			   (gvl :operates-on :selectable-objs))))))))


(defun Make-IB-Window ()
  (create-instance NIL inter:interactor-window
     (:left 550)(:top 300)(:width 450)(:height 280)
     (:title "Gilt Motif Gadgets")
     (:background-color opal:motif-gray)
     ))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Now define Motif gadget objects
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(create-instance 'type-motif-text-button-panel NIL
		  (:line-p NIL)
		  (:changeable-slots '(T T NIL NIL))
		  (:String-Set-Func 'Motif-Button-String-Func)
		  (:aggrelist-slots *List-Item*)
		  (:properties-slots
		   (append *aggrelist-slots*
			   (list
			    (list :text-offset #'num-only)
			    '(:final-feedback-p (T NIL))
			    :items
			    :inactive-items
			    (list :font (font-for))
			    (list :foreground-color (Color-DB-For)))))
		  (:props-title "Motif Text Button Properties")
		  (:slots-to-copy *List-Item*))

(create-instance 'type-motif-check-button-panel NIL
	    (:line-p NIL)
	    (:changeable-slots '(T T NIL NIL))
	    (:String-Set-Func 'Motif-Button-String-Func)
	    (:slots-to-copy *List-Item*)
	    (:aggrelist-slots *List-Item*)
	    (:props-title "Motif Check Button Properties")
	    (:properties-slots
	     (append *aggrelist-slots* 
		     (list (list :button-width #'num-only)
			   (list :text-offset #'num-only)
			   '(:text-on-left-p (T NIL))
			   :items
			   :inactive-items
			   (list :font (font-for))
			   (list :foreground-color (Color-DB-For))))))

(create-instance 'type-motif-radio-button-panel NIL
	    (:line-p NIL)
	    (:changeable-slots '(T T NIL NIL))
	    (:String-Set-Func 'Motif-Button-String-Func)
	    (:slots-to-copy *List-Item*)
	    (:aggrelist-slots *List-Item*)
	    (:properties-slots
	     (append *aggrelist-slots*
		     (list (list :button-width #'num-only)
			   (list :text-offset #'num-only)
			   '(:text-on-left-p (T NIL))
			   :items
			   :inactive-items
			   (list :font (font-for))
			   (list :foreground-color (Color-DB-For)))))
	    (:props-title "Motif Radio Button Properties"))

(create-instance 'type-motif-menu NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:String-Set-Func 'Motif-Menu-String-Func)
		 (:properties-slots
		  (append (list '(:known-as NIL "(keyword)")
				'(:final-feedback-p (T NIL))
				(list :text-offset #'num-only)
				(list :min-frame-width #'num-only)
				(list :v-spacing #'num-only)
				'(:h-align (:Left :center :right))
				:items
				(list :accelerators NIL
				      "[list of lists: ((#\\r \"Alt-R\" #\\meta-r)...)]")
				(list :inactive-items NIL
				      "[list of items: (\"Label2\"...)]")
				:bar-above-these-items
				:select-function
				(list :foreground-color (Color-DB-For))
				(list :item-font (font-for))
				(list :accel-font (font-for)))))
		 (:props-title "Motif Menu Properties")
		 (:slots-to-copy *List-Item*)
		 (:aggrelist-slots *List-Item*))

(create-instance 'type-okcancel NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:String-Set-Func NIL) ; must stay OK-CANCEL
		 (:props-title "OK-Cancel Properties")
		 ; no selection function - set action in save-box.
		 (:properties-slots
		   (list '(:known-as NIL "(keyword)")
				'(:direction (:Vertical :Horizontal))
				(list :v-spacing #'num-only)
				(list :h-spacing #'num-only)
				'(:fixed-width-p (T NIL))
				'(:fixed-height-p (T NIL))
				'(:h-align (:Left :center :right))
				(list :rank-margin #'num-only)
				(list :pixel-margin #'num-only)
				(list :indent #'num-only)
				(list :text-offset #'num-only)
				(list :font (font-for))
				(list :foreground-color (Color-DB-For))))
		 (:aggrelist-slots *List-Item*)
		 (:slots-to-copy *List-Item*))

(create-instance 'type-okapplycancel NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:String-Set-Func NIL) ; must stay OK-APPLY-CANCEL
		 (:props-title "OK-Apply-Cancel Properties")
		 ; no selection function - set action in save-box.
		 (:properties-slots
		  (list '(:known-as NIL "(keyword)")
				'(:direction (:Vertical :Horizontal))
				(list :v-spacing #'num-only)
				(list :h-spacing #'num-only)
				'(:fixed-width-p (T NIL))
				'(:fixed-height-p (T NIL))
				'(:h-align (:Left :center :right))
				(list :rank-margin #'num-only)
				(list :pixel-margin #'num-only)
				(list :indent #'num-only)
				(list :text-offset #'num-only)
				(list :font (font-for))
				(list :foreground-color (Color-DB-For))))
		 (:aggrelist-slots *List-Item*)
		 (:slots-to-copy *List-Item*))

(create-instance 'type-motif-h-scroll-bar NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T T NIL))
		 (:props-title "Motif Horizontal Scroll Bar Properties")
		 (:properties-slots
		  (append (List '(:known-as NIL "(keyword)")
				:select-function
				(list :val-1 #'num-only)
				(list :val-2 #'num-only))
			  *motif-scroll-slots*
			  (list (list :foreground-color (Color-DB-For))))))

(create-instance 'type-motif-v-scroll-bar NIL
	    (:line-p NIL)
	    (:changeable-slots '(T T NIL T))
	    (:props-title "Motif Vertical Scroll Bar Properties")
	    (:properties-slots
	     (append (list '(:known-as NIL "(keyword)")
			   :select-function
			   :val-1 :val-2)
		     *motif-scroll-slots*
		     (list (list :foreground-color (Color-DB-For))))))

(create-instance 'type-motif-slider NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL T))
		 (:props-title "Motif Slider Properties")
		 (:properties-slots
		  (append (list (list :trough-width #'num-only)
				(list :text-offset #'num-only)
				'(:indicator-text-p (T NIL)))
			  *motif-slider-slots*
			  (list (list :foreground-color (Color-DB-For))))))

(create-instance 'type-motif-gauge NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T T NIL))
		 (:String-Set-Func 'Gauge-String-Func)
		 (:props-title "Motif Gauge Properties")
		 (:properties-slots
		  (append (list '(:known-as NIL "(keyword)")
				:select-function
				(list :scr-incr #'num-only)
				(list :val-1 #'num-only)
				(list :val-2 #'num-only)
				(list :num-marks #'num-only)
				'(:tic-marks-p (T NIL))
				'(:enumerate-p (T NIL))
				'(:value-feedback-p (T NIL))
				:title
				(list :text-offset #'num-only)
				(list :foreground-color (Color-DB-For))
				(list :title-font (font-for))
				(list :value-font (font-for))
				(list :enum-font  (font-for)))))
		 (:aggrelist-slots '(:num-marks))
		 (:slots-to-copy (list :title)))


(create-instance 'type-motif-scrolling-labeled-box NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T T NIL))
		 (:props-title "Motif Scrolling Labeled Box Properties")
		 (:properties-slots (list '(:known-as NIL "(keyword)")
					  :select-function
					  (list :field-offset #'num-only)
					  (list :label-offset #'num-only)
					  :label-string
					  '(:active-p (T NIL))
					  (list :label-font (font-for))
					  (list :field-font (font-for))
					  (list :foreground-color (Color-DB-For))))
		 (:String-Set-Func 'Labeled-Box-String-Func))


(create-instance 'type-rectangle NIL
	    (:line-p NIL)
	    (:changeable-slots '(T T T T))
	    (:props-title "Rectangle Properties")
	    (:properties-slots (list '(:known-as NIL "(keyword)")
				     (list :line-style (Line-style-for))
				     (list :filling-style (fill-style-for))
				     :draw-function)))

(create-instance 'type-line NIL
		 (:line-p T)
		 (:changeable-slots '(T T T T))
		 (:props-title "Line Properties")
		 (:properties-slots (list '(:known-as NIL "(keyword)")
					  (list :line-style (Line-style-for))
					  :draw-function)))

(create-instance 'type-text NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:properties-func 'String-Props)
		 (:props-title "Text Properties")
		 (:String-Set-Func 'String-String-Func))

(create-instance 'type-motif-background NIL
		 (:line-p NIL)
		 (:props-title "Motif Background Properties")
		 (:changeable-slots '(NIL NIL NIL NIL))
		 (:properties-slots (list (list :foreground-color (Color-DB-for)))))

(create-instance 'type-bitmap NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:properties-slots (list '(:known-as NIL "(keyword)")
					  (list :image-name #'invalid-pathname-p
						"(pathname)")
					  :draw-function))
		 (:props-title "Bitmap Properties")
		 )


;;; The next one is used for objects read from the disk.  Don't know
;;; what properties are available so just allow position to be changed.
(create-instance 'type-generic NIL
		 (:line-p NIL)
		 (:changeable-slots '(T T NIL NIL))
		 (:properties-slots NIL)
		 (:props-title "Generic Properties"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Now define the gadgets;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun add-std-gadgets (ib-win)
  (let ((agg (g-value ib-win :aggregate :selectable-objs)))
    (opal:add-components agg
			 
       (create-instance NIL garnet-gadgets:MOTIF-TEXT-BUTTON-PANEL
	    (:left 18)(:top 20)
	    (:constant T)
	    (:items '("Label1" "Label2" "Label3"))
	    (:loaded T)
	    (:gilt-type type-motif-text-button-panel)
	    (:maker '((create-instance NIL
		       garnet-gadgets:MOTIF-TEXT-BUTTON-PANEL
		       (:box '(18 20 NIL NIL))
		       (:left (formula leftform))
		       (:top (formula topform))
		       (:items '("Label1" "Label2" "Label3"))
		       (:gilt-type type-motif-text-button-panel)))))
       
       (create-instance NIL garnet-gadgets:MOTIF-CHECK-BUTTON-PANEL
	    (:constant T)
	    (:left 95)(:top 29)
	    (:items '("Label1" "Label2" "Label3"))
	    (:gilt-type type-motif-check-button-panel)
	    (:loaded T)
	    (:maker '((create-instance NIL
		       garnet-gadgets:MOTIF-CHECK-BUTTON-PANEL
		       (:box '(95 29 NIL NIL))
		       (:left (formula leftform))
		       (:top (formula topform))
		       (:items '("Label1" "Label2" "Label3"))
		       (:gilt-type type-motif-check-button-panel)))))

       (create-instance NIL garnet-gadgets:MOTIF-RADIO-BUTTON-PANEL
	    (:left 96)(:top 119)
	    (:constant T)
	    (:items '("Label1" "Label2" "Label3"))
	    (:gilt-type type-motif-radio-button-panel)
	    (:loaded T)
	    (:maker '((create-instance NIL
		       garnet-gadgets:MOTIF-RADIO-BUTTON-PANEL
		       (:box '(96 119 NIL NIL))
		       (:left (formula leftform))
		       (:top (formula topform))
		       (:items '("Label1" "Label2" "Label3"))
		       (:gilt-type type-motif-radio-button-panel)))))

       (create-instance NIL garnet-gadgets:MOTIF-MENU
	    (:constant T)
	    (:items '("Label1" "Label2" "Label3"))
	    (:gilt-type type-motif-menu)
	    (:constant T)
	    (:left 13)(:top 116)
	    (:loaded T)
	    (:maker '((create-instance NIL
		       garnet-gadgets:MOTIF-MENU
		       (:box '(13 116 NIL NIL))
		       (:left (formula leftform))
		       (:top (formula topform))
		       (:items '("Label1" "Label2" "Label3"))
		       (:gilt-type type-motif-menu)))))

       (create-instance NIL garnet-gadgets:MOTIF-TEXT-BUTTON-PANEL
	    (:constant T)
	    (:gilt-type type-okcancel)
	    (:left 13)(:top 205)
	    (:direction :horizontal)
	    (:items '("OK" "Cancel"))
	    (:text-offset 5)
	    (:loaded T)
	    (:maker '((create-instance NIL
		       garnet-gadgets:MOTIF-TEXT-BUTTON-PANEL
		       (:box '(13 205 NIL NIL))
		       (:left (formula leftform))
		       (:top (formula topform))
		       (:direction :horizontal)
		       (:items '("OK" "Cancel"))
		       (:text-offset 5)
		       (:final-feedback-p NIL)
		       (:select-function 'OKCancel-Function)
		       (:gilt-type type-okcancel)))))

       (create-instance NIL garnet-gadgets:MOTIF-TEXT-BUTTON-PANEL
	    (:constant T)
	    (:gilt-type type-okapplycancel)
	    (:left 13)(:top 237)
	    (:direction :horizontal)
	    (:items '("OK" "Apply" "Cancel"))
	    (:text-offset 5)
	    (:loaded T)
	    (:maker '((create-instance NIL
		       garnet-gadgets:MOTIF-TEXT-BUTTON-PANEL
		       (:box '(13 237 NIL NIL))
		       (:left (formula leftform))
		       (:top (formula topform))
		       (:direction :horizontal)
		       (:items '("OK" "Cancel"))
		       (:text-offset 5)
		       (:final-feedback-p NIL)
		       (:select-function 'OKCancel-Function)
		       (:gilt-type type-okapplycancel)))))

       (create-instance NIL garnet-gadgets:MOTIF-V-SCROLL-BAR
	    (:constant T)
	    (:gilt-type type-motif-v-scroll-bar)
	    (:left 186)(:top 31)(:height 185)
	    (:loaded T)
	    (:min-height 40)
	    (:maker '((create-instance NIL
		       garnet-gadgets:MOTIF-V-SCROLL-BAR
		       (:box '(186 31 NIL 185))
		       (:left (formula leftform))
		       (:top (formula topform))
		       (:height (formula heightform))
		       (:grow-p T)
		       (:gilt-type type-motif-v-scroll-bar)))))
       
       (create-instance NIL garnet-gadgets:MOTIF-H-SCROLL-BAR
	    (:constant T)
	    (:gilt-type type-motif-h-scroll-bar)
	    (:left 270)(:top 31)(:width 170)
	    (:loaded T)
	    (:min-width 40)
	    (:maker '((create-instance NIL
		       garnet-gadgets:MOTIF-H-SCROLL-BAR
		       (:box '(270 31 170 NIL))
		       (:left (formula leftform))
		       (:top (formula topform))
		       (:width (formula widthform))
		       (:grow-p T)
		       (:gilt-type type-motif-h-scroll-bar)))))

       (create-instance NIL garnet-gadgets:MOTIF-SLIDER
	    (:constant T)
	    (:gilt-type type-motif-slider)
	    (:left 212)(:top 31)(:height 185)
	    (:loaded T)
	    (:min-height 40)
	    (:maker '((create-instance NIL
		       garnet-gadgets:MOTIF-SLIDER
		       (:box '(212 31 NIL 185))
		       (:left (formula leftform))
		       (:top (formula topform))
		       (:height (formula heightform))
		       (:grow-p T)
		       (:gilt-type type-motif-slider)))))

       (create-instance NIL garnet-gadgets:MOTIF-GAUGE
	    (:constant T)
	    (:gilt-type type-motif-gauge)
	    (:left 292)(:top 59)(:width 121)
	    (:val-1 10)(:val-2 0)
	    (:num-marks 6)(:title "Title")(:value-feedback-p NIL)
	    (:min-width 60)	    
	    (:loaded T)
	    (:maker '((create-instance NIL
		       garnet-gadgets:MOTIF-GAUGE
		       (:box '(292 59 121 NIL))
		       (:left (formula leftform))
		       (:top (formula topform))
		       (:width (formula widthform))
		       (:grow-p T) (:val-1 10)(:val-2 0)
		       (:num-marks 6) (:title "Title")(:value-feedback-p NIL)
		       (:int-feedback-p NIL)
		       (:gilt-type type-motif-gauge)))))
	   
       (create-instance NIL opal:multi-text
	    (:box '(276 190 NIL NIL)) 
	    (:left (formula leftform))(:top (formula topform))
	    (:point-to-leaf 'Fake-Point-to-Leaf) ; needed for text-interactor
	    (:string "Label")
	    (:gilt-type type-text))

       (create-instance NIL garnet-gadgets:MOTIF-SCROLLING-LABELED-BOX
	    (:constant T)
	    (:left 276)(:top 157)(:width 135)
	    (:min-width 100)
	    (:label-string "Title:")
	    (:field-string "Scrolling Text Box")
	    (:gilt-type type-motif-scrolling-labeled-box)
	    (:loaded T)
	    (:maker '((create-instance NIL
		       garnet-gadgets:MOTIF-SCROLLING-LABELED-BOX
		       (:box '(276 157 135 NIL))
		       (:left (formula leftform))
		       (:top (formula topform))
		       (:width (formula widthform))
		       (:grow-p T) (:min-width 100)
		       (:label-string "Title:")
		       (:field-string "Scrolling Text Box")
		       (:gilt-type type-motif-scrolling-labeled-box)))))

       (create-instance NIL opal:rectangle
	    (:box '(276 216 46 32))
	    (:left (formula leftform))(:top (formula topform))
	    (:grow-p T)
	    (:width (formula widthform))(:height (formula heightform))
	    (:gilt-type type-rectangle))

       (create-instance NIL opal:line
	    (:points '(333 217 357 247))
	    (:line-p T)
	    (:grow-p T)
	    (:x1 (o-formula (first (gvl :points))))
	    (:y1 (o-formula (second (gvl :points))))
	    (:x2 (o-formula (third (gvl :points))))
	    (:y2 (o-formula (fourth (gvl :points))))
	    (:gilt-type type-line))

       (create-instance NIL opal:bitmap
	    (:gilt-type type-bitmap)
	    (:box '(373 216 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:image (o-formula (opal:read-image (gvl :image-name))))
	    ;; want this to be a string, not a pathname.  *** PROBABLY NEED
	    ;; something different for Apple.
	    (:image-name
	     (namestring (merge-pathnames user::Garnet-Gilt-Bitmap-PathName
					  "giltbitmap.bitmap")))
	    (:maker '((create-instance NIL opal:bitmap
	    (:gilt-type type-bitmap)
	    (:box '(373 216 NIL NIL))
	    (:left (formula leftform))(:top (formula topform))
	    (:image (o-formula (opal:read-image (gvl :image-name))))
	    (:image-name
	     (namestring (merge-pathnames user::Garnet-Gilt-Bitmap-PathName
					  "giltbitmap.bitmap")))))))

       (create-instance NIL opal:text
	  (:gilt-type type-motif-background)
	  (:left 290) (:top 258)
	  (:string "Motif-Background")
	  (:font (create-instance NIL opal:font (:constant T) (:face :bold)))
	  (:loaded T)
	  (:maker '((create-instance NIL garnet-gadgets:MOTIF-BACKGROUND
	  (:box '(0 0 NIL NIL))
	  (:left 0) (:top 0)
	  (:foreground-color opal:MOTIF-GRAY)
	  (:select-outline-only T)
	  (:gilt-type type-motif-background)))))
       )

    (Fix-All-Interactors agg T T)
    ))

