From: Matt Birkholz Date: Thu, 28 Apr 2016 22:47:58 +0000 (-0700) Subject: gtk/swat.scm: fiddle %trace messages X-Git-Tag: mit-scheme-pucked-9.2.12~340 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=befca8d21178f61e7036e560fb14ee8b8b67dd10;p=mit-scheme.git gtk/swat.scm: fiddle %trace messages --- diff --git a/src/gtk/swat.scm b/src/gtk/swat.scm index 4bbe27cff..7a3069a85 100644 --- 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 ) . args) - (%trace ";(initialize-instance ) "widget" "args"\n") + (%trace "(initialize-instance ) "widget" "args) (apply call-next-method widget args) ;; Connect to the "realize" signal to apply options like colors. ;; NOT replacing '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 ( (constructor ())) @@ -88,7 +88,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. ( )) (define-method initialize-instance ((frame )) - (%trace ";(initialize-instance ) "frame"\n") + (%trace "(initialize-instance ) "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 ) width height) - (%trace ";(initialize-instance ) "canvas" "width"x"height"\n") + (%trace "(initialize-instance ) "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 () @@ -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