Pass the text-widget to update-modeline, update-cursor, redraw-cursor.

diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm
index a490aaa6b123ae3267831cfffb5c90e51bb786aa..22d2359e892bca15a0d730d8d08d925a3d960756 100644 (file)
--- a/src/gtk-screen/gtk-screen.scm
+++ b/src/gtk-screen/gtk-screen.scm
@@ -292,7 +292,8 @@ USA.
 
 (define-method screen-modeline-event! ((screen <gtk-screen>) window type)
   (%trace "; screen-modeline-event! "screen" "window" "type"\n")
-  (update-modeline window))
+  (let ((widget (window-text-widget* window)))
+    (and widget (update-modeline widget))))
 \f
 ;;; Event Handling
 
@@ -1152,7 +1153,7 @@ USA.
 (define (update-window widget)
   (%trace ";     update-window "widget"\n")
   (let ((window (text-widget-buffer-frame widget)))
-    (update-modeline window)
+    (update-modeline widget)
     (let ((message (window-override-message window))
          (drawing (fix-layout-drawing widget)) ; current drawing: either...
          (override (text-widget-override-drawing widget)) ; this...
@@ -1185,7 +1186,7 @@ USA.
                  (set-fix-layout-drawing! widget text
                                           (car saved-pos) (cdr saved-pos)))
                (%trace ";\ttext still up\n"))
-           (update-cursor window)
+           (update-cursor widget)
            (let ((extent (fix-ink-extent (text-widget-cursor-ink widget))))
              (%trace ";\tscrolling to "extent"\n")
              (fix-layout-scroll-nw! widget extent)
@@ -1197,12 +1198,12 @@ USA.
 ;; thread should be the only thread accessing this resource.
 (define modeline-image "")
 
-(define (update-modeline window)
-  (%trace ";     update-modeline "window"\n")
-  (let ((widget (window-text-widget* window))
-       ;; Add a few columns so the text runs past scrollbars and
-       ;; whatnot, off the right side of the widget.
-       (x-size (+ 5 (window-x-size window))))
+(define (update-modeline widget)
+  (%trace ";     update-modeline "widget"\n")
+  (let* ((window (text-widget-buffer-frame widget))
+        ;; Add a few columns so the text runs past scrollbars and
+        ;; whatnot, off the right side of the widget.
+        (x-size (+ 5 (window-x-size window))))
     (if widget
        (let ((modeline (text-widget-modeline widget)))
          (if modeline
@@ -1397,7 +1398,8 @@ USA.
            (set-fix-drawing-size! drawing
                                   (fix-rect-max-x drawing-extent)
                                   (fix-rect-max-y drawing-extent)))
-         (set-fix-drawing-size! drawing 0 0)))
+         (set-fix-drawing-size! drawing 0 0))
+      (%trace ";\tnew drawing extent: "(fix-drawing-extent drawing)"\n"))
 
     (define (redraw-start lines start num y receiver)
       (%trace3 ";         redraw-start "lines" "start" "num" "y"\n")
@@ -1798,63 +1800,63 @@ USA.
 
      (fix:< end-index change-start-index))))
 \f
-(define (update-cursor window)
-  (%trace ";\t  update-cursor "window"\n")
-  (let ((widget (window-text-widget* window)))
-    (if (not widget) (error "No widget for window" window))
-    (let ((cursor (text-widget-cursor-ink widget)))
-      (%trace ";\t    cursor: "cursor"\n")
-
-      (define (in-change-region? point)
-       (let ((group (mark-group point))
-             (index (mark-index point)))
-         (let ((start (group-start-changes-index group))
-               (end (group-end-changes-index group)))
-           (and start (fix:<= start index) (fix:<= index end)))))
-
-      (let ((window-point (window-point window))
-           (cursor-point (cursor-ink-point cursor)))
-       (cond ((and cursor-point
-                   (mark= cursor-point window-point)
-                   (not (in-change-region? cursor-point)))
-              (%trace ";\t    unchanged at "(mark-index cursor-point)
-                      " = "(mark-index window-point)" ("
-                      (and (in-change-region? cursor-point) #t)")\n"))
-             ((and cursor-point
-                   (mark= cursor-point window-point))
-              (%trace ";\t    in change region"
-                      " at "(mark-index cursor-point)
-                      " ("(mark-index window-point)")\n")
-              (redraw-cursor window window-point))
-             (cursor-point
-              (%trace ";\t    changed from "(mark-index cursor-point)
-                      " to "(mark-index window-point)"\n")
-              (redraw-cursor window window-point))
-             (else
-              (%trace ";\t    new at "(mark-index window-point)"\n")
-              (set-cursor-ink-point! cursor
-                                     (mark-permanent-copy window-point))
-              (redraw-cursor window window-point))))
-      ;; Get cursor appearance right per current mode.  An active
-      ;; minibuffer looks selected, else invisible.  An active buffer
-      ;; looks selected, else visible.
-      (let ((selected (screen-cursor-window (window-screen window))))
-       (cond ((eq? window selected)
-              (set-box-ink-shadow! cursor 'etched-in)
-              (visible! cursor #t))
-             ((minibuffer-widget? widget)
-              (set-box-ink-shadow! cursor 'etched-out)
-              (visible! cursor #f))
-             (else ;; text widget
-              (set-box-ink-shadow! cursor 'etched-out)
-              (visible! cursor #t)))))))
-
-(define (redraw-cursor window point)
-  (%trace ";\t      redraw-cursor at "point" in "window"\n")
-  (let ((screen (window-screen window))
-       (group (mark-group point))
-       (cursor (window-cursor-ink* window))
-       (line (find-line window point)))
+(define (update-cursor widget)
+  (%trace ";\t  update-cursor "widget"\n")
+  (let ((window (text-widget-buffer-frame widget))
+       (cursor (text-widget-cursor-ink widget)))
+    (%trace ";\t    cursor: "cursor"\n")
+
+    (define (in-change-region? point)
+      (let ((group (mark-group point))
+           (index (mark-index point)))
+       (let ((start (group-start-changes-index group))
+             (end (group-end-changes-index group)))
+         (and start (fix:<= start index) (fix:<= index end)))))
+
+    (let ((window-point (window-point window))
+         (cursor-point (cursor-ink-point cursor)))
+      (cond ((and cursor-point
+                 (mark= cursor-point window-point)
+                 (not (in-change-region? cursor-point)))
+            (%trace ";\t    unchanged at "(mark-index cursor-point)
+                    " = "(mark-index window-point)" ("
+                    (and (in-change-region? cursor-point) #t)")\n"))
+           ((and cursor-point
+                 (mark= cursor-point window-point))
+            (%trace ";\t    in change region"
+                    " at "(mark-index cursor-point)
+                    " ("(mark-index window-point)")\n")
+            (redraw-cursor widget window-point))
+           (cursor-point
+            (%trace ";\t    changed from "(mark-index cursor-point)
+                    " to "(mark-index window-point)"\n")
+            (redraw-cursor widget window-point))
+           (else
+            (%trace ";\t    new at "(mark-index window-point)"\n")
+            (set-cursor-ink-point! cursor
+                                   (mark-permanent-copy window-point))
+            (redraw-cursor widget window-point))))
+    ;; Get cursor appearance right per current mode.  An active
+    ;; minibuffer looks selected, else invisible.  An active buffer
+    ;; looks selected, else visible.
+    (let ((selected (screen-cursor-window (window-screen window))))
+      (cond ((eq? window selected)
+            (set-box-ink-shadow! cursor 'etched-in)
+            (visible! cursor #t))
+           ((minibuffer-widget? widget)
+            (set-box-ink-shadow! cursor 'etched-out)
+            (visible! cursor #f))
+           (else ;; text widget
+            (set-box-ink-shadow! cursor 'etched-out)
+            (visible! cursor #t))))))
+
+(define (redraw-cursor widget point)
+  (%trace ";\t      redraw-cursor at "point" in "widget"\n")
+  (let* ((window (text-widget-buffer-frame widget))
+        (screen (window-screen window))
+        (cursor (text-widget-cursor-ink widget))
+        (line (find-line window point))
+        (group (mark-group point)))
     (%trace ";\t\tfound line: "line"\n")
 
     (define-integrable (main)