From: Matt Birkholz Date: Tue, 6 Sep 2011 01:06:15 +0000 (-0700) Subject: Use gtk-thread-running? and fix:quotient. Reindent some stuff. X-Git-Tag: mit-scheme-pucked-9.2.12~366^2~116 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6cc56351e7c9ab7044fa0df7e54e23d2f9c767e9;p=mit-scheme.git Use gtk-thread-running? and fix:quotient. Reindent some stuff. --- diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm index 80c2d26a7..13a0242f9 100644 --- a/src/gtk-screen/gtk-screen.scm +++ b/src/gtk-screen/gtk-screen.scm @@ -464,7 +464,7 @@ USA. (set! gtk-display-type (make-display-type 'GTK #t - gtk-screen-available? + gtk-thread-running? make-gtk-screen (lambda (screen) screen ;ignore @@ -473,11 +473,6 @@ USA. with-gtk-interrupts-enabled with-gtk-interrupts-disabled)) unspecific) - -(define (gtk-screen-available?) - ;; Perhaps (option-available? 'Gtk-Screen) would be more accurate... - (file-exists? (merge-pathnames "gtk-shim.so" - (system-library-directory-pathname)))) (define (update-widgets screen) (%trace "; update-widgets "screen"\n") @@ -780,7 +775,9 @@ USA. (set-simple-text-ink-text! ink widget "Initial override message.") (fix-drawing-add-ink! drawing ink) (let ((extent (fix-ink-extent ink))) - (set-fix-drawing-size! drawing (fix-rect-width extent) (fix-rect-height extent)))) + (set-fix-drawing-size! drawing + (fix-rect-width extent) + (fix-rect-height extent)))) (set-text-widget-override-drawing! widget drawing) (set-fix-layout-drawing! widget drawing 0 0)) (set-fix-layout-map-handler! widget map-handler) @@ -859,7 +856,9 @@ USA. ink widget "--------Initial mode line.--------------------------------") (fix-drawing-add-ink! drawing ink) (let ((extent (fix-ink-extent ink))) - (set-fix-drawing-size! drawing (fix-rect-width extent) (fix-rect-height extent)))) + (set-fix-drawing-size! drawing + (fix-rect-width extent) + (fix-rect-height extent)))) (set-fix-layout-drawing! widget drawing 0 0)) (set-fix-layout-map-handler! widget map-handler) (set-fix-layout-unmap-handler! widget unmap-handler) @@ -1022,8 +1021,7 @@ USA. (%trace "; no cursor window\n") (blink! screen #f)) (let ((widget (window-text-widget* window))) - (%trace "; cursor window: "window - " "(window-text-widget* window)"\n") + (%trace "; cursor window: "window" "widget"\n") (guarantee-text-widget widget 'update-blinking) (let ((cursor (text-widget-cursor-ink widget))) (if (not cursor) @@ -1098,7 +1096,7 @@ USA. (modeline (text-widget-modeline widget))) (cond ((not cursor) (let ((new (make-cursor-ink)) - (width (quotient (gtk-screen-char-width screen) 2)) + (width (fix:quotient (gtk-screen-char-width screen) 2)) (height (gtk-screen-line-height screen)) (space (gtk-screen-line-spacing screen)) (widgets (list widget))) @@ -1168,29 +1166,30 @@ USA. (let* ((text-ink (car (fix-drawing-display-list override)))) (set-simple-text-ink-text! text-ink widget message) (let ((e (fix-ink-extent text-ink))) - (set-fix-drawing-size! - override (fix-rect-width e) (fix-rect-height e)))) + (set-fix-drawing-size! override + (fix-rect-width e) + (fix-rect-height e)))) (if (not (eq? override drawing)) (let ((saved-pos (text-widget-text-pos widget)) (view (fix-layout-view widget))) (set-car! saved-pos (fix-rect-x view)) (set-cdr! saved-pos (fix-rect-y view)) - (%trace ";\t saving text position "saved-pos"\n") + (%trace ";\tsaving text position "saved-pos"\n") (set-fix-layout-drawing! widget override 0 0)) - (%trace ";\t override still up\n"))) + (%trace ";\toverride still up\n"))) (begin ;; ReDisplay text, and scroll to cursor. (if (not (eq? text drawing)) (let ((saved-pos (text-widget-text-pos widget))) - (%trace ";\t restoring "text" to "saved-pos"\n") + (%trace ";\trestoring "text" to "saved-pos"\n") (set-fix-layout-drawing! widget text (car saved-pos) (cdr saved-pos))) - (%trace ";\t text still up\n")) + (%trace ";\ttext still up\n")) (update-cursor window) (let ((extent (fix-ink-extent (text-widget-cursor-ink widget)))) - (%trace ";\t scrolling to "extent"\n") + (%trace ";\tscrolling to "extent"\n") (fix-layout-scroll-nw! widget extent) - (%trace ";\t view: "(fix-layout-view widget)"\n"))))))) + (%trace ";\tview: "(fix-layout-view widget)"\n"))))))) ;; This variable caches a modeline image buffer. A modeline update ;; hacks this buffer, then compares it to the string in the simple- @@ -1199,7 +1198,7 @@ USA. (define modeline-image "") (define (update-modeline window) - (%trace ";\tupdate-modeline "window"\n") + (%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. @@ -1227,10 +1226,10 @@ USA. (let ((copy (string-copy modeline-image))) (set-simple-text-ink-text! ink widget copy) ;; Ensure that text-ink is wider than widget??? - (%trace ";\t updated "modeline": \""copy"\"\n")) - (%trace ";\t unchanged "modeline"\n")))) - (%trace ";\t no modeline\n"))) - (%trace ";\t no widget!\n")))) + (%trace ";\tupdated "modeline": \""copy"\"\n")) + (%trace ";\tunchanged "modeline"\n")))) + (%trace ";\tno modeline\n"))) + (%trace ";\tno widget!\n")))) (define (update-name screen) (let ((name (frame-name screen)) @@ -1800,11 +1799,11 @@ USA. (fix:< end-index change-start-index)))) (define (update-cursor window) - (%trace "; update-cursor "window"\n") + (%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 "; cursor: "cursor"\n") + (%trace ";\t cursor: "cursor"\n") (define (in-change-region? point) (let ((group (mark-group point)) @@ -1818,23 +1817,23 @@ USA. (cond ((and cursor-point (mark= cursor-point window-point) (not (in-change-region? cursor-point))) - (%trace "; unchanged at "(mark-index cursor-point) - " = "(mark-index window-point)" (" - (and (in-change-region? cursor-point) #t)")\n")) + (%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 "; in change region" - " at "(mark-index cursor-point) - " ("(mark-index window-point)")\n") + (%trace ";\t in change region" + " at "(mark-index cursor-point) + " ("(mark-index window-point)")\n") (redraw-cursor window window-point)) (cursor-point - (%trace "; changed from "(mark-index cursor-point) - " to "(mark-index window-point)"\n") + (%trace ";\t changed from "(mark-index cursor-point) + " to "(mark-index window-point)"\n") (redraw-cursor window window-point)) (else - (%trace "; new at "(mark-index window-point)"\n") + (%trace ";\t new at "(mark-index window-point)"\n") (set-cursor-ink-point! cursor - (mark-permanent-copy window-point)) + (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 @@ -1851,17 +1850,17 @@ USA. (visible! cursor #t))))))) (define (redraw-cursor window point) - (%trace "; redraw-cursor at "point" in "window"\n") + (%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))) - (%trace "; found line: "line"\n") + (%trace ";\t\tfound line: "line"\n") (define-integrable (main) (cond ((not cursor) - (%trace "; no widget for "window"\n") + (%trace ";\t\tno widget for "window"\n") #t) ;; When beyond a final newline, position cursor where next line @@ -1872,7 +1871,7 @@ USA. (let* ((extent (fix-ink-extent line)) (line-spacing (gtk-screen-line-spacing screen)) (y (fix:+ (fix-rect-max-y extent) line-spacing))) - (%trace "; redraw-cursor beyond final newline, at 0,"y"\n") + (%trace ";\t\tredraw-cursor beyond final newline, at 0,"y"\n") (set-half-box! 0 y))) ;; Else at end (or inside) found line. @@ -1885,13 +1884,13 @@ USA. (lambda (xG yG widthG heightG) (let ((log-x (fix:+ xG (fix-rect-x extent))) (log-y (fix:+ yG (fix-rect-y extent)))) - (%trace "; redraw-cursor: index-to-pos: "column + (%trace ";\t\tredraw-cursor: index-to-pos: "column " => "log-x","log-y" "widthG"x"heightG" - "layout"\n") (set-box! log-x log-y widthG heightG)))))) ;; Else... a half-char box for the empty buffer. (else - (%trace "; no line found: half box at 0,0\n") + (%trace ";\t\tno line found: half box at 0,0\n") (set-half-box! 0 0)))) (define (set-half-box! x y)