gtk-screen: Expose handler must not layout-line! during redraw-line!.

Renamed %layout-line! to emphasize that it should not be used without
interlocking with the expose handler, i.e. without without-interrupts.
Most calls are serialized by edwin-thread but the expose handler can
intervene (and likely WILL when running interpreted s-code), so all
calls should be without-interrupts, for now.

Punt exposing uninitialized lines.

Simplify the destruction of override text (a simple-text-ink) AND
ensure that it does not call %layout-line! via text-ink-pango-layout.

diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg
index 5553ca097fcbd0cd8472f28707d866f6ce90d9aa..ff999951b042c2c24fd1bcbe9c2f4922df0ae306 100644 (file)
--- a/src/gtk-screen/gtk-screen.pkg
+++ b/src/gtk-screen/gtk-screen.pkg
@@ -95,6 +95,7 @@ USA.
          fix-drawing-extent
          fix-ink-extent
          text-ink-pango-layout
+         simple-text-ink-pango-layout
 
          make-fix-rect copy-fix-rect fix-rect-string
          fix-rect-x fix-rect-y fix-rect-width fix-rect-height

diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm
index d958a19c2fe73d2e5bab60b460d1b8e80d131e4a..560e60bb3a3d25857f22e976391aa626af2526c0 100644 (file)
--- a/src/gtk-screen/gtk-screen.scm
+++ b/src/gtk-screen/gtk-screen.scm
@@ -1052,11 +1052,13 @@ USA.
   (let ((cursor (text-widget-cursor-ink widget)))
     (if cursor
        (fix-ink-remove! cursor)))
-  (and-let* ((drawing (text-widget-override-drawing widget))
-            (ink (car (fix-drawing-display-list drawing)))
-            ((text-ink? ink))
-            (layout (text-ink-pango-layout ink)))
-    (gobject-unref! layout))
+  (let ((drawing (text-widget-override-drawing widget)))
+    (and drawing
+        (let ((ink (car (fix-drawing-display-list drawing))))
+          (and (simple-text-ink? ink)
+               (let ((layout (simple-text-ink-pango-layout ink)))
+                 (and layout
+                      (gobject-unref! layout)))))))
   unspecific)
 
 (define-method fix-widget-realize-callback ((widget <text-widget>))
@@ -2113,7 +2115,9 @@ USA.
 
   (%trace3 ";\t      redraw-line! "line" from "(line-ink-start line)
           " ("x","y") with "pango-layout"\n")
-  (layout-line! line pango-layout)
+  (without-interrupts
+   (lambda ()
+     (%layout-line! line pango-layout)))
   (pango-layout-get-pixel-extents
    pango-layout
    (lambda (width height)
@@ -2130,9 +2134,10 @@ USA.
 
 (define image-buffer-size (* 50 1024))
 (define image-buffer (string-allocate image-buffer-size))
-(define-integrable image-results substring-image-results)
 
-(define (layout-line! line pango-layout)
+(define (%layout-line! line pango-layout)
+  ;; This must run without-interrupts because it uses image-buffer.
+  ;; An async expose event might otherwise fubar it.
   (let* ((drawing (fix-ink-drawing line))
         (buffer (buffer-drawing-buffer drawing))
         (group (buffer-group buffer))
@@ -2147,7 +2152,7 @@ USA.
      (buffer-drawing-char-image-strings drawing)
      (lambda (text-index image-index)
        (if (fix:= image-index max-image-size)
-          (warn ";layout-line!: long paragraph"))
+          (warn ";%layout-line!: long paragraph"))
        (set-mark-index! (line-ink-end line) text-index)
 
        ;; Run Pango on buffer.
@@ -2415,22 +2420,27 @@ USA.
       layout))
 
   ;; Do not (call-next-method ink).  There is no <text-ink> method.
-  (if (unchanged? ink)
-      (or (line-ink-cached-pango-layout ink)
-         ;; When executed by the expose handler, this already runs
-         ;; without-interrupts.  However there are other places
-         ;; (e.g. redraw-cursor) where this could be called.  Ensure
-         ;; that the async. expose handlers do not start frobbing the
-         ;; pango-layout cache until we are done here.
-         (without-interrupts
-          (lambda ()
-            (let ((layout (or (salvage-pango-layout ink)
-                              (cache-pango-layout ink))))
-              (layout-line! ink layout)
-              layout))))
-      (begin
-       (outf-error ";text-ink-pango-layout: punted "ink"\n")
-       #f)))
+  (cond ((fix:zero? (fix-rect-height (fix-ink-extent ink)))
+        ;; An expose event can arrive between adding a new line to
+        ;; the drawing and laying it out (see add-line in
+        ;; update-drawing).  If the dimensions (any) are zero, punt.
+        #f)
+       ((unchanged? ink)
+        (or (line-ink-cached-pango-layout ink)
+            ;; When executed by the expose handler, this already runs
+            ;; without-interrupts.  However there are other places
+            ;; (e.g. redraw-cursor) where this could be called.  Ensure
+            ;; that the async. expose handlers do not start frobbing the
+            ;; pango-layout cache until we are done here.
+            (without-interrupts
+             (lambda ()
+               (let ((layout (or (salvage-pango-layout ink)
+                                 (cache-pango-layout ink))))
+                 (%layout-line! ink layout)
+                 layout)))))
+       (else
+        (outf-error ";text-ink-pango-layout: punted "ink"\n")
+        #f)))
 
 (define (clear-cached-pango-layout line)
   ;; This probably aught to be done without-interrupts, since it