suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

more on scroll-by-copy

Browse Source 
make it per-editor customizable, add callbacks, and use
them to make the special first line mixin work properly
when it is enabled
This commit is contained in:
Robby Findler 2015-11-26 08:46:38 -06:00
parent 79128627d2
commit fe77bb34d4
7 changed files with 110 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
gui-doc/scribblings/gui/editor-canvas-class.scrbl
View File

@ -183,6 +183,17 @@ Returns a line count installed with @method[editor-canvas%
}
@defmethod[(get-scroll-via-copy) boolean?]{
Returns @racket[#t] if scrolling triggers a copy of
the editor content (and then a refresh of the newly exposed
content). Returns @racket[#f] when scrolling triggers a
refresh of the entire editor canvas. Defaults to
@racket[#f].
See also @method[editor<%> on-scroll-to]
and @method[editor<%> after-scroll-to].
}
@defmethod*[([(horizontal-inset)
(integer-in 1 10000)]
[(horizontal-inset [step (integer-in 1 10000)])
@ -324,7 +335,7 @@ Enables or disables bottom-base scrolling, or gets the current enable
}
@defmethod[(set-editor [edit (or/c (or/c (is-a?/c text%) (is-a?/c pasteboard%)) #f)]
[redraw? any/c #t])
void?]{
@ -360,6 +371,10 @@ If the line count is set to @racket[#f], then the canvas's graphical
}
@defmethod[(set-scroll-via-copy [scroll-via-copy? any/c]) void?]{
Changes the scrolling mode refresh. See also @method[editor-canvas% get-scroll-via-copy].
}
@defmethod*[([(vertical-inset)
(integer-in 1 10000)]
[(vertical-inset [step (integer-in 1 10000)])

25
gui-doc/scribblings/gui/editor-intf.scrbl
View File

@ -164,6 +164,20 @@ Does nothing.
}
}
@defmethod[(after-scroll-to) void?]{
@methspec{
Called when the editor has just scrolled, but the entire display
may not have been refreshed. (If the editor scrolls but the entire window
is redrawn, this method may not be called.)
See also @method[editor-canvas% get-scroll-via-copy].
}
@methimpl{Does nothing.}
}
@defmethod*[([(auto-wrap)
boolean?]
[(auto-wrap [auto-wrap? any/c])
@ -1656,6 +1670,17 @@ Does nothing.
}}
@defmethod[(on-scroll-to) void?]{
@methspec{
Called when the editor is about to scroll, but the entire display is
may not be refreshed. (If the editor scrolls but the entire window
is redrawn, this method may not be called.)
See also @method[editor-canvas% get-scroll-via-copy].
}
@methimpl{Does nothing.}
}
@defmethod[#:mode pubment
(on-snip-modified [snip (is-a?/c snip%)]

51
gui-lib/framework/private/text.rkt
View File

@ -748,6 +748,38 @@
(super on-event event)]
[else
(super on-event event)]))]))
(define to-invalidate #f)
(define/override (on-scroll-to)
(super on-scroll-to)
(set! to-invalidate (get-region-to-draw)))
(define/override (after-scroll-to)
(super after-scroll-to)
(define (maybe-invalidate)
(when to-invalidate
(invalidate-bitmap-cache
(list-ref to-invalidate 0)
(list-ref to-invalidate 1)
(list-ref to-invalidate 2)
(list-ref to-invalidate 3))
(set! to-invalidate #f)))
(maybe-invalidate)
(set! to-invalidate (get-region-to-draw))
(maybe-invalidate))
(define/private (get-region-to-draw)
(cond
[(show-first-line?)
(define admin (get-admin))
(cond
[admin
(send admin get-view bx by bw #f #f)
(define first-line (get-text 0 (paragraph-end-position 0)))
(define-values (tw th _1 _2) (send (get-dc) get-text-extent first-line (get-font)))
(list (unbox bx) (unbox by) (unbox bw) (+ th extra-fade-space))]
[else #f])]
[else #f]))
(define extra-fade-space 11)
(define/override (on-paint before? dc left top right bottom dx dy draw-caret)
(unless before?
@ -755,7 +787,8 @@
(define admin (get-admin))
(when admin
(send admin get-view bx by bw #f #f)
(unless (= (unbox by) 0)
(define y-coord (unbox by))
(unless (= y-coord 0)
(define draw-first-line-number?
(and (is-a? this line-numbers<%>)
(send this showing-line-numbers?)))
@ -772,10 +805,10 @@
(send dc set-smoothing 'aligned)
(send dc set-text-mode 'transparent)
(define-values (tw th _1 _2) (send dc get-text-extent first-line))
(define line-height (+ (unbox by) dy th 1))
(define line-height (+ y-coord dy th 1))
(define line-left (+ (unbox bx) dx))
(define line-right (+ (unbox bx) dx (unbox bw)))
(if w-o-b?
(send dc set-pen "white" 1 'solid)
(send dc set-pen "black" 1 'solid))
@ -784,7 +817,7 @@
(when (eq? (send dc get-smoothing) 'aligned)
(define start (if w-o-b? 6/10 3/10))
(define end 0)
(define steps 10)
(define steps (- extra-fade-space 1))
(send dc set-pen
(if w-o-b? dark-wob-first-line-color dark-first-line-color)
1
@ -803,20 +836,20 @@
(send dc set-alpha 1)
(send dc set-pen "gray" 1 'transparent)
(send dc set-brush (if w-o-b? "black" "white") 'solid)
(send dc draw-rectangle (+ (unbox bx) dx) (+ (unbox by) dy) (unbox bw) th)
(send dc draw-rectangle (+ (unbox bx) dx) (+ y-coord dy) (unbox bw) th)
(send dc set-text-foreground
(send the-color-database find-color
(if w-o-b? "white" "black")))
(define x-start
(cond
[draw-first-line-number?
(send this do-draw-single-line dc dx dy 0 (unbox by) #f #f)
(send this do-draw-single-line dc dx dy 0 y-coord #f #f)
(send dc set-pen (if w-o-b? "white" "black") 1 'solid)
(send this draw-separator dc (unbox by) (+ (unbox by) line-height) dx dy)
(send this draw-separator dc y-coord (+ y-coord line-height) dx dy)
(define-values (padding-left _1 _2 _3) (get-padding))
padding-left]
[else 0]))
(send dc draw-text first-line (+ x-start (+ (unbox bx) dx)) (+ (unbox by) dy))
(send dc draw-text first-line (+ x-start (+ (unbox bx) dx)) (+ y-coord dy))
(send dc set-text-foreground old-text-foreground)
(send dc set-text-mode old-text-mode)
@ -4570,7 +4603,7 @@ designates the character that triggers autocompletion
#t)
(super-new)))
(define basic% (basic-mixin (editor:basic-mixin text%)))
(define line-spacing% (line-spacing-mixin basic%))
(define hide-caret/selection% (hide-caret/selection-mixin line-spacing%))

2
gui-lib/info.rkt
View File

@ -30,4 +30,4 @@
(define pkg-authors '(mflatt robby))
(define version "1.18")
(define version "1.19")

2
gui-lib/mred/private/mrcanvas.rkt
View File

@ -320,6 +320,8 @@
(define scroll-to-last? #f)
(define scroll-bottom? #f)
(define/public (call-as-primary-owner f) (send wx call-as-primary-owner f))
(define/public (set-scroll-via-copy s) (send wx set-scroll-via-copy s))
(define/public (get-scroll-via-copy) (send wx get-scroll-via-copy))
(define allow-scroll-to-last
(entry-point
(case-lambda

24
gui-lib/mred/private/wxme/editor-canvas.rkt
View File

@ -157,8 +157,6 @@
(define (keep-style l s) (if (memq s l) (list s) null))
(define SCROLL-VIA-COPY? #f)
(defclass editor-canvas% canvas%
(inherit refresh get-canvas-background get-dc
@ -172,6 +170,10 @@
begin-refresh-sequence
end-refresh-sequence)
(define scroll-via-copy? #f)
(define/public (set-scroll-via-copy v) (set! scroll-via-copy? (and v #t)))
(define/public (get-scroll-via-copy) scroll-via-copy?)
(define blink-timer #f)
(define noloop? #f)
@ -944,11 +946,13 @@
retval)))))))
(define/private (do-scroll x y refresh? old-x old-y)
(define ed (get-editor))
(let ([savenoloop? noloop?])
(set! noloop? #t)
(maybe-reset-size)
(define on-scroll-to-called? #f)
(define change?
(or
;; Set x
@ -958,6 +962,9 @@
(and (not (= x old-x))
(begin
(when (not fake-x-scroll?)
(when scroll-via-copy?
(set! on-scroll-to-called? #t)
(when scroll-via-copy? (when ed (send ed on-scroll-to))))
(set-scroll-pos 'horizontal x))
#t))))
;; Set y
@ -967,13 +974,17 @@
(and (not (= y old-y))
(begin
(when (not fake-y-scroll?)
(unless on-scroll-to-called?
(when scroll-via-copy?
(set! on-scroll-to-called? #t)
(when ed (send ed on-scroll-to))))
(set-scroll-pos 'vertical y))
#t))))))
(set! noloop? savenoloop?)
(when (and change? refresh?)
(if (and SCROLL-VIA-COPY?
(if (and scroll-via-copy?
(not need-refresh?)
(not lazy-refresh?)
(get-canvas-background)
@ -1016,7 +1027,10 @@
#t))
(end-refresh-sequence))]
[else (repaint)])))
(repaint)))))
(repaint)))
(when on-scroll-to-called?
(when ed (send ed after-scroll-to)))))
(define/override (set-scrollbars x y x2 y2 x3 y3 x4 y4 ?) (void))

5
gui-lib/mred/private/wxme/editor.rkt
View File

@ -226,6 +226,11 @@
;; ----------------------------------------
(define/public (on-scroll-to) (void))
(define/public (after-scroll-to) (void))
;; ----------------------------------------
(def/public (set-admin [(make-or-false editor-admin%) administrator])
(setting-admin administrator)