m.stangl
9e3e8e16ae
TEST_LINIENZUG (ebenso hmrec:stubs-aus und vsp-headless-aus) schaltete die GUI am Ende pauschal wieder ein. Unter SSG_RUN_ALL_TESTS fragte der direkt folgende EXPORTSIVAS dann nach Hoehen-Check/Bereinigen und der Lauf blieb stehen. Alle drei stellen jetzt den Vorzustand von *ssg-gui-aus* wieder her. SSG_RUN_ALL_TESTS schaltet zusaetzlich *csv-hoehencheck-fragen* und *csv-bereinigen-vor-export* fuer den Lauf ab (unmittelbar vor jedem Export erneut, export.lsp belegt nil beim Nachladen wieder mit T), erzwingt GUI aus mit Warnung und stellt am Ende die Vorgaben wieder her. Neues Laufprotokoll DXFM_LOG/testlauf_<name>.dbg je Test (Debug-Schalter "testlauf", Standard ein): Zustand vor/nach dem Test, Fehler, Ergebnis-JSON, Export-Schritte. Eigene Datei mit sofortigem Schreiben statt dbgopen, damit die Module mit ihren eigenen .dbg-Dateien es nicht umlenken und bei einem Haenger der letzte Schritt sichtbar ist. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
391 lines
15 KiB
Common Lisp
391 lines
15 KiB
Common Lisp
;; ============================================================
|
|
;; 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*))))
|
|
|
|
;; ------------------------------------------------------------
|
|
;; TEMPORAER - Diagnose "gespiegelte Sepliste-Koordinate" (lfdnr=2)
|
|
;;
|
|
;; Beide Schalter hier stehen NUR fuer diese Fehlersuche auf 1 und werden
|
|
;; danach wieder entfernt (mitsamt der zugehoerigen Instrumentierung in
|
|
;; ssg_ks_insert.lsp/Gefaellestrecke.lsp/vf_core.lsp bzw. dem Guard in
|
|
;; csv:hilfskopien-loeschen, export.lsp). vf-sepliste ist bewusst mit 1
|
|
;; vorregistriert, damit nach einem BricsCAD-Neustart ohne weiteres Zutun
|
|
;; protokolliert wird; csv_leave_proxies mit 0 - Standard ist, dass der Export
|
|
;; seine Hilfskopien wieder abraeumt.
|
|
;;
|
|
;; vf-sepliste - protokolliert den kompletten Weg der
|
|
;; Sepliste-Koordinaten beim Bau einer VF-/GF-Kette
|
|
;; nach DXFM_LOG/vf_sepliste.dbg (eigene Datei, nicht
|
|
;; ueber *dbg-path*).
|
|
;; csv_leave_proxies - laesst ALLE Hilfskopien des Exports (Separator-/
|
|
;; Element-Kopien, Foerder-/Gefaelleeinheit-Proxies)
|
|
;; nach dem Export in der Zeichnung stehen, damit man
|
|
;; in BricsCAD sieht, was exportiert wurde. Auch ueber
|
|
;; den Dialog CSV_EXPORT_KONFIG schaltbar. Standard 0.
|
|
;; Der naechste Export raeumt stehengebliebene
|
|
;; Einheiten-Proxies selbst ab; Separator-/Element-
|
|
;; Kopien sammeln sich dagegen an - Zeichnung mit
|
|
;; eingeschaltetem Schalter nicht speichern.
|
|
;; kf-zeit - Zwischenzeiten beim Aufruf von KETTENFOERDERER
|
|
;; (Daten lesen / Dialogaufbau), siehe kf-zeit in
|
|
;; KettenFoerderer.lsp. Standard 0 - nur einschalten,
|
|
;; wenn der Dialog spuerbar verzoegert erscheint.
|
|
;; testlauf - Laufprotokoll je Test von SSG_RUN_ALL_TESTS nach
|
|
;; DXFM_LOG/testlauf_<name>.dbg (eigene Datei, nicht
|
|
;; ueber *dbg-path*; jede Zeile sofort geschrieben,
|
|
;; damit bei einem haengenden Test der letzte Schritt
|
|
;; sichtbar ist). Standard 1 - kostet nur ein paar
|
|
;; Zeilen je Test, siehe testrun:log in
|
|
;; tests/test_run_all.lsp.
|
|
;; ------------------------------------------------------------
|
|
(foreach nm '(("vf-sepliste" . 1) ("csv_leave_proxies" . 0) ("kf-zeit" . 0)
|
|
("testlauf" . 1))
|
|
(if (not (assoc (car nm) *dbg-schalter*))
|
|
(setq *dbg-schalter* (cons nm *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)
|
|
)
|
|
|
|
(princ)
|