(in-package :gb-custom)
(use-package :OLI)

(sd-defdialog 'replace_parts
:dialog-title (sd-multi-lang-string "Replace Parts/Assys" :german "Teil/Bgr tauschen")
:toolbox-button t
:variables '(
	(source		:value-type :part-assembly
			:initial-value nil
			:multiple-items nil
			:prompt-text (sd-multi-lang-string "Specify new part or assembly to be used"
                                                           :german "Neues, einzusetzendes Teil oder Baugruppe angeben")
			:title (sd-multi-lang-string "SourcePart" :german "Quelle")
			:modifies nil
			:after-input (progn
					(setq dest nil)
					(setq other_dest nil)
					)
	)
	(dest		:value-type :part-assembly
			:initial-value nil
			:multiple-items nil
			:prompt-text (sd-multi-lang-string "Specify part or assembly to be replaced by source" 
                                                           :german "Altes, zu ersetzendes Teil oder Baugruppe angeben")
			:title (sd-multi-lang-string "Dest. Part" :german "Ziel")
			:modifies nil
			:after-input (progn
					(l-check-part-parent)
					(setq other_dest nil)
					)
	)
	("Other Parts/Assys")
	(flag0 :value-type	:boolean
			:initial-value t
			:toggle-type :wide-toggle
			:title (sd-multi-lang-string "None" :german "Kein weiteres")
	)
	(flag1 :value-type	:boolean
			:initial-value nil
			:toggle-type :wide-toggle
			:title (sd-multi-lang-string "Include all shares" :german "Alle gemeinsam genutzten"))
	(other_dest		:value-type :part-assembly
			:initial-value nil
			:initial-optional t
			:multiple-items t
			:prompt-text (sd-multi-lang-string "Specify other parts or assemblies to be replaced" 
                                                           :german "weitere, zu ersetzende Teile oder Baugruppen angeben")
			:title (sd-multi-lang-string "PickShares" :german "Ziele opt.")
			:modifies nil
			:after-input (l-check-list-parent)
	)
	(assy_list)
	(dummy :title "Options")
	
	(flag		:value-type	:boolean
			:initial-value t
			:toggle-type :wide-toggle
			:title (sd-multi-lang-string "Delete Source" :german "Quelle loeschen"))
	(flag2		:value-type	:boolean
			:initial-value nil
			:toggle-type :wide-toggle
			:title (sd-multi-lang-string "Keep old names" :german "Alten Namen behalten"))
	);variables
:mutual-exclusion '(flag0 flag1 other_dest)
;:help-action '(sd-display-url (concatenate 'string (system:getenv "GBDOCDIR") "/doc/gb_ex_prt.html"))
:local-functions '(

(l-check-part-parent ()
	(when (sd-inq-obj-parent-contents-read-only-p dest)
			(l-error-read-only)
			(setq dest nil)
	);
	(when (equal source dest)
			(l-error-source-dest)
			(setq dest nil)
	)
);

(recurse (obj)
	(dolist (child (oli:sd-inq-obj-children obj))
			(if (not (oli:sd-inq-container-p child))
				(recurse child)
				);end if
				);end dolist
		;(when (oli:sd-inq-part-p obj)
			(push obj assy_list)
			;);end when
);end recurse

(l-check-list-parent ()
	(let (orig teil
	(l-error-read-only-f nil)
	(l-error-sys-id-f nil)
	(l-error-sel-parts-f nil))
	(setf orig (sd-inq-obj-contents-sysid dest))
	(dolist (a-prt other_dest)
		(when (sd-inq-obj-parent-contents-read-only-p a-prt)
				(setf l-error-read-only-f t)
				(setq other_dest nil)
		)
		(setf teil (sd-inq-obj-contents-sysid a-prt))
		(unless (string= orig teil)
				(setf l-error-sys-id-f t)
				(setq other_dest nil)
		)
		(when (equal dest a-prt)
				(setf l-error-sel-parts-f t)
				(setq other_dest nil)
		)
	)
	(when l-error-read-only-f
		(l-error-read-only)
	)
	(when l-error-sys-id-f
		(l-error-sys-id)
	)
	(when l-error-sel-parts-f
		(l-error-sel-parts)
	)
	); let
)

(l-error-read-only ()
	(sd-display-error (sd-multi-lang-string "Owner of the selected part is marked as read-only !" 
                                                                   :german "Besitzer ist schreibgeschÏtzt !"))
);

(l-error-sys-id ()
	(sd-display-error (sd-multi-lang-string "Different assemblies have been selected."
                                                :german "Es wurden verschiedene Baugruppen gewaehlt"))
);

(l-error-sel-parts ()
        (sd-display-error (sd-multi-lang-string "\"Dest.opt\" contains the destination assembly" 
                                   :german "Ziel-Baugruppe ist in \"Ziele opt.\" enthalten"))
);

(l-error-source-dest ()
	(sd-display-error (sd-multi-lang-string "Same source and destination have been specified."
                                                :german "source und Ziel sind identisch"))
);
);local-functions

:ok-action 
'(let (prt-list name owner p1 p2 p3 p4 p5 p6 new-name sparts-list)
	(setf p1 (sd-vec-xform (gpnt3d 0.0 0.0 0.0) :source-space dest :dest-space :global))
	(setf p3 (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space dest :dest-space :global))
	(setf p5 (sd-vec-xform (gpnt3d 0.0 1.0 0.0) :source-space dest :dest-space :global))
	(setf new-name (sd-inq-obj-basename source))
	(if flag1
		(progn
			(recurse (oli:sd-pathname-to-obj "/"))
			(dolist (assy_memb assy_list "done")
				(when (oli:sd-string= (oli:sd-inq-obj-contents-sysid dest) (oli:sd-inq-obj-contents-sysid assy_memb))
					(if (oli:sd-inq-obj-parent-contents-read-only-p assy_memb)
						(setf l-error-read-only-f t)
						(progn
						;(display (format nil "Part: ~A" (oli:sd-inq-obj-pathname assy_memb)))
						(push assy_memb sparts-list)
						)
					)
				)
			)
		)
		(progn
			(setf sparts-list other_dest)
			(push dest sparts-list)
		)
	)
	(dolist (a-part sparts-list)
		;(display (format nil "~A" (oli:sd-inq-obj-pathname a-part)))
		(setf name (sd-inq-obj-basename a-part))
		(setf p2 (sd-vec-xform (gpnt3d 0.0 0.0 0.0) :source-space a-part :dest-space :global))
		(setf p4 (sd-vec-xform (gpnt3d 1.0 0.0 0.0) :source-space a-part :dest-space :global))
		(setf p6 (sd-vec-xform (gpnt3d 0.0 1.0 0.0) :source-space a-part :dest-space :global))
		(setf owner (sd-inq-parent-obj a-part))
		(sd-call-cmds (delete_3d a-part))
		(unless flag2
			(setf name (sd-gen-obj-basename :assembly :parent owner :prefix (concatenate 'string new-name ".")))
		)
		(sd-call-cmds (CREATE_MULTIPLE_PA :SHARE
			:SOURCE source
			:OWNER owner
			:NAME name
			:match_three_pts p1 p2 p3 p4 p5 p6
		))
	)
	(when flag 
		(unless (sd-inq-obj-parent-contents-read-only-p source)
			(sd-call-cmds (delete_3d source))
		)
	)
	); let

);sd-defdialog