diff --git a/collects/racket/draw/unsafe/glib.rkt b/collects/racket/draw/unsafe/glib.rkt index 66bafde7c8..3f5231c947 100644 --- a/collects/racket/draw/unsafe/glib.rkt +++ b/collects/racket/draw/unsafe/glib.rkt @@ -31,3 +31,7 @@ (define-ffi-definer define-glib glib-lib) (define-ffi-definer define-gmodule gmodule-lib) (define-ffi-definer define-gobj gobj-lib) + +;; Route glib logging to Racket logging: +(define-glib g_log_set_default_handler (_fun _fpointer _pointer -> _fpointer)) +(void (g_log_set_default_handler (get-ffi-obj 'scheme_glib_log_message #f _fpointer) #f)) diff --git a/src/racket/include/mzwin.def b/src/racket/include/mzwin.def index 5f2ef7a294..4c40d29944 100644 --- a/src/racket/include/mzwin.def +++ b/src/racket/include/mzwin.def @@ -100,6 +100,7 @@ EXPORTS scheme_log_message scheme_log_abort scheme_log_warning + scheme_glib_log_message scheme_out_of_memory_abort scheme_wrong_count scheme_wrong_count_m diff --git a/src/racket/include/mzwin3m.def b/src/racket/include/mzwin3m.def index 8dffd3241a..25e99ccfc7 100644 --- a/src/racket/include/mzwin3m.def +++ b/src/racket/include/mzwin3m.def @@ -100,6 +100,7 @@ EXPORTS scheme_log_message scheme_log_abort scheme_log_warning + scheme_glib_log_message scheme_out_of_memory_abort scheme_wrong_count scheme_wrong_count_m diff --git a/src/racket/include/racket.exp b/src/racket/include/racket.exp index 015e172cad..d24017f152 100644 --- a/src/racket/include/racket.exp +++ b/src/racket/include/racket.exp @@ -98,6 +98,7 @@ scheme_log scheme_log_message scheme_log_abort scheme_log_warning +scheme_glib_log_message scheme_out_of_memory_abort scheme_wrong_count scheme_wrong_count_m diff --git a/src/racket/include/racket3m.exp b/src/racket/include/racket3m.exp index adf0535742..1f0d86d2da 100644 --- a/src/racket/include/racket3m.exp +++ b/src/racket/include/racket3m.exp @@ -98,6 +98,7 @@ scheme_log scheme_log_message scheme_log_abort scheme_log_warning +scheme_glib_log_message scheme_out_of_memory_abort scheme_wrong_count scheme_wrong_count_m diff --git a/src/racket/src/error.c b/src/racket/src/error.c index b1d0bbf35c..2fd07a3472 100644 --- a/src/racket/src/error.c +++ b/src/racket/src/error.c @@ -2882,6 +2882,49 @@ void scheme_log_warning(char *buffer) scheme_log_message(scheme_main_logger, SCHEME_LOG_WARNING, buffer, strlen(buffer), scheme_false); } +void scheme_glib_log_message(const char *log_domain, + int log_level, + const char *message, + void *user_data) +/* This handler is suitable for use as a glib logging handler. + Although a handler can be implemented with the FFI, + we build one into Racket to avoid potential problems of + handlers getting GCed or retaining a namespace. */ +{ +#define mzG_LOG_LEVEL_ERROR (1 << 2) +#define mzG_LOG_LEVEL_CRITICAL (1 << 3) +#define mzG_LOG_LEVEL_WARNING (1 << 4) +#define mzG_LOG_LEVEL_MESSAGE (1 << 5) +#define mzG_LOG_LEVEL_INFO (1 << 6) +#define mzG_LOG_LEVEL_DEBUG (1 << 7) + int level, len1, len2; + char *together; + + if (log_level & (mzG_LOG_LEVEL_ERROR)) + level = SCHEME_LOG_FATAL; + if (log_level & (mzG_LOG_LEVEL_CRITICAL)) + level = SCHEME_LOG_ERROR; + if (log_level & (mzG_LOG_LEVEL_WARNING | mzG_LOG_LEVEL_MESSAGE)) + level = SCHEME_LOG_WARNING; + if (log_level & (mzG_LOG_LEVEL_INFO)) + level = SCHEME_LOG_INFO; + if (log_level & (mzG_LOG_LEVEL_DEBUG)) + level = SCHEME_LOG_DEBUG; + + len2 = strlen(message); + if (log_domain) { + len1 = strlen(log_domain); + together = (char *)scheme_malloc_atomic(len1 + len2 + 3); + memcpy(together, log_domain, len1); + memcpy(together + len1, ": ", 2); + memcpy(together + len1 + 2 + 1, message, len2); + len2 += len1 + 2; + } else + together = (char *)message; + + scheme_log_message(scheme_main_logger, level, together, len2, scheme_false); +} + static int extract_level(const char *who, int which, int argc, Scheme_Object **argv) { Scheme_Object *v; diff --git a/src/racket/src/schemef.h b/src/racket/src/schemef.h index 6f385fcaab..1e9d669d42 100644 --- a/src/racket/src/schemef.h +++ b/src/racket/src/schemef.h @@ -205,6 +205,7 @@ MZ_EXTERN void scheme_log(Scheme_Logger *logger, int level, int flags, MZ_EXTERN void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, intptr_t len, Scheme_Object *data); MZ_EXTERN void scheme_log_abort(char *buffer); MZ_EXTERN void scheme_log_warning(char *buffer); +MZ_EXTERN void scheme_glib_log_message(const char *log_domain, int log_level, const char *message, void *user_data); MZ_EXTERN void scheme_out_of_memory_abort(); MZ_EXTERN void scheme_wrong_count(const char *name, int minc, int maxc, diff --git a/src/racket/src/schemex.h b/src/racket/src/schemex.h index 0da0c5010e..516fa9395f 100644 --- a/src/racket/src/schemex.h +++ b/src/racket/src/schemex.h @@ -162,6 +162,7 @@ void (*scheme_log)(Scheme_Logger *logger, int level, int flags, void (*scheme_log_message)(Scheme_Logger *logger, int level, char *buffer, intptr_t len, Scheme_Object *data); void (*scheme_log_abort)(char *buffer); void (*scheme_log_warning)(char *buffer); +void (*scheme_glib_log_message)(const char *log_domain, int log_level, const char *message, void *user_data); void (*scheme_out_of_memory_abort)(); void (*scheme_wrong_count)(const char *name, int minc, int maxc, int argc, Scheme_Object **argv); diff --git a/src/racket/src/schemex.inc b/src/racket/src/schemex.inc index caac19eeaf..73e1a52379 100644 --- a/src/racket/src/schemex.inc +++ b/src/racket/src/schemex.inc @@ -106,6 +106,7 @@ scheme_extension_table->scheme_log_message = scheme_log_message; scheme_extension_table->scheme_log_abort = scheme_log_abort; scheme_extension_table->scheme_log_warning = scheme_log_warning; + scheme_extension_table->scheme_glib_log_message = scheme_glib_log_message; scheme_extension_table->scheme_out_of_memory_abort = scheme_out_of_memory_abort; scheme_extension_table->scheme_wrong_count = scheme_wrong_count; scheme_extension_table->scheme_wrong_count_m = scheme_wrong_count_m; diff --git a/src/racket/src/schemexm.h b/src/racket/src/schemexm.h index fa082c493f..adac620c93 100644 --- a/src/racket/src/schemexm.h +++ b/src/racket/src/schemexm.h @@ -106,6 +106,7 @@ #define scheme_log_message (scheme_extension_table->scheme_log_message) #define scheme_log_abort (scheme_extension_table->scheme_log_abort) #define scheme_log_warning (scheme_extension_table->scheme_log_warning) +#define scheme_glib_log_message (scheme_extension_table->scheme_glib_log_message) #define scheme_out_of_memory_abort (scheme_extension_table->scheme_out_of_memory_abort) #define scheme_wrong_count (scheme_extension_table->scheme_wrong_count) #define scheme_wrong_count_m (scheme_extension_table->scheme_wrong_count_m) diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h index b4f6fd217d..f34e8d9112 100644 --- a/src/racket/src/schvers.h +++ b/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "5.0.99.4" +#define MZSCHEME_VERSION "5.0.99.5" #define MZSCHEME_VERSION_X 5 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 99 -#define MZSCHEME_VERSION_W 4 +#define MZSCHEME_VERSION_W 5 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)