;;--------------------------------------------------------------------------*
;;  Copyright 2004  DC4 Technisches Büro GmbH                               *
;;                                                                          *
;;--------------------------------------------------------------------------*
;;  Dateiname: teilname_v3.lsp
;;  Version  : 32.0
;;  Datum    : 27.10.2005
;;  Author   : Gt
;;--------------------------------------------------------------------------*

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

;;--------------------------------------------------------------------------*

(sd-defdialog 'dc4-desman-mminfo-to-basename-dialog
:dialog-title "Namen aendern"
;;:dialog-control :sequential
:variables
  '(
    (csids)
    (wahl
           :selection
              (*sd-object-seltype*)
           :multiple-items t
           :show-select-menu t
           :prompt-text "Teile oder Baugruppen angeben"
           :title "Teile/Baugr."
           :initial-value nil
           :check-function #'(lambda (para) (if nil :ok :err))
           :confirmation
             (:Err :dialog :warning
                   :prompt (format nil "Alle ausgewaehlten Teile und Baugruppen werden~%~%entsprechend ihren MM-Inhalten umbenannt!")
                   :severity :high
                   :cancel-cleanup (cancel)
             )
    )
    (nur
           :selection
              (*sd-object-seltype*)
           :multiple-items t
           :show-select-menu t
           :prompt-text "Teile oder Baugruppen angeben"
           :title "nur Exemplare"
           :initial-optional t
           :after-input (after-nur-action)
    )
    (mnum  :value-type :grouped-boolean
           :title "Modell-Nr"
           :initial-value nil
    )
    (mbes  :value-type :grouped-boolean
           :title "Beschreibung"
           :initial-value t
    )
    (cust  :value-type :string
           :title "Benutzerd."
           :toggle-type :indicator-toggle-data
           :initial-value nil
           :check-function #'(lambda (para) (if nil :ok :err))
           :confirmation
             (:Err :dialog :warning
                   :prompt (format nil "Alle Teile und Baugruppen werden~%~%ohne Unterscheidung auf diesen Namen umbenannt!")
                   :severity :high
                   :cancel-cleanup (cancel)
             )
    )
    (alle  :value-type :boolean
           :toggle-type :wide-toggle
           :title "Alle umbenennen"
           :initial-value nil
    )
    (next
           :push-action (sd-call-cmds (next-action))
    )
   )
:mutual-exclusion '((mnum mbes cust))
:local-functions
  '(
    (after-nur-action ()
     (let (kind csid)
      (dolist (kind nur)
       (setf csid (sd-inq-obj-contents-sysid kind))
       (push csid csids)
      );;dolist
     )
    )
    (next-action ()
     (let ()
      (dolist (kind wahl)
       (dc4-mminfo-to-basename-in-bgr kind alle mnum mbes cust csids)
      );;dolist
     )
    )
   )
:ok-action
   '(sd-call-cmds (next-action))
)

(defun dc4-mminfo-to-basename-in-bgr (teil_bgr alle mnum mbes cust csids)
 (let (basename owner pathname mminfo basename newpath kind kinder csid)
  (setf basename (sd-inq-obj-basename teil_bgr))
  (setf csid (sd-inq-obj-contents-sysid teil_bgr))
;;(display basename)
  (when (or (sd-inq-part-p teil_bgr)
            (sd-inq-assembly-p teil_bgr)
            (sd-inq-container-p teil_bgr)
        )
   (progn
    (setf pathname (sd-inq-obj-pathname teil_bgr))
    (when (sd-string/= pathname "/")
     (progn
      (cond
       (mnum
        (setf mminfo (sd-inq-obj-contents-name teil_bgr))
       )
       (mbes
        (setf mminfo (dc4-desman-get-benennung-info teil_bgr))
       )
       (cust
        (setf mminfo cust)
       )
       (t
        (setf mminfo (sd-inq-obj-contents-name teil_bgr))
       )
      );;if
      (setf owner (sd-inq-parent-obj teil_bgr))
      (when (not owner)
        (setf owner (sd-pathname-to-obj "/"))
      );;when
      (when mminfo
       (progn
;;(display pathname)
        (setf newname (dc4-gen-part-basename owner teil_bgr mminfo))
;;(display newname)
        (when (or (and (sd-inq-part-p teil_bgr) (sd-string-match-pattern-p "[tT][0-9]*" basename))
                  (and (sd-inq-assembly-p teil_bgr) (sd-string-match-pattern-p "[bB][0-9]*" basename))
                  (and (sd-inq-container-p teil_bgr) (sd-string-match-pattern-p "[bB][hH][0-9]*" basename))
                  alle
              )
         (if csids
          (progn
           (when (member csid csids :test #'equal)
            (progn
             (if (not (sd-inq-obj-parent-contents-read-only-p teil_bgr))
              (sd-call-cmds (CHANGE_NAME_PA :PART_ASMB pathname :NAME newname))
              (display (format nil "~a konnte nicht umbenannt werden" pathname))
             );;if
            );;progn
           );;when
          );;progn
          (progn
           (if (not (sd-inq-obj-parent-contents-read-only-p teil_bgr))
            (sd-call-cmds (CHANGE_NAME_PA :PART_ASMB pathname :NAME newname))
            (display (format nil "~a konnte nicht umbenannt werden" pathname))
           );;if
          );;progn
         );;if
        );;when
       );;progn
      );;when
     );;progn
    );;when
    (setf kinder (sd-inq-obj-children teil_bgr))
    (dolist (kind kinder)
       (dc4-mminfo-to-basename-in-bgr kind alle mnum mbes cust csids)
    ) ;; dolist
   );;progn
  );;when
 ) ;; let
)

(defun dc4-gen-part-basename (owner teil_bgr prefix)
 (let (baslist chlist ch teiletyp bas index name)
  (setf baslist (list))
;;(display owner)
  (setf chlist (sd-inq-obj-children owner))
  (dolist (ch chlist)
   (when (or (sd-inq-part-p ch) (sd-inq-assembly-p ch) (sd-inq-container-p ch))
    (progn
     (when (not (equal ch teil_bgr))
      (progn
;;(display (sd-inq-obj-pathname teil_bgr))
       (setf bas (sd-inq-obj-basename ch))
       (setf baslist (nconc baslist (list bas)))
      );;progn
     );;when
    );;progn
   );;when
  );;dolist
  (setf index 0)
;;(display baslist)
  (loop
   (setf index (+ index 1))
   (if (= index 1)
    (setf name prefix)
    (setf name (format nil "~a.~10,3,'0,'0r" prefix index))
   );;if
   (if (not (member name baslist :test #'equal)) (return t))
  );;loop
  (values name)
 );;let
)

(defun dc4-desman-get-benennung-info (teil)
 (let (attributliste attribut inf)
  (setf attributliste (sd-inq-item-attributes teil :attachment :contents))
  (setf inf nil)
  (dolist (attribut attributliste)
   (progn
    (when (string= attribut "DB-DREF")
     (progn
      (setq inf (sd-inq-item-attribute teil attribut :BESCHREIBUNG :attachment :contents))
     );;progn
    );;when
   );;progn
  );;dolist
  (when (typep inf 'STRING)
   (when (= (length inf) 0) (setf inf nil))
  );;when
 (values inf)
 );;let
)