277 lines
8.9 KiB
Common Lisp
277 lines
8.9 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)
|
|
|
|
;; ------------------------------------------------------------
|
|
;; 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*))
|
|
)
|
|
|
|
;; ------------------------------------------------------------
|
|
;; 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 (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD HH:MM:SS)"))
|
|
(if (not ts) (setq ts "(kein Zeitstempel)"))
|
|
(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 (menucmd "M=$(edtime,$(getvar,date),YYYY-MO-DD HH:MM:SS)"))
|
|
(if (not ts) (setq ts "(kein Zeitstempel)"))
|
|
(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)
|