Make startup logging safe
ober
4364871454dca95111fbb92687f438c882fa9586
--- a/src/jerboa-emacs/core.ss +++ b/src/jerboa-emacs/core.ss @@ -235,7 +235,6 @@ (import :std/sugar :std/sort :std/srfi/13 - (only-in :std/srfi/19 current-date date->string) :std/misc/rwlock (only-in :std/misc/string string-split) (only-in :std/misc/list filter-map) @@ -1886,34 +1885,44 @@ (def *jemacs-log-port* #f) (def *jemacs-original-stderr* #f) (def *verbose-log-port* #f) +(def *jemacs-log-seq* 0) +(def *verbose-log-seq* 0) (def (init-jemacs-log!) "Initialize the runtime error log. Opens ~/.jemacs-errors.log for append, - redirects current-error-port so Scheme-level stderr writes go to the log. Call once at startup (Qt or TUI)." (let ((log-path (or (getenv "JEMACS_ERROR_LOG" #f) (string-append (getenv "HOME" "/tmp") "/.jemacs-errors.log")))) ;; Save original stderr for fallback (set! *jemacs-original-stderr* (current-error-port)) - ;; Open log file in append mode - (set! *jemacs-log-port* (open-output-file log-path 'append)) - ;; Redirect Scheme current-error-port to the log file - ;; This captures Gambit's display-exception, warning messages, etc. - (current-error-port *jemacs-log-port*) - (jemacs-log! "jemacs started"))) + (with-catch + (lambda (e) + (set! *jemacs-log-port* #f) + (when *jemacs-original-stderr* + (display "jemacs-log init failed\n" *jemacs-original-stderr*) + (flush-output-port *jemacs-original-stderr*))) + (lambda () + ;; Open log file in append mode. Do not redirect current-error-port: + ;; static Qt builds have crashed during startup when mutating it here, + ;; and stderr breadcrumbs are needed in gdb logs. + (set! *jemacs-log-port* (open-output-file log-path 'append)) + (jemacs-log! "jemacs started"))))) (def (jemacs-log! . args) - "Write a timestamped line to the jemacs error log. + "Write a line to the jemacs error log. Arguments are concatenated as strings." (when *jemacs-log-port* - (let ((port *jemacs-log-port*) - (ts (date->string (current-date 0) "~Y-~m-~d ~H:~M:~S"))) - (display "[" port) - (display ts port) - (display "] " port) - (for-each (lambda (arg) (display arg port)) args) - (newline port) - (force-output port)))) + (with-catch + (lambda (e) (void)) + (lambda () + (set! *jemacs-log-seq* (+ *jemacs-log-seq* 1)) + (let ((port *jemacs-log-port*)) + (display "[log " port) + (display (number->string *jemacs-log-seq*) port) + (display "] " port) + (for-each (lambda (arg) (display arg port)) args) + (newline port) + (flush-output-port port)))))) ;; Legacy aliases (kept for backward compatibility) ;; gemacs-log! and init-gemacs-log! removed — use jemacs-log! / init-jemacs-log! directly @@ -1923,25 +1932,28 @@ Call from qt-main when --verbose is passed." (let ((path (or (getenv "JEMACS_VERBOSE_LOG" #f) (string-append (getenv "HOME" "/tmp") "/.jemacs-verbose.log")))) - (set! *verbose-log-port* (open-output-file path 'append)) - (verbose-log! "=== jemacs-qt verbose log started ===") + (with-catch + (lambda (e) (set! *verbose-log-port* #f)) + (lambda () + (set! *verbose-log-port* (open-output-file path 'append)) + (verbose-log! "=== jemacs-qt verbose log started ==="))) path)) (def (verbose-log! . args) - "Write a timestamped line to ~/.jemacs-verbose.log with thread id. + "Write a line to ~/.jemacs-verbose.log. No-op if verbose mode is not enabled." (when *verbose-log-port* - (let* ((port *verbose-log-port*) - (ts (date->string (current-date 0) "~Y-~m-~d ~H:~M:~S")) - (tid (format "~a" (current-thread)))) - (display "[" port) - (display ts port) - (display "] [" port) - (display tid port) - (display "] " port) - (for-each (lambda (arg) (display arg port)) args) - (newline port) - (force-output port)))) + (with-catch + (lambda (e) (void)) + (lambda () + (set! *verbose-log-seq* (+ *verbose-log-seq* 1)) + (let ((port *verbose-log-port*)) + (display "[verbose " port) + (display (number->string *verbose-log-seq*) port) + (display "] " port) + (for-each (lambda (arg) (display arg port)) args) + (newline port) + (flush-output-port port)))))) ;;;============================================================================ ;;; Captured output logs (for eval stdout/stderr in Qt)