(set! gtk-display-type
(make-display-type 'GTK
#t
- gtk-screen-available?
+ gtk-thread-running?
make-gtk-screen
(lambda (screen)
screen ;ignore
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))))
\f
(define (update-widgets screen)
(%trace "; update-widgets "screen"\n")
(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)
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)
(%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)
(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)))
(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-
(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.
(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))
(fix:< end-index change-start-index))))
\f
(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))
(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
(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
(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.
(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)
projects / mit-scheme.git / commitdiff