From: Matt Birkholz Date: Tue, 6 Sep 2011 01:22:01 +0000 (-0700) Subject: Pass the text-widget to update-modeline, update-cursor, redraw-cursor. X-Git-Tag: mit-scheme-pucked-9.2.12~366^2~114 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=24e6f83a98208e1632a7ab130a7a6378909b499d;p=mit-scheme.git 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 a490aaa6b..22d2359e8 100644 --- 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 ) window type) (%trace "; screen-modeline-event! "screen" "window" "type"\n") - (update-modeline window)) + (let ((widget (window-text-widget* window))) + (and widget (update-modeline widget)))) ;;; 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)))) -(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)