Reformat trace messages some more.

diff --git a/src/gtk/fix-demo.scm b/src/gtk/fix-demo.scm
index 36fb6265dbfa3ff60fb805aa4a3ee445c9d3b037..c4d86577de46bad820925b0d981fd5ca2fe67ae6 100644 (file)
--- 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 cbc1d496a9cd4fc3ecb612377daea04d0f5f3e54..f2cd57d07f03089712e384dfb5ec616c5673ee4a 100644 (file)
--- 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 <fix-layout>))))
 
-  (%trace ";((initialize-instance <fix-layout>) "widget" "width" "height")...\n")
+  (%trace ";(initialize-instance <fix-layout>) "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 <fix-layout>))
-  (%trace ";((fix-layout-realize-callback <fix-layout>) "widget")...\n")
+  (%trace ";(fix-layout-realize-callback <fix-layout>) "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)))))
 \f
 (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 <line-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 <rectangle-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 <arc-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 <text-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 <image-ink>))
-  (%trace ";((initialize-instance <image-ink>) "ink")...\n")
+  (%trace ";(initialize-instance <image-ink>) "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 <image-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 <box-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 <hline-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 6f5c3de9c457e8af28aa333f89c5673df415766c..d1c0a5c2bd0b86a6e24a2b95f1ebd66c3083e739 100644 (file)
--- 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 <swat-widget>) . args)
-  (%trace ";((initialize-instance <swat-widget>) "widget" "args")...\n")
+  (%trace ";(initialize-instance <swat-widget>) "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.
     (<swat-widget> <gtk-frame>))
 
 (define-method initialize-instance ((frame <swat-label>))
-  (%trace ";((initialize-instance <swat-label>) "frame")...\n")
+  (%trace ";(initialize-instance <swat-label>) "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 <swat-canvas>) width height)
-  (%trace ";((initialize-instance <swat-canvas>) "canvas" "width" "height")...\n")
+  (%trace ";(initialize-instance <swat-canvas>) "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)