Schoenenberger_Systeme_GmbH/dxfmakros
3
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity
Files
bfd95ea7253887656b85cf695c761e7b43590b2b
dxfmakros/Lisp/ssg_dbg.lsp
T
m.stangl f92c80d82a VF-Linienzug: Modus 2 loggen, Debug-Default auf AN, GF-Hoehenvorschlag-Bug behoben 
Debug-Logging (Schalter vfl-modus1/2/3) ist jetzt standardmaessig AN statt
AUS, damit nicht vor jeder Session manuell eingeschaltet werden muss. Modus 2
(vf-linienzug-modus2) war bisher nicht instrumentiert - Session-Open/Close
und *error*-Handling analog Modus 1/3 ergaenzt; da Modus 2 durchgehend die
vfl-in-*-Wrapper nutzt, wird das Eingabe-Logging automatisch ueber den
vorhandenen vfl-journal-record-Hook mitgezogen.

Bugfix: Der Hoehen-Vorschlag im GF-Zielhoehe-Dialog (Wizard + Konsole) war
schlicht die unveraenderte Ist-Hoehe der Kette. Direkt uebernommen ergab das
deltaH=0, was als "Auf" statt "Ab" gewertet und immer mit "kann nicht
steigen" abgelehnt wurde - der Default war also nie baubar. Neue Hilfs-
funktion vfl-gf-hoehe-vorschlag rundet auf volle mm ab und zieht bei
bereits ganzzahligen Werten zusaetzlich 1mm ab, damit der Vorschlag
garantiert unterhalb der Ist-Hoehe liegt.

Ausserdem: unnoetige Anfuehrungszeichen aus den zugehoerigen Fehlermeldungen
(de/en) entfernt.

Co-Authored-By: Claude Sonnet 5 <noreply@anthropic.com>
2026-08-27 11:25:47 +02:00

351 lines
12 KiB
Common Lisp
Raw Blame History

;; ============================================================
;; 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)
Reference in New Issue View Git Blame Copy Permalink