;; ============================================================
;; SSG_DBG.LSP - Debug-Routinensammlung
;;
;; Funktionen:
;;   (dbgopen "dateiname.dbg")  - Oeffnet Debug-Datei
;;   (dbgclose)                 - Schliesst Debug-Datei
;;   (dbgon)                   - Aktiviert Debug-Ausgabe
;;   (dbgoff)                  - Deaktiviert Debug-Ausgabe
;;   (dbgf "funktionsname")    - Schreibt Funktionseintritt mit {
;;   (dbgreturn wert)          - Schreibt Funktionsaustritt mit } = wert
;;   (dbg wert)                - Schreibt Variable mit aktuellem Wert
;;   (dbgp "text")             - Debug-Print (Alias fuer dbgmsg)
;;   (dbgmsg "text")           - Freitext-Nachricht loggen
;;
;; Strategie: dbgf/dbg/dbgmsg puffern im Speicher.
;; dbgreturn flusht den Puffer auf die Platte (open/append/close).
;; So hat jede Funktion mindestens einen Schreibvorgang,
;; ohne dass jeder einzelne dbg-Aufruf die Datei oeffnet.
;;
;; dbgon/dbgoff steuert, ob Ausgaben geschrieben werden.
;; Ein (dbgoff) VOR (dbgopen) verhindert das Anlegen der Datei.
;;
;; Beispiel:
;;   (dbgopen "test.dbg" "DXFM_LOG")
;;   (dbgf "meine-funktion")
;;   (dbg 'x)
;;   (dbgreturn ergebnis)      ; <-- hier wird alles geschrieben
;;   (dbgclose)
;; ============================================================

;; Globale Variablen
(setq *dbg-path* nil)        ; Voller Dateipfad (String)
(setq *dbg-indent* 0)        ; Aktuelle Einruecktiefe
(setq *dbg-active* T)        ; Debug-Ausgabe aktiv (Standard: ein)
(setq *dbg-buffer* nil)      ; Zeilenpuffer (Liste von Strings)

;; ------------------------------------------------------------
;; ZENTRALE DEBUG-SCHALTER-SAMMLUNG
;;
;; Jedes Feature/jede Routine hat ihren eigenen Schalter (Symbol -> 0/1).
;; Neue/unbekannte Schalter (die NICHT unten vorregistriert sind) gelten
;; implizit als AUS (0) - so bleiben (dbg-schalter-open "name" ...)-Aufrufe
;; im Code stehen, ohne dass beim normalen Arbeiten ungeplant .dbg-Dateien
;; entstehen. Die VF-Linienzug-Schalter unten sind bewusst mit Default 1
;; (EIN) vorregistriert, siehe Kommentar dort.
;;
;;   (dbg-schalter-on  "vfl-modus3")   ; Schalter einschalten (1)
;;   (dbg-schalter-off "vfl-modus3")   ; Schalter ausschalten (0)
;;   (dbg-schalter-p   "vfl-modus3")   ; T wenn eingeschaltet, sonst nil
;;   (dbg-schalter-open "vfl-modus3" "vfl_modus3.dbg" "DXFM_LOG")
;;                                     ; oeffnet die Datei NUR wenn Schalter=1;
;;                                     ; gibt T zurueck wenn geoeffnet, sonst nil
;;   (dbg-schalter-liste)              ; alle bekannten Schalter + Zustand zeigen
;; ------------------------------------------------------------
(if (not (boundp '*dbg-schalter*)) (setq *dbg-schalter* nil))

;; VF-Linienzug (Modus 1/2/3) Debug-Schalter, Default 1 (EIN): der Nutzer
;; will die Session + alle Eingaben durchgehend geloggt haben, ohne den
;; Schalter vor jedem Aufruf manuell einzuschalten. Bei Bedarf einzeln
;; abschaltbar: (dbg-schalter-off "vfl-modus1") usw.
(foreach nm '("vfl-modus1" "vfl-modus2" "vfl-modus3")
  (if (not (assoc nm *dbg-schalter*))
    (setq *dbg-schalter* (cons (cons nm 1) *dbg-schalter*))))

(defun dbg-schalter-set (name wert)
  (setq *dbg-schalter*
        (cons (cons name wert)
              (vl-remove-if '(lambda (p) (= (car p) name)) *dbg-schalter*)))
  wert)

(defun dbg-schalter-on  (name) (dbg-schalter-set name 1) (princ))
(defun dbg-schalter-off (name) (dbg-schalter-set name 0) (princ))

(defun dbg-schalter-p (name / p)
  (setq p (assoc name *dbg-schalter*))
  (and p (= (cdr p) 1)))

;; Oeffnet die Debug-Datei NUR, wenn der Schalter <name> eingeschaltet ist.
;; Rueckgabe: T wenn eine Datei geoeffnet wurde, sonst nil.
(defun dbg-schalter-open (name filename envvar)
  (if (dbg-schalter-p name)
    (progn (dbgon) (dbgopen filename envvar) T)
    nil))

(defun dbg-schalter-liste ( / )
  (prompt "\n[DBG] Bekannte Debug-Schalter:")
  (foreach p (reverse *dbg-schalter*)
    (prompt (strcat "\n  " (car p) " = " (itoa (cdr p))
                    (if (= (cdr p) 1) "  (EIN)" "  (aus)"))))
  (princ))

;; ------------------------------------------------------------
;; DBGON - Debug-Ausgabe aktivieren
;; ------------------------------------------------------------
(defun dbgon ()
  (setq *dbg-active* T)
  (princ)
)

;; ------------------------------------------------------------
;; DBGOFF - Debug-Ausgabe deaktivieren
;; ------------------------------------------------------------
(defun dbgoff ()
  (setq *dbg-active* nil)
  (princ)
)

;; ------------------------------------------------------------
;; DBG-FLUSH - Puffer auf Platte schreiben (open/append/close)
;; ------------------------------------------------------------
(defun dbg-flush (/ fh)
  (if (and *dbg-path* *dbg-buffer*)
    (progn
      (setq fh (open *dbg-path* "a"))
      (if fh
        (progn
          (foreach line (reverse *dbg-buffer*)
            (write-line line fh)
          )
          (close fh)
        )
      )
      (setq *dbg-buffer* nil)
    )
  )
)

;; ------------------------------------------------------------
;; DBG-BUFWRITE - Zeile in den Puffer schreiben
;; ------------------------------------------------------------
(defun dbg-bufwrite (line)
  (setq *dbg-buffer* (cons line *dbg-buffer*))
)

;; ------------------------------------------------------------
;; DBG-TIMESTAMP - Aktuellen Zeitstempel als String liefern
;; Bevorzugt DIESEL edtime (sauber vorformatiert), faellt bei nil (z.B.
;; ohne aktiven Grafikbildschirm/Menuekontext) auf die Systemvariable
;; CDATE zurueck (Format JJJJMMTT.SSMMSSmmm, immer nullgepolstert) -
;; besser ein aus CDATE geparster Zeitstempel als der alte Platzhalter
;; "(kein Zeitstempel)", der ueberhaupt nicht zeigt, WANN eine .dbg-Datei
;; angelegt wurde.
;; ------------------------------------------------------------
(defun dbg-timestamp ( / ts cdate)
  (setq ts (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD HH:MM:SS)"))
  (if (not ts)
    (progn
      (setq cdate (rtos (getvar "CDATE") 2 6))
      (setq ts (strcat (substr cdate 1 4) "-" (substr cdate 5 2) "-" (substr cdate 7 2)
                        " " (substr cdate 10 2) ":" (substr cdate 12 2) ":" (substr cdate 14 2)))
    )
  )
  ts
)

;; ------------------------------------------------------------
;; DBGOPEN - Debug-Datei oeffnen
;; Wenn *dbg-active* nil ist, wird keine Datei angelegt.
;; Parameter:
;;   filename - Dateiname (z.B. "test.dbg")
;;   envvar   - Optional: Name einer Umgebungsvariable fuer das
;;              Zielverzeichnis (z.B. "DXFM_LOG").
;;              Wenn nil oder nicht gesetzt, wird "." verwendet.
;; ------------------------------------------------------------
(defun dbgopen (filename envvar / dir fullpath fh ts)
  (if (not *dbg-active*)
    (progn
      (prompt "\n[DBG] Debug deaktiviert - keine Datei angelegt.")
      (princ)
    )
    (progn
      ;; Verzeichnis bestimmen
      (setq dir nil)
      (if (and envvar (/= envvar ""))
        (progn
          (setq dir (getenv envvar))
          ;;(prompt (strcat "\n[DBG] getenv " envvar " = " (if dir dir "nil")))
        )
      )
      (if (or (not dir) (= dir ""))
        (setq dir ".")
      )
      ;; Backslash am Ende sicherstellen
      (if (and (/= (substr dir (strlen dir) 1) "\\")
               (/= (substr dir (strlen dir) 1) "/"))
        (setq dir (strcat dir "\\"))
      )
      ;; Verzeichnis anlegen falls es nicht existiert
      (if (not (vl-file-directory-p (vl-string-right-trim "\\/" dir)))
        (progn
          (vl-mkdir (vl-string-right-trim "\\/" dir))
          (prompt (strcat "\n[DBG] Verzeichnis angelegt: " dir))
        )
      )
      (setq fullpath (strcat dir filename))
      ;; Datei mit "w" erstellen/leeren, Header schreiben, sofort schliessen
      (setq fh (open fullpath "w"))
      (if fh
        (progn
          (setq *dbg-path* fullpath)
          (setq *dbg-indent* 0)
          (setq *dbg-buffer* nil)
          (setq ts (dbg-timestamp))
          (write-line (strcat "=== DEBUG START " ts " ===") fh)
          (close fh)
          (prompt (strcat "\n[DBG] Debug-Datei geoeffnet: " fullpath))
        )
        (prompt (strcat "\n[DBG] FEHLER: Konnte Debug-Datei nicht oeffnen: " fullpath))
      )
      (princ)
    )
  )
)

;; ------------------------------------------------------------
;; DBGCLOSE - Debug-Datei schliessen (Puffer + Abschluss schreiben)
;; ------------------------------------------------------------
(defun dbgclose ( / ts)
  (if *dbg-path*
    (progn
      (setq ts (dbg-timestamp))
      (dbg-bufwrite (strcat "=== DEBUG ENDE " ts " ==="))
      (dbg-flush)
      (setq *dbg-path* nil)
      (setq *dbg-indent* 0)
      (prompt "\n[DBG] Debug-Datei geschlossen.")
    )
    (prompt "\n[DBG] Keine Debug-Datei geoeffnet.")
  )
  (princ)
)

;; ------------------------------------------------------------
;; DBG-TABS - Hilfsfunktion: Erzeugt Einrueckung
;; ------------------------------------------------------------
(defun dbg-tabs (/ result)
  (setq result "")
  (repeat *dbg-indent*
    (setq result (strcat result "\t"))
  )
  result
)

;; ------------------------------------------------------------
;; DBG-TOSTRING - Hilfsfunktion: Wert in String umwandeln
;; ------------------------------------------------------------
(defun dbg-tostring (val)
  (cond
    ((= val nil) "nil")
    ((= (type val) 'STR) (strcat "\"" val "\""))
    ((= (type val) 'INT) (itoa val))
    ((= (type val) 'REAL) (rtos val 2 6))
    ((= (type val) 'LIST)
      (strcat "(" (dbg-list-tostring val) ")")
    )
    ((= (type val) 'ENAME) (strcat "<Entity: " (vl-princ-to-string val) ">"))
    (T (vl-princ-to-string val))
  )
)

;; ------------------------------------------------------------
;; DBG-LIST-TOSTRING - Hilfsfunktion: Liste in String
;; ------------------------------------------------------------
(defun dbg-list-tostring (lst / result first)
  (setq result "" first T)
  (foreach item lst
    (if first
      (setq first nil)
      (setq result (strcat result " "))
    )
    (setq result (strcat result (dbg-tostring item)))
  )
  result
)

;; ------------------------------------------------------------
;; DBGF - Funktionseintritt loggen (puffert nur)
;; Schreibt "funktionsname(){" und erhoeht Einrueckung
;; ------------------------------------------------------------
(defun dbgf (funcname)
  (if (and *dbg-path* *dbg-active*)
    (progn
      (dbg-bufwrite (strcat (dbg-tabs) funcname "(){"))
      (setq *dbg-indent* (1+ *dbg-indent*))
    )
  )
  (princ)
)

;; ------------------------------------------------------------
;; DBGRETURN - Funktionsaustritt loggen + FLUSH auf Platte
;; Verringert Einrueckung und schreibt "} = wert"
;; ------------------------------------------------------------
(defun dbgreturn (retval)
  (if (and *dbg-path* *dbg-active*)
    (progn
      (setq *dbg-indent* (max 0 (1- *dbg-indent*)))
      (if retval
        (dbg-bufwrite (strcat (dbg-tabs) "} = " (dbg-tostring retval)))
        (dbg-bufwrite (strcat (dbg-tabs) "}"))
      )
      (dbg-flush)
    )
  )
  retval
)

;; ------------------------------------------------------------
;; DBG - Variable/Wert loggen (puffert nur)
;; Aufruf: (dbg 'varname) oder (dbg wert)
;; ------------------------------------------------------------
(defun dbg (varname / val)
  (if (and *dbg-path* *dbg-active*)
    (if (= (type varname) 'SYM)
      (progn
        (setq val (eval varname))
        (dbg-bufwrite (strcat (dbg-tabs) (vl-symbol-name varname) "=" (dbg-tostring val)))
      )
      (dbg-bufwrite (strcat (dbg-tabs) "value=" (dbg-tostring varname)))
    )
  )
  (princ)
)

;; ------------------------------------------------------------
;; DBGMSG - Freitext-Nachricht loggen (puffert nur)
;; ------------------------------------------------------------
(defun dbgmsg (msg)
  (if (and *dbg-path* *dbg-active*)
    (dbg-bufwrite (strcat (dbg-tabs) ">> " msg))
  )
  (princ)
)

;; ------------------------------------------------------------
;; DBGP - Alias fuer DBGMSG (debug print)
;; ------------------------------------------------------------
(defun dbgp (msg) (dbgmsg msg))

;; ------------------------------------------------------------
;; DBGFLUSH - Puffer sofort auf Platte schreiben (oeffentlich)
;; Nuetzlich wenn kein dbgreturn folgt (z.B. Startup-Code)
;; ------------------------------------------------------------
(defun dbgflush ()
  (dbg-flush)
  (princ)
)

(prompt "\nssg_dbg geladen.")
(princ)