gtk-screen: Remove without-interruption debugging aids.

diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg
index ba394efd671806859dec1f672289a0a7989ad39c..d9716663774a2cb854938c6e3184430f65b587f3 100644 (file)
--- a/src/gtk-screen/gtk-screen.pkg
+++ b/src/gtk-screen/gtk-screen.pkg
@@ -105,8 +105,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
          set-fix-rect-size! set-fix-rect-position!
          fix-rect-intersect? fix-rect-union!)
   (import (glib)
-         assert-glib-locked
          with-glib-lock without-glib-lock
+         assert-glib-locked assert-without-interruption
          gobject-alien gobject-unref!)
   (import (gtk)
          gtk-css-provider-load-from-data

diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm
index c4a1cc32b269b9ce7cd5c59be744f48ee15cdc1f..1c5a68ab0448b29cc88f54be426208a5203b87b5 100644 (file)
--- a/src/gtk-screen/gtk-screen.scm
+++ b/src/gtk-screen/gtk-screen.scm
@@ -197,7 +197,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define-method set-screen-size! ((screen <gtk-screen>) x-size y-size)
   (%trace "; (set-screen-size! <gtk-screen>) "screen" "x-size"x"y-size"\n")
-  (%without-interruption
+  (without-interruption
    (lambda ()
      (set-screen-x-size! screen x-size)
      (set-screen-y-size! screen y-size)
@@ -216,7 +216,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
    (lambda ()
      (%trace2 ";blinking started on "screen"\n")
      (let loop ()
-       (%without-interruption
+       (without-interruption
        (lambda ()
          (let ((cursor (gtk-screen-blinking screen)))
            (cond ((not cursor)
@@ -269,14 +269,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (gtk-widget-destroy (gtk-screen-toplevel screen))
   (pango-font-description-free (gtk-screen-font screen)))
 
-(define %glib-mutex (access glib-mutex (->environment '(glib))))
 (define-method screen-modeline-event! ((screen <gtk-screen>) window type)
   (%trace "; screen-modeline-event! "screen" "window" "type"\n")
-  ;;(assert-glib-locked '(screen-modeline-event! <gtk-screen>))
-  (if (not (eq? (current-thread) (thread-mutex-owner %glib-mutex)))
-      (begin
-       (outf-error "Yo!\n")
-       (error "yo:" screen window type)))
+  (assert-glib-locked '(screen-modeline-event! <gtk-screen>))
   unspecific)
 \f
 ;;; These scrolling procedures are for editor commands (not
@@ -896,8 +891,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                           make-gtk-screen
                           get-gtk-input-operations
                           with-gtk-grabbed
-                          %with-interruption
-                          %without-interruption))
+                          with-interruption
+                          without-interruption))
   unspecific)
 
 (define (spawn-edit . args)
@@ -2262,7 +2257,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (define (remove-line line)
       (mark-temporary! (line-ink-start line))
       (mark-temporary! (line-ink-end line))
-      (%without-interruption
+      (without-interruption
        (lambda ()
         (clear-cached-pango-layout line)
         (fix-ink-remove! line))))
@@ -2311,13 +2306,13 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
   (%trace3 ";\t      redraw-line! "line" from "(line-ink-start line)
           " ("x","y") with "pango-layout"\n")
-  (%without-interruption
+  (without-interruption
    (lambda ()
      (%layout-line! line pango-layout)))
   (pango-layout-get-pixel-extents
    pango-layout
    (lambda (width height)
-     (%without-interruption
+     (without-interruption
       (lambda ()
        (clear-cached-pango-layout line)
        (%trace3 ";\t        erasing "(fix-ink-extent line)"\n")
@@ -2639,7 +2634,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (visible! cursor visible?)
   ;; Atomically sets cursor-ink-visible? and fix-ink-widgets.
-  (%without-interruption
+  (without-interruption
    (lambda ()
      (if visible?
         (if (not (cursor-ink-visible? cursor))
@@ -2654,7 +2649,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (blink! screen cursor)
   ;; Atomically sets CURSOR up to blink.  CURSOR may be #f, in which
   ;; case blinking will pause.
-  (%without-interruption
+  (without-interruption
    (lambda ()
      (let ((old (gtk-screen-blinking screen)))
        (if cursor
@@ -2692,42 +2687,15 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (<rectangle-ink>)
   (text-ink define standard))
 \f
-(define-integrable %without-interruption without-interruption)
-#;(define (%without-interruption thunk)
-  (%trace "; %without-interruption "thunk"\n")
-  (%assert-with-interruption '%without-interruption)
-  (let ((v (without-interruption thunk)))
-    (%trace "; %without-interruption "thunk" => "v"\n")
-    v))
-
-(define (%with-interruption thunk)
-  (%trace "; %with-interruption "thunk"\n")
-  (%assert-without-interruption '%with-interruption)
+(define (with-interruption thunk)
+  (%trace "; with-interruption "thunk"\n")
+  (assert-without-interruption 'with-interruption)
   (unblock-thread-events)
   (let ((v (thunk)))
-    (%trace "; %with-interruption "thunk" => "v"\n")
+    (%trace "; with-interruption "thunk" => "v"\n")
     (block-thread-events)
     v))
 
-#;(begin
-  (define-integrable (%assert-without-interruption operator)
-    (declare (ignore operator))
-    #f)
-  (define-integrable (%assert-with-interruption operator)
-    (declare (ignore operator))
-    #f))
-
-(begin
-  (define %get-thread-event-block
-    (access get-thread-event-block (->environment '(runtime thread))))
-
-  (define-integrable (%assert-without-interruption operator)
-    (if (not (%get-thread-event-block))
-       (outf-error ";not without interruption: "operator"\n")))
-  (define-integrable (%assert-with-interruption operator)
-    (if (%get-thread-event-block)
-       (outf-error ";not with interruption: "operator"\n"))))
-
 (define %trace? #f)
 
 (define-syntax %trace