;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: LAPIDARY; 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. ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; CHANGE LOG
;;;
;;; 08/25/92 amickish - Commented out declaration of obj-name in make-instance-
;;;                     or-copy because its use is commented out

;;; gadgetcopy.lisp -- make copies and instances of gadgets


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

(defvar copy-interactor nil)
(defvar instance-interactor nil)

#|
(defun copy-instance-inter-do-go ()

  ;; create a copy interactor
  (create-instance 'copy-interactor multi-win-interactor
    (:window (o-formula (gv *selection-info* :window)))
    (:final-function #'make-instance-or-copy)
    (:feedback-obj (formula '(gvl :current-window :copy-instance-feedback))) 
    (:obj-to-change (o-formula (if (is-a-p (gvl :first-obj-over :parent)
					   agg-sel-feedback-circle)
				   (gvl :first-obj-over :parent :parent :obj-over)
				   (gvl :first-obj-over :parent :obj-over))))
    (:start-where 
     (o-formula (list :list-leaf-element-of
		      *selection-info* :feedback)))
    (:start-event *copy-button*))

  ;; create an instance interactor
  (create-instance 'instance-interactor multi-win-interactor
     (:window (o-formula (gv *selection-info* :window)))
     (:final-function #'make-instance-or-copy)
     (:instance-p t)
     (:feedback-obj 
      (formula '(gvl :current-window :copy-instance-feedback)))
     (:obj-to-change (o-formula (if (is-a-p (gvl :first-obj-over :parent)
					    agg-sel-feedback-circle)
				    (gvl :first-obj-over :parent :parent :obj-over)
				    (gvl :first-obj-over :parent :obj-over))))
     (:start-where 
      (o-formula (list :list-leaf-element-of
		       *selection-info* :feedback)))
     (:start-event *instance-button*)))

(defun copy-instance-inter-do-stop ()
  (when (boundp 'instance-inter) (opal:destroy instance-inter))
  (when (boundp 'copy-inter) (opal:destroy copy-inter)))
|#

(defun make-instance-or-copy (instance-p)
  (let* ((objs (g-value *selection-info* :selected))
	 editor-agg result
;	 obj-name
	 )
    (cond ((null objs) (lapidary-error "must select an object first") nil)
	  (t
	   ; this prevents create-instance from copying feedback links
	   (primary-deselect-objects :none)
	   (secondary-deselect-objects :none)

	   (dolist (obj objs)
	     ;; remove corrupted slots from the object
	     (fix-up-obj obj)

	     ;; ask the user to name the new instance
#|
	     (setf obj-name 
		   (keyword-from-string
		    (lapidary-prompt-for-input "please enter object name: ")))
|#

	     (with-constants-disabled
	      (if instance-p
		 ; create the instance
		 (setf result (create-instance nil obj))
	         ; create a copy
	         (setf result (opal:copy-gadget obj nil))))

             ;; generate a name for the new object
             (name-lapidary-obj result)

	     ;;; put the instance in the correct window
	     (setf editor-agg (g-value obj :window :editor-agg))
	     (opal:add-component editor-agg result)

	     ;;; move the instance 20 pixels to the right and below the
	     ;;; object it is based on
	     (if (is-a-line-p result)
		 (progn
		   (s-value result :x1 (+ 20 (g-value obj :x1)))
		   (s-value result :y1 (+ 20 (g-value obj :y1)))
		   (s-value result :x2 (+ 20 (g-value obj :x2)))
		   (s-value result :y2 (+ 20 (g-value obj :y2))))
	         (opal:set-position result (+ 20 (g-value obj :left))
				           (+ 20 (g-value obj :top))))
	     
	     ;;; Select the instance
	     (primary-select result))))))
