;;-----------------------------------------------------------------------------
;;                                    for CoCreate OneSpace Designer Annotation
;;  Description:
;;    coloring obj in structure browser based on StephanWörz 1st version
;;     former file name: sd_browser_color_schiller.lsp
;;-----------------------------------------------------------------------------
;;  Filename   : cadde_92_001029.lsp
;;  Version    : 1.1
;;  Datum      : Wed Nov 29 19:34:16 CET 2023
;;  Author     : der_Wolfgang@forum@cad.de
;;  Modified   : Wed Nov 29 20:32:45 CET 2023  der_Wolfgang@forum@cad.de
;;  Download   : cad.de
;;  SD-Version : developed with PE80,
;;               should work in old versions as well as in big Modeling
;;
;;  reference: https://ww3.cad.de/foren/ubb/Forum92/HTML/001029.shtml
;;
;;-----------------------------------------------------------------------------

#|
Wir müssen den Ansatz für so einen Interrogator etwas um strukturieren.

a) es gibt EINE Funktion my-color-interrogator
b) diese wird einmal beim Laden der Datei mit sd-browser-add-interrogator  registriert
c) das Verhalten der Funktion steuern wir über einen globalen toggle
d) den toggle steuern wir über eine/zwei on/off Funktionen
e) den Wert des Toggles könnten wir über sd-set/get-persistent-data auch persistent machen
   oder wir nutzen gleich den Settingsbrowser, dann ist es im UI arg hübsch
|#

(in-package  :schiller)
(use-package :Oli)
(export 'browser-colors-toggle) ;; @Stephan, glaub nicht das du die exports wirklich brauchst
(export 'browser-colors-on)
(export 'browser-colors-off)

(let ((useColorState nil)) ;; ein 'globales let'  zur Kapselung = keiner kommt von aussen da ran!

(defun browser-colors-toggle ()
  (setq useColorState (not useColorState))
  (sd-browser-exec-cmd "parcel-gbrowser" :REFRESH-TREE)
  )
(defun browser-colors-on ()
  (setq useColorState T)
  (sd-browser-exec-cmd "parcel-gbrowser" :REFRESH-TREE)
  )
(defun browser-colors-off ()
  (setq useColorState nil)
  (sd-browser-exec-cmd "parcel-gbrowser" :REFRESH-TREE)
  )

;; liefert
;;   ne hybsche Farbe wenn die Einfärbung EINgeschaltet ist
;;   nil wenn die Einfärbung AUSgeschaltet ist
(defun my-color-interrogator (node browser-name)
  (if useColorState
    (let (myobj myattrib children)
      (if (sd-is-pseudo-folder-node-p (browsernode-nodeid node))
        (progn
          (setq children (sd-query-browser browser-name :get-children node))
          (setq myobj (sd-pathname-to-obj (browsernode-objpath (first children))))
          )
        ;; else
        (setq myobj (sd-pathname-to-obj (browsernode-objpath node)))
        )
      (when (and (sel_item-p myobj)
                (or (sd-inq-part-p myobj)
                    (sd-inq-assembly-p myobj)))
        ;; if the object is a pseudo-folder, use its first child object as "myobj"
        ;; capture the attribute value so we don't have to retrieve it multiple times when testing (faster!)
        (setf myattrib (sd-inq-item-attribute myobj "PDM-ATTR" :status :attachment :contents))
        (cond
         ((not (stringp myattrib)) "#000000") ;; kein Attribut/wert? schnell weg hier!  -> Performance!
         ((equal myattrib "In Arbeit") "#0000ff" ) ;; blau
         ((equal myattrib "Zur Pruefung") "#FF00FF" ) ;: Magenta
         ((equal myattrib "Vorfreigabe") "#FF8000" ) ;: orange
         ((equal myattrib "Freigabe") "#008000" ) ;: green
         ((equal myattrib "Gesperrt") "#FF0000" ) ;: rot
         ;; uncomment the following line to highlight pseudo-folders separately (red in this case)
         ;;((sd-is-pseudo-folder-node-p (browsernode-nodeid node)) "#FF0000")
         ((sd-inq-part-p myobj) "#414141") ;; highlight parts w/o matching attrib in blue
         ((sd-inq-assembly-p myobj) "#414141") ;; highlight assemblies w/o matching attrib in green
         (t "#000000")  ;; if nothing above matches
        ))
      ) ;; end let
    ;; else
    nil ;; no color at all == default color for browser text
    ) ;; end if useColorState
  );;defun

(sd-browser-add-interrogator "parcel-gbrowser" ;; ist der Name der Strukturliste!!
  :interrogator-type :text-color
  :interrogator-func 'my-color-interrogator)

) ;; end global let

(when nil  ;; set T for debugging purpose
  (trace browser-colors-toggle browser-colors-off browser-colors-on my-color-interrogator)
  (trace sd-pathname-to-obj sd-inq-part-p sd-inq-assembly-p sd-is-pseudo-folder-node-p sd-inq-item-attribute)
  )