From: Matt Birkholz Date: Wed, 20 Jul 2011 16:21:30 +0000 (-0700) Subject: Reformat trace messages some more. X-Git-Tag: mit-scheme-pucked-9.2.12~679 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fbc00ee86a2e67251259740da5c196c92241587b;p=mit-scheme.git Reformat trace messages some more. --- diff --git a/src/gtk/fix-demo.scm b/src/gtk/fix-demo.scm index 36fb6265d..c4d86577d 100644 --- a/src/gtk/fix-demo.scm +++ b/src/gtk/fix-demo.scm @@ -252,8 +252,6 @@ USA. (define %trace? #f) (define %trace2? #f) -;; The (%trace...) syntax avoids evaluating expensive expressions among -;; the argument forms when its corresponding %trace? flag is off. (define-syntax %trace (syntax-rules () ((_ . ARGS) (if %trace? ((lambda () (outf-console . ARGS))))))) diff --git a/src/gtk/fix-layout.scm b/src/gtk/fix-layout.scm index cbc1d496a..f2cd57d07 100644 --- a/src/gtk/fix-layout.scm +++ b/src/gtk/fix-layout.scm @@ -107,7 +107,7 @@ USA. (error:wrong-type-argument obj "a positive fixnum, 0 or -1" (list 'initialize-instance )))) - (%trace ";((initialize-instance ) "widget" "width" "height")...\n") + (%trace ";(initialize-instance ) "widget" "width" "height"\n") (call-next-method widget) (let ((alien (gobject-alien widget))) (let ((w (->requisition-fixnum width)) @@ -260,14 +260,14 @@ USA. ;;; Callbacks. (define (allocation-callback widget GtkAllocation) - (%trace2 ";allocation "widget" "GtkAllocation"\n") + (%trace2 ";allocation-callback "widget" "GtkAllocation"\n") (let ((alien (gobject-alien widget)) (x (C-> GtkAllocation "GtkAllocation x")) (y (C-> GtkAllocation "GtkAllocation y")) (width (C-> GtkAllocation "GtkAllocation width")) (height (C-> GtkAllocation "GtkAllocation height")) (rect (fix-layout-geometry widget))) - (%trace "; Allocation: "width"x"height" to "widget"\n") + (%trace "; "width"x"height" to "widget"\n") (set-fix-rect! rect x y width height) (set-fix-rect-size! (fix-layout-view widget) width height) ;; For the random toolkit GtkWidget method too. @@ -291,7 +291,7 @@ USA. (define-generic fix-layout-realize-callback (layout)) (define-method fix-layout-realize-callback ((widget )) - (%trace ";((fix-layout-realize-callback ) "widget")...\n") + (%trace ";(fix-layout-realize-callback ) "widget"\n") (let ((geometry (fix-layout-geometry widget)) (attr (malloc (C-sizeof "GdkWindowAttr") '|GdkWindowAttr|)) (main-GdkWindow (fix-layout-window widget)) @@ -345,7 +345,7 @@ USA. (define (adjustments-callback widget hGtkAdjustment vGtkAdjustment) (%trace2 ";set-scroll-adjustments "widget " "hGtkAdjustment" "vGtkAdjustment"\n") - (%trace "; Adjustments:" + (%trace ";adjustments:" " 0x"(alien/address-string hGtkAdjustment) " 0x"(alien/address-string vGtkAdjustment)"\n") (connect-adjustment (fix-layout-hadjustment widget) hGtkAdjustment @@ -390,10 +390,10 @@ USA. (value (floor->exact (C-> (gobject-alien adjustment) "GtkAdjustment value")))) (cond ((eq? adjustment vadjustment) - (%trace2 "; Vadjustment to "value"\n") + (%trace2 ";vadjustment to "value"\n") (scroll widget (fix-rect-x window-extent) value)) ((eq? adjustment hadjustment) - (%trace2 "; Hadjustment to "value"\n") + (%trace2 ";hadjustment to "value"\n") (scroll widget value (fix-rect-y window-extent))) (else (warn "Unexpected adjustment:" adjustment)))))) @@ -430,9 +430,10 @@ USA. page-size step-incr page-incr))))) (define (event-callback layout GdkEvent) - (%trace2 ";event "layout" "GdkEvent"\n") + (%trace2 ";event "layout" "GdkEvent) (let ((type (C-> GdkEvent "GdkEvent any type"))) + (%trace2 " "(C-enum "GdkEventType" type)"\n") (if (int:= type (C-enum "GDK_EXPOSE")) (let ((window (C-> GdkEvent "GdkEvent any window")) (x (C-> GdkEvent "GdkEventExpose area x")) @@ -443,13 +444,12 @@ USA. (drawing (fix-layout-drawing layout)) (widget-window (fix-layout-window layout))) (cond ((not (alien=? window widget-window)) - (%trace "; Expose a strange window "window - " (not "widget-window").\n")) + (warn "Expose event on strange window:" window widget-window)) (drawing (let* ((view (fix-layout-view layout)) (offx (fix-rect-x view)) (offy (fix-rect-y view))) - (%trace2 "; Expose area "width"x"height" "x","y + (%trace2 ";expose area "width"x"height" "x","y " of "layout".\n") (drawing-expose drawing layout window (make-fix-rect @@ -840,11 +840,9 @@ USA. ;;; For draw-ink expose handlers (without-interrupts in gtk-thread). (define (with-gc options widget receiver) - (%trace2 ";(with-gc "options" "widget")") (if (pair? options) (let* ((alien.mask (malloc-gcvalues options)) (gc (gtk-gc-get widget alien.mask))) - (%trace2 " => "alien.mask", "gc"\n") (free (car alien.mask)) (receiver gc) (gtk-gc-release gc)) @@ -853,7 +851,6 @@ USA. (C-> gc "GtkStyle fg_gc" gc) (C-array-loc! gc "* GdkGC" (C-enum "GTK_STATE_NORMAL")) (C-> gc "* GdkGC" gc) - (%trace2 " => fg:"gc"\n") (receiver gc)))) (define (gtk-gc-get widget gcvalues.mask) @@ -968,7 +965,7 @@ USA. (define-method fix-ink-expose-callback ((ink ) widget window area) (declare (ignore area)) - (%trace2 "; (Re)Drawing "ink" on "widget".\n") + (%trace2 ";drawing "ink" on "widget"\n") (let ((view (fix-layout-view widget)) (vector (line-ink-vector ink))) (with-fix-rect @@ -1102,7 +1099,7 @@ USA. (define-method fix-ink-expose-callback ((ink ) widget window area) (declare (ignore area)) - (%trace2 "; (Re)Drawing "ink" on "widget".\n") + (%trace2 ";drawing "ink" on "widget"\n") (let ((view (fix-layout-view widget)) (rect (rectangle-ink-rect ink))) (with-fix-rect @@ -1236,7 +1233,7 @@ USA. (define-method fix-ink-expose-callback ((ink ) widget window area) (declare (ignore area)) - (%trace2 "; (Re)Drawing "ink" on "widget".\n") + (%trace2 ";drawing "ink" on "widget"\n") (let ((view (fix-layout-view widget)) (rect (arc-ink-rect ink))) (with-fix-rect @@ -1362,7 +1359,7 @@ USA. (define-method fix-ink-expose-callback ((ink ) widget window area) (declare (ignore area)) - (%trace2 "; (Re)Drawing "ink" on "widget".\n") + (%trace2 ";drawing "ink" on "widget"\n") (let ((view (fix-layout-view widget)) (rect (fix-ink-extent ink))) (let ((x (fix:- (fix-rect-x rect) (fix-rect-x view))) @@ -1547,7 +1544,7 @@ USA. (loader define standard initializer make-pixbuf-loader)) (define-method initialize-instance ((ink )) - (%trace ";((initialize-instance ) "ink")...\n") + (%trace ";(initialize-instance ) "ink"\n") (call-next-method ink) (let ((loader (image-ink-loader ink))) (set-pixbuf-loader-size-hook! loader (image-ink-size-prepared ink)) @@ -1587,7 +1584,7 @@ USA. unspecific)))) (define-method fix-ink-expose-callback ((ink ) widget window area) - (%trace2 "; (Re)Drawing "ink" on "widget".\n") + (%trace2 ";drawing "ink" on "widget"\n") (let ((pixbuf (let ((p (image-ink-pixbuf ink))) (if p (gobject-alien p) #f)))) @@ -1635,7 +1632,7 @@ USA. (define-method fix-ink-expose-callback ((ink ) widget window area) (declare (ignore area)) - (%trace2 "; (Re)Drawing "ink" on "widget".\n") + (%trace2 ";drawing "ink" on "widget"\n") (let ((alien (gobject-alien widget)) (view (fix-layout-view widget)) (extent (fix-ink-extent ink))) @@ -1697,7 +1694,7 @@ USA. #;(define-method fix-ink-expose-callback ((ink ) widget window area) (declare (ignore area)) - (%trace2 "; (Re)Drawing "ink" on "widget".\n") + (%trace2 ";drawing "ink" on "widget"\n") (let ((alien (gobject-alien widget)) (view (fix-layout-view widget)) (extent (fix-ink-extent ink))) diff --git a/src/gtk/swat.scm b/src/gtk/swat.scm index 6f5c3de9c..d1c0a5c2b 100644 --- a/src/gtk/swat.scm +++ b/src/gtk/swat.scm @@ -42,7 +42,7 @@ USA. (on-death define standard initial-value #f)) (define-method initialize-instance ((widget ) . args) - (%trace ";((initialize-instance ) "widget" "args")...\n") + (%trace ";(initialize-instance ) "widget" "args"\n") (apply call-next-method widget args) ;; Do NOT replace fix-layout's realize callback. (Add a method to ;; fix-layout-realize-callback instead [or support a more generic @@ -88,7 +88,7 @@ USA. ( )) (define-method initialize-instance ((frame )) - (%trace ";((initialize-instance ) "frame")...\n") + (%trace ";(initialize-instance ) "frame"\n") (call-next-method frame "") (gtk-container-add frame (gtk-label-new ""))) @@ -141,7 +141,7 @@ USA. (swat-handlers define standard initial-value '())) (define-method initialize-instance ((canvas ) width height) - (%trace ";((initialize-instance ) "canvas" "width" "height")...\n") + (%trace ";(initialize-instance ) "canvas" "width" "height"\n") (call-next-method canvas width height) (set-fix-layout-drawing! canvas (make-fix-drawing) 0 0)) @@ -1094,9 +1094,9 @@ USA. (let ((width (find-option options '-width #f)) (height (find-option options '-height #f))) (let ((canvas (make-swat-canvas width height))) - (%trace ";(make-canvas "options") configuring "canvas"\n") + (%trace ";make-canvas "options": configuring "canvas"\n") (widget-configure! canvas (delete-options! '(-width -height) options)) - (%trace ";(make-canvas "options") => "canvas"\n") + (%trace ";make-canvas "options": "canvas"\n") canvas))) (define (make-canvas-item-group canvas items)