;; allows most expose events to find exposed line-inks ready with a
;; PangoLayout to paint. As lines scroll into view, new PangoLayouts
;; are allocated (or stolen), and the buffer text is re-imaged,
-;; styled, and relayed-out just as when originally drawn. Sometimes,
+;; styled, and re-layed-out just as when originally drawn. Sometimes,
;; however, the original buffer text is NOT available.
;;
-;; When expose events arrive SYNCHRONOUSLY, during the Read part of
-;; the editor command loop, the expose event handler can always
-;; re-construct a line from the original buffer text.
+;; Expose events arrive ASYNCHRONOUSLY, and may find that a line's
+;; text has changed. The line may extend into (or just touch!) a
+;; buffer's change region. The original buffer text is no longer
+;; available, so the original PangoLayout cannot be re-constructed.
+;; The event handler must PUNT, and leave the line blank. (It will
+;; have been cleared to the background color.)
;;
-;; When expose events arrive ASYNCHRONOUSLY, during the Eval or
-;; Redisplay parts of the editor command loop, buffers can have
-;; non-empty change regions. The event handler may find that the
-;; original buffer text is no longer available. It has been modified
-;; and thus the original PangoLayout cannot be re-constructed. The
-;; event handler must punt, and leave the line blank. (It will have
-;; been cleared to the background color.)
+;; To ensure that lines can be exposed as soon as they are re-drawn,
+;; each buffer drawing keeps an "update region" that it narrows as it
+;; redraws. The expose handlers refer to THIS change region, when
+;; available (during Redisplay), rather than the buffer's change
+;; region. Narrowing a buffer-drawing's update region BEFORE
+;; redrawing lines ensures that the resulting expose events will not
+;; be punted.
;;
-;; These punted exposures should be infrequent. Exposures generated by
-;; Scheme's Redisplay process will hopefully be handled synchronously
-;; -- batched up until the final gdk_window_process_updates.
-;; Exposures by other means are rare. The window manager may
-;; restack windows. An application may close a window. Each of
-;; these would have to occur during the tiny moment when an editor
-;; command is Evaled and the screens Redisplayed.
-;;
-;; These occasional misses are harmless IF exposures from the
-;; Redisplay process are batched up until the final calls to
-;; gdk_window_process_updates. Then, with ignore-change-region set,
-;; the expose event handlers need not punt. Each changed line will
-;; be repainted, including any that had punted an expose event.
-;;
-;; If this batching cannot be relied upon, some Scheme side batching
-;; can be done, and incorrectly exposed regions again queued for
-;; redrawing.
+;; Punted exposures should be infrequent, resulting from external
+;; events (e.g. an obscuring window was closed) exposing lines that
+;; have just recently changed in the buffer, during the tiny Eval and
+;; Redisplay parts of Edwin's main loop. These occasional misses
+;; should be hardly noticeable. The blank line should be quickly
+;; redrawn by the end of Redisplay.
(define-method update-screen! ((screen <gtk-screen>) display-style)
(%trace "; (update-screen! <gtk-screen>) "screen" "display-style"\n")
(else
(update-name screen)
(update-widgets screen)
- (and (begin
- (%trace "; update drawings\n")
- (for-each-text-widget screen update-widget-buffer)
- (if (every (lambda (entry) (update-drawing screen (cdr entry)))
- (gtk-screen-drawings screen))
- (begin
- (%trace "; update drawings done\n")
- #t)
- (begin
- (%trace "; (update-screen! <gtk-screen>) done: halted\n")
- #f)))
- ;; From here on, drawings are up-to-date, a change region
- ;; notwithstanding.
- (fluid-let ((ignore-change-region #t))
- (%trace "; update windows\n")
- (for-each-text-widget screen update-window)
- (if (display-style/discard-screen-contents? display-style)
- (for-each-text-widget screen gtk-widget-queue-draw))
- (update-blinking screen)
- (%trace "; (update-screen! <gtk-screen>) done: finished\n")
- #t)))))))
+ (for-each-text-widget screen update-widget-buffer)
+ (%trace "; update drawings\n")
+ (if (every (lambda (entry) (update-drawing screen (cdr entry)))
+ (gtk-screen-drawings screen))
+ (begin
+ (%trace "; update windows\n")
+ (for-each-text-widget screen update-window)
+ (if (display-style/discard-screen-contents? display-style)
+ (for-each-text-widget screen gtk-widget-queue-draw))
+ (update-blinking screen)
+ (%trace "; (update-screen! <gtk-screen>) done: finished\n")
+ #t)
+ (begin
+ (%trace "; (update-screen! <gtk-screen>) done: halted\n")
+ #f)))))))
(define-integrable with-screen-in-update
(named-lambda (with-screen-in-update screen thunk)
(set-screen-in-update?! screen #t)
(let ((v (thunk)))
(set-screen-in-update?! screen #f)
+ ;; It would be better if this happened AFTER buffer change
+ ;; regions were cleared. Or use gdk-window-process-updates here?
+ (for-each (lambda (buffer.drawing)
+ (set-buffer-drawing-update-region! (cdr buffer.drawing) #f))
+ (gtk-screen-drawings screen))
v)))
(define (update-blinking screen)
(mark-index display-start)))
(change-end-index (if (buffer-drawing-valid? drawing)
(group-end-changes-index group)
- (mark-index display-end))))
+ (mark-index display-end)))
+ (update-region #f))
(define-syntax %trace3
(syntax-rules ()
(%trace ";\tno changes\n")
#t)
(else
+ (set! update-region (cons change-start-index change-end-index))
+ (set-buffer-drawing-update-region! drawing update-region)
(let ((finished?
(redraw-start
lines start num y
redraw-end)))))))))
+
+ (set-buffer-drawing-update-region! drawing finished?)
(if finished?
(begin
(set-size)
(set! drawing-extent (copy-fix-rect extent))
(fix-rect-union! drawing-extent extent)))
+ ;; If the update region is narrowed to exclude each line before it
+ ;; is re-drawn, then the resulting exposes will not be punted by
+ ;; the line-ink expose handler (which is otherwise shuns change
+ ;; regions). The expose event could arrive instantly (thread
+ ;; timer interrupts permitting), so this must be done before
+ ;; (re)drawing the line-ink.
+ (define (update-region! start)
+ (set-car! update-region (mark-index start)))
+
;; Keeps the next line to redraw on the front, skipping inks like
;; cursors, selection boxes, embedded images/widgets/whatnot.
(define (next-lines inks)
(%trace3 "; add-line "start" "num" "y" "old"\n")
(let ((new (make-line-ink)))
(set-line-ink-start! new (mark-permanent-copy start))
+ (update-region! start)
(set-line-ink-end! new (mark-permanent-copy start))
(set-line-ink-number! new num)
(fix-drawing-add-ink! drawing new (and (pair? old) (car old)))
(define (steal-line! line start num y)
(%trace3 "; steal-line! "line" "start" "num" "y"\n")
(move-mark-to! (line-ink-start line) start)
+ (update-region! start)
(set-line-ink-number! line num)
(redraw-line! line 0 y (layout))
(union-ink! line))
(let* ((extent (fix-ink-extent line))
(old-num (line-ink-number line))
(old-y (fix-rect-y extent)))
+ (update-region! start)
(if (not (fix:= old-y y))
(set-text-ink-position! line 0 y))
(if (not (fix:= old-num num))
(next-y-extent extent)))
(define (remove-line line)
- (clear-cached-pango-layout line)
(mark-temporary! (line-ink-start line))
(mark-temporary! (line-ink-end line))
- (fix-ink-remove! line))
+ (fix-ink-remove! line)
+ (clear-cached-pango-layout line))
(define (no-display-changes?)
;; If the drawing already agrees with the buffer and its current
(%trace3 ";\t redraw-line! "line" from "(line-ink-start line)
" ("x","y") with "pango-layout"\n")
- (clear-cached-pango-layout line)
(layout-line! line pango-layout)
(pango-layout-get-pixel-extents
pango-layout
(lambda (width height)
(without-interrupts
(lambda ()
+ (clear-cached-pango-layout line)
(%trace3 ";\t erasing "(fix-ink-extent line)"\n")
(drawing-damage line)
(let ((extent (fix-ink-extent line)))
(and (not (group-start-index? group index))
(char=? #\newline (group-left-char group index)))))
-(define (unchanged? line)
- (let* ((drawing (fix-ink-drawing line))
- (buffer (buffer-drawing-buffer drawing)))
- (and buffer
- (let* ((group (buffer-group buffer))
- (start-changes-index (group-start-changes-index group)))
- (or (not start-changes-index) ;short-circuit no-changes case
- (%unchanged? line start-changes-index
- (group-end-changes-index group)))))))
-
-(define (%unchanged? line change-start-index change-end-index)
- (or
- ;; Common trivial case: no change = unchanged.
- (not change-start-index)
-
- ;; First case: there is a change region, but it ends before
- ;; our start.
- (let ((start-index (line-ink-start-index line)))
- ;; change end = line start is normally considered a miss
- ;; (not overlapping) but is incorrect here. A change
- ;; abutting the beginning of the line may have removed a
- ;; newline...
- (and
- ;;(fix:< change-end-index start-index)
- ;; Is this unnecessary???
- (fix:<= change-end-index start-index)
- (fix:< change-start-index start-index)
- ))
-
- ;; Second case: it starts after our end.
- (let ((end-index (line-ink-end-index line)))
- ;; Now line end = change start IS a miss. A change
- ;; abutting the end of the line has only touched its
- ;; newline and remains unaffected. YET this is wrong?
- ;;
- ;; (fix:<= end-index change-start-index)
+(define-integrable unchanged?
+ (named-lambda (unchanged? line)
+ (let* ((drawing (fix-ink-drawing line))
+ (update-region (buffer-drawing-update-region drawing)))
+ (cond ((eq? update-region #t) #t)
+ ((pair? update-region)
+ (or
+ (let ((change-start (car update-region))
+ (line-end (line-ink-end-index line)))
+ (fix:<= line-end change-start))
+ (let ((change-end (cdr update-region))
+ (line-start (line-ink-start-index line)))
+ (fix:< change-end line-start))))
+ (else
+ (let ((buffer (buffer-drawing-buffer drawing)))
+ (and buffer
+ (let ((group (buffer-group buffer)))
+ (%unchanged? line
+ (group-start-changes-index group)
+ (group-end-changes-index group))))))))))
+
+(define-integrable %unchanged?
+ (named-lambda (%unchanged? line change-start-index change-end-index)
+ (or
+ ;; Common trivial case: no change = unchanged.
+ (not change-start)
+
+ ;; First case: the change region ends before LINE starts.
;;
- ;; If there is NO newline, the line IS affected. A
- ;; deletion at the end of the buffer will produce a
- ;; change-start at end-of-line/buffer???
+ ;; LINE and change region may not touch. The change region may
+ ;; have removed the newline before LINE, or inserted new text
+ ;; after the newline, changing LINE's start.
+ (let ((line-start (line-ink-start-index line)))
+ (fix:< change-end line-start))
- (fix:< end-index change-start-index))))
+ ;; Second case: the change region starts after LINE ends.
+ ;;
+ ;; LINE must end with a newline, else a change region touching
+ ;; the end is adding to the line. Rather than test for this,
+ ;; consider touching lines as NOT unchanged.
+ (let ((line-end (line-ink-end-index line)))
+ (fix:< line-end change-start)))))
\f
(define (update-cursor widget)
(%trace ";\t update-cursor "widget"\n")
(display-start define standard initial-value #f)
(display-end define standard initial-value #f)
+ ;; During redisplay this is the portion of the buffer's change
+ ;; region that has yet to be re-drawn.
+ (update-region define standard initial-value #f)
+
;; These are the particulars of the set of PangoLayouts in use.
;; Each element is a "cache" containing: (<line-ink>|#f
;; . <pango-layout>). Thus each layout is either idle, or in use --
(write-char #\- port)
(write (line-ink-end-index line) port))))
-(define ignore-change-region
- ;; fluid-assigned to #t when a buffer drawing is known to be
- ;; up-to-date, but its change region has yet to be cleared.
- #f)
-
(define-method text-ink-pango-layout ((ink <line-ink>))
- ;; This procedure is for the expose handler, and mouse tracker, and?
- ;; They all seem to be able to fire off ANYTIME. A cached pango
- ;; layout is presumed to be all laid out. A cache miss means a
- ;; PangoLayout must be re-laid-up from the buffer text, if the text
- ;; has not changed. If the change region intersects, the expose
- ;; handler must punt (unless ignore-change-region is #t), leaving a
- ;; blank spot! A subsequent screen update should damage the punted
- ;; line's region. It was intersected by the change region, and will
- ;; be updated -- moved/resized/re-texted, or removed entirely.
- ;; Presumably this produces only occasional flashes of blank spots
- ;; -- an expose sneaking into the tiny Eval-Print parts of the
- ;; editor REP loop.
+ ;; A cached pango layout is presumed to be all laid out. A cache
+ ;; miss means a PangoLayout must be re-laid-up from the buffer text,
+ ;; if the text has not changed. If the change region intersects,
+ ;; punt!
(define (salvage-pango-layout line)
;; Look for a cached PangoLayout to re-use. Returns abandoned
layout))
;; Do not (call-next-method ink). There is no <text-ink> method.
- (if (or ignore-change-region (unchanged? ink))
+ (if (unchanged? ink)
(or (line-ink-cached-pango-layout ink)
(let ((layout (or (salvage-pango-layout ink)
(cache-pango-layout ink))))
(layout-line! ink layout)
layout))
(begin
- (%trace ";text-ink-pango-layout: punted "ink"\n")
+ (outf-error ";text-ink-pango-layout: punted "ink"\n")
#f)))
(define (clear-cached-pango-layout line)
projects / mit-scheme.git / commitdiff