gtk/swat.scm: fiddle %trace messages

diff --git a/src/gtk/swat.scm b/src/gtk/swat.scm
index 4bbe27cffb527210e1e36660cc2e2a6430de98d1..7a3069a85d575a56a5c168ecffe9fde9a3afe786 100644 (file)
--- a/src/gtk/swat.scm
+++ b/src/gtk/swat.scm
@@ -42,7 +42,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, 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)
   (apply call-next-method widget args)
   ;; Connect to the "realize" signal to apply options like colors.
   ;; NOT replacing <fix-widget>'s realize callback; the
@@ -59,7 +59,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                       on-death)))))
     (if on-death
        (begin
-         (%trace ";on-death "object": "on-death"\n")
+         (%trace "on-death "object": "on-death)
          ((cdr on-death))))))
 
 (define-class (<swat-button> (constructor ()))
@@ -88,7 +88,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, 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)
   (call-next-method frame "")
   (gtk-container-add frame (gtk-label-new "")))
 
@@ -141,7 +141,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (swat-handlers define standard initial-value '()))
 
 (define-method initialize-instance ((canvas <swat-canvas>) width height)
-  (%trace ";(initialize-instance <swat-canvas>) "canvas" "width"x"height"\n")
+  (%trace "(initialize-instance <swat-canvas>) "canvas" "width"x"height)
   (call-next-method canvas width height '())
   (set-fix-layout-drawing! canvas (make-fix-drawing) 0 0))
 
@@ -163,15 +163,15 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
       (set-fix-widget-button-handler!
        canvas type
        (named-lambda (canvas-button-handler canvas type button modifiers x y)
-        (%trace ";canvas-button-handler "type" "button" "modifiers
-                " "x","y" "canvas"\n")
+        (%trace "canvas-button-handler "type" "button" "modifiers
+                " "x","y" "canvas)
         (handle-canvas-event canvas
                              (append! (list type button) modifiers) x y))))
     '(press release double-press triple-press))
   (set-fix-widget-motion-handler!
    canvas
    (named-lambda (canvas-motion-handler canvas modifiers x y)
-     (%trace2 ";canvas-motion-handler "modifiers" "x","y" "canvas"\n")
+     (%trace2 "canvas-motion-handler "modifiers" "x","y" "canvas)
      (handle-canvas-event canvas (cons 'motion modifiers) x y))))
 
 (define-class <swat-ink> (<fix-ink>)
@@ -353,7 +353,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 ;;; swat-thread (which can sleep).
 
 (define (handle-canvas-event canvas event window-x window-y)
-  (%trace2 ";  handle-canvas-event "event" "window-x","window-y" "canvas"\n")
+  (%trace2 "handle-canvas-event "event" "window-x","window-y" "canvas)
   (let* ((view (fix-layout-view canvas))
         (x (fix:+ window-x (fix-rect-x view)))
         (y (fix:+ window-y (fix-rect-y view))))
@@ -372,7 +372,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (create-thread
    #f
    (lambda ()
-     (%trace ";swat-thread: "(current-thread)"\n")
+     (%trace "thread: "(current-thread))
 
      (let main ()
 
@@ -408,37 +408,40 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                         (handle event)))))))))
          (else
           (handle event)))))
