From a14876da99913c555ed3d07b8c2155df0391adbb Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Sun, 18 Mar 2018 13:53:14 -0700 Subject: [PATCH] gtk-screen: Remove without-interruption debugging aids. --- src/gtk-screen/gtk-screen.pkg | 2 +- src/gtk-screen/gtk-screen.scm | 60 ++++++++--------------------------- 2 files changed, 15 insertions(+), 47 deletions(-) diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg index ba394efd6..d97166637 100644 --- 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 c4a1cc32b..1c5a68ab0 100644 --- 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 ) x-size y-size) (%trace "; (set-screen-size! ) "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 ) window type) (%trace "; screen-modeline-event! "screen" "window" "type"\n") - ;;(assert-glib-locked '(screen-modeline-event! )) - (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! )) unspecific) ;;; 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. () (text-ink define standard)) -(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 -- 2.25.1