;;--------------------------------------------------------------------------*
;;  Copyright 2012  DC4 Technisches Büro GmbH                               *
;;                                                                          *
;;--------------------------------------------------------------------------*
;;  Dateiname: comcon.lsp
;;  Version  : 1.0
;;  Datum    : 05.02.2012
;;  Author   : Gt
;;--------------------------------------------------------------------------*
;;  Modulbeschreibung: mehrere Unterkonfigurationen kombinieren         *
;;                                                                          *
;;--------------------------------------------------------------------------*

;;--------------------------------------------------------------------------*
;;     in-packages                                                          *
;;--------------------------------------------------------------------------*

(in-package :DC4)

;;--------------------------------------------------------------------------*
;;     use-packages                                                         *
;;--------------------------------------------------------------------------*

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

;;--------------------------------------------------------------------------*
;;     export                                                               *
;;--------------------------------------------------------------------------*

;;--------------------------------------------------------------------------*
;;     global variables                                                     *
;;--------------------------------------------------------------------------*

(defvar *dc4-concom-owner*)
(setq *dc4-concom-owner* nil)

;;--------------------------------------------------------------------------*
;;     menues                                                               *
;;--------------------------------------------------------------------------*

;;--------------------------------------------------------------------------*
;;     dialogs                                                              *
;;--------------------------------------------------------------------------*

(sd-defdialog 'dc4-konfigurationen-kombinieren-dialog
:dialog-title "Konfig.komb."
;;:dialog-control :sequential
:precondition '(if (sd-inq-active-configuration)
																(values :error "Achtung, Konfiguration aktiv!")
                :ok)
:variables
  '(
    (bgr   :value-type :assembly
           :prompt-text "Baugruppe als Besitzer angeben"
           :title "Besitzer"
           :after-input (setq *dc4-concom-owner* bgr)
    )
    (cname :value-type :string
           :prompt-text "Name der neuen Konfiguration angeben"
           :title "Name"
    )
				(att   :range (
																		(:CONTENTS :label "Inhalt")
																		(:INSTANCE :label "Exemplar")
																			)
           :title "Zuordnung"
				)
				(pmod  :range (
																		(:ABSOLUTE :label "Absolut")
																		(:RELATIVE :label "Relativ")
																			)
           :title "Pos.Modus"
				)
    (clist :selection
              (*sd-configuration-seltype*)
           :multiple-items t
           :show-select-menu t
           :prompt-text "Quell-Konfigurationen angeben"
           :title "Quellen"
           :check-function
           #'(lambda (wert)
              (let (ans)
               (setf ans (dc4-check-sourcecon-ownwer wert))
              (if ans
                :ok
                (values :error "Die Konfiguration muss unter der Zielkonfiguration liegen!")
               );;if
              );;let
             );;lambda
           ;;:initial-value nil
           :after-input (check-it)
    )
   )
:local-functions
  '(
    (check-it ()
     (let (good paroblist parob cf)
      (setf good t)
						(setf paroblist (list))
      (dolist (cf clist)
						 (setf parob (sd-inq-parent-obj cf))
       (if (find parob paroblist :test #'equal)
        (setf good nil)
								(push parob paroblist)
       );;if 
      );;dolist
      (when (not good)
       (progn
        (sd-display-error "Mehrere Konfigurationen eines Besitzers sind nicht zulaessig!")
        (setf clist nil)
       );;progn
      );;when
     );;let
    )
    (next-action ()
     (let (tmz qc tmq)
						(setf tmz (list))
						(dolist (qc clist)
							(setf tmq (sd-inq-configuration-positions qc))
							(setf tmz (nconc tmz tmq))
;;							(display tmz)
						);;dolist
						(sd-create-configuration :owner bgr
                         :mode pmod
                         :attachment att
                         :name cname
                         :name-conflict :delete-old 
                         :positions tmz
                         )
     );;let
    )
   )
:ok-action
   '(next-action)
:help-action '()
)

;;--------------------------------------------------------------------------*
;;     functions                                                            *
;;--------------------------------------------------------------------------*

(defun dc4-check-sourcecon-ownwer (scon)
 (let (obgr answer)
			(setf answer nil)
;;			(display (sd-inq-obj-pathname *dc4-concom-owner*))
   (setf obgr (sd-inq-parent-obj scon))
;;			(display (sd-inq-obj-pathname obgr))
   (if (sd-string= (sd-inq-obj-pathname obgr) (sd-inq-obj-pathname *dc4-concom-owner*))
     (setf answer t)
     (setf answer (dc4-check-sourcecon-owner-2 obgr))
    );;if
			(values answer)
 ) ;; let
)

(defun dc4-check-sourcecon-owner-2 (obgr)
 (let (obgr2 answer)
			(setf answer nil)
			(when obgr
			 (progn
		   (setf obgr2 (sd-inq-parent-obj obgr))
;;					(display (sd-inq-obj-pathname obgr2))
		   (if (sd-string= (sd-inq-obj-pathname obgr2) (sd-inq-obj-pathname *dc4-concom-owner*))
		     (setf answer t)
		     (setf answer (dc4-check-sourcecon-owner-2 obgr2))
		    );;if
					);;progn
				);;when
			(values answer)
 ) ;; let
)