-     (%trace ";swat-thread: done\n")
+     (%trace "thread done")
      (stop-current-thread))))
 
 (define (handle-event key canvas x y)
   (or (let* ((handlers (swat-canvas-swat-handlers canvas))
             (entry (assoc key handlers)))
-       (%trace ";    Canvas: "entry"\n")
+       (%trace2 "handle-event canvas: "entry)
        (and entry ((cdr entry) canvas x y)))
       (let ((items (pick-list canvas x y)))
-       (%trace ";    Pick list: "items"\n")
+       (%trace2 "handle-event pick list: "items)
        (find (lambda (item)
                (let* ((handlers (swat-ink-swat-handlers item))
                       (entry (assoc key handlers)))
-                 (%trace ";    "entry" "item"\n")
+                 (if entry
+                     (%trace "handle-event "entry" on "item)
+                     (%trace2 "handle-event #f on "item))
                  (and entry ((cdr entry) canvas x y))))
              items))))
 
 (define (pick-list canvas x y)
-  (%trace2 ";      pick-list "x","y" "canvas"\n")
+  (%trace2 "pick-list "x","y" "canvas)
   (let loop ((items (fix-drawing-display-list (fix-layout-drawing canvas)))
             (picks '()))
     (if (pair? items)
        (loop (cdr items)
              (let ((item (car items)))
-               (if (not (fix-ink-in-widget? item canvas))
-                   (%trace2 ";\t"item" not in "canvas"\n")
-                   (begin
-                     (%trace2 ";\t"x","y" in "item" ("(fix-ink-extent item)")? ")
-                     (if (point-in-fix-rect? x y (fix-ink-extent item))
-                         (%trace2 "yes!\n")
-                         (%trace2 "no\n"))))
+               (if %trace2?
+                   (if (not (fix-ink-in-widget? item canvas))
+                       (%trace2 item" not in "canvas)
+                       (let ((extent (fix-ink-extent item)))
+                         (if (point-in-fix-rect? x y extent)
+                             (%trace2 item" ("extent") contains "x","y)
+                             (%trace2 item" ("extent") does NOT contain "x","y)
+                             ))))
                (if (and (fix-ink-in-widget? item canvas)
                         (point-in-fix-rect? x y (fix-ink-extent item)))
                    (cons item
@@ -674,7 +677,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (make-label-frobbery label)
   (named-lambda (label-frobbery value)
-    (%trace ";label-frobbage "label" "value"\n")
+    (%trace "label-frobbage "label" "value)
     (if (string? value)
        (gtk-label-set-text (gtk-bin-child label) value)
        (warn "Bogus text for swat-label frobbery:" value label))))
@@ -1027,7 +1030,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
    (create-thread
     #f
     (lambda ()
-      (%trace ";after-delay "seconds", sleeping "(current-thread)"\n")
+      (%trace "after-delay "seconds", sleeping "(current-thread))
       (sleep-current-thread (* seconds 1000))
       (thunk)
       (stop-current-thread)))))
@@ -1105,7 +1108,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (make-checkbutton-frobbery button)
   (named-lambda (checkbutton-frobbery value)
-    (%trace ";checkbutton-frobbery: setting "button" to "value"\n")
+    (%trace "checkbutton-frobbery: setting "button" to "value)
     (gtk-check-button-set-active button value)))
 
 (define (checkbutton-toggled-callback button)
@@ -1115,15 +1118,15 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (let ((state (gtk-check-button-get-active button)))
          (if variable
              (begin
-               (%trace ";checkbutton-toggled-callback:"
-                       " setting "variable" to "state" for "button"\n")
+               (%trace "checkbutton-toggled-callback:"
+                       " setting "variable" to "state" for "button)
                (frob-active-variable! variable state)))
          (if callback
              (begin
-               (%trace ";checkbutton-toggled-callback:"
-                       " calling "callback" for "button"\n")
+               (%trace "checkbutton-toggled-callback:"
+                       " calling "callback" for "button)
                (callback))))
-       (%trace ";checkbutton-toggled-callback: noop\n"))))
+       (%trace "checkbutton-toggled-callback: noop"))))
 
 (define (checkbutton-variable-on? active)
   (active-variable-value active))
@@ -1159,9 +1162,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, 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)
       (widget-configure! canvas (delete-options! '(-width -height) options))
-      (%trace ";make-canvas "options": "canvas"\n")
+      (%trace "make-canvas "options": "canvas)
       canvas)))
 
 (define (make-canvas-item-group canvas items)
@@ -1290,13 +1293,13 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define-syntax %trace
   (syntax-rules ()
     ((_ ARGS ...)
-     (if %trace? (outf-error ARGS ...)))))
+     (if %trace? (outf-error "; swat: " ARGS ... "\n")))))
 
 (define %trace2? #f)
 
 (define-syntax %trace2
   (syntax-rules ()
     ((_ ARGS ...)
-     (if %trace2? (outf-error ARGS ...)))))
+     (if %trace2? (outf-error "; swat: " ARGS ... "\n")))))
 
 (initialize-package!)
\ No newline at end of file