add 'hide-hscroll and 'hide-vscroll for panel%

This commit is contained in:
Matthew Flatt 2016-05-18 15:27:35 -06:00
parent 3e6fcf18bb
commit 399cfe9c5b
4 changed files with 40 additions and 16 deletions

View File

@ -24,8 +24,8 @@ A @racket[panel%] object has a degenerate placement strategy for
@defconstructor[([parent (or/c (is-a?/c frame%) (is-a?/c dialog%)
(is-a?/c panel%) (is-a?/c pane%))]
[style (listof (or/c 'border 'deleted
'hscroll 'auto-hscroll
'vscroll 'auto-vscroll)) null]
'hscroll 'auto-hscroll 'hide-hscroll
'vscroll 'auto-vscroll 'hide-vscroll)) null]
[enabled any/c #t]
[vert-margin spacing-integer? 0]
[horiz-margin spacing-integer? 0]
@ -47,14 +47,17 @@ If the @racket['hscroll] or @racket['vscroll] style is specified, then
the panel includes a scrollbar in the corresponding direction, and
the panel's own size in the corresponding direction is not
constrained by the size of its children subareas. The @racket['auto-hscroll]
and @racket['auto-vscroll] styles are like @racket['hscroll] or
@racket['vscroll], but they cause the corresponding scrollbar to
and @racket['auto-vscroll] styles imply @racket['hscroll] and
@racket['vscroll], respectively, but they cause the corresponding scrollbar to
disappear when no scrolling is needed in the corresponding direction;
the @racket['auto-vscroll] and @racket['auto-hscroll] modes assume that
children subareas are placed using the default algorithm for a @racket[panel%],
@racket[vertical-panel%], or @racket[horizontal-panel%].
@racket[vertical-panel%], or @racket[horizontal-panel%]. The @racket['hide-hscroll]
and @racket['hide-vscroll] styles imply @racket['auto-hscroll] and
@racket['auto-vscroll], respectively, but the corresponding scroll bar is never
made visible (while still allowing the panel content to exceed its own size).
@WindowKWs[@racket[enabled]] @SubareaKWs[] @AreaContKWs[] @AreaKWs[]
}}
@history[#:changed "1.25" @elem{Added @racket['hide-vscroll] and @racket['hide-hscroll].}]}}

View File

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

View File

@ -182,14 +182,29 @@
panel))]
[as-canvas? (lambda () (or (memq 'vscroll style)
(memq 'auto-vscroll style)
(memq 'hide-vscroll style)
(memq 'hscroll style)
(memq 'auto-hscroll style)))])
(memq 'auto-hscroll style)
(memq 'hide-hscroll style)))])
(check-container-parent cwho parent)
(check-style cwho #f (append '(border deleted)
(if can-canvas?
'(hscroll vscroll auto-hscroll auto-vscroll)
'(hscroll vscroll
auto-hscroll auto-vscroll
hide-hscroll hide-vscroll)
null))
style)
(define (add-scrolls style)
(append
(if (memq 'hide-vscroll style)
'(auto-vscroll)
null)
(if (memq 'hide-hscroll style)
'(auto-hscroll)
null)
style))
(as-entry
(lambda ()
(super-instantiate
@ -208,7 +223,7 @@
wx-canvas-panel%
wx-panel%)])
this this (mred->wx-container parent)
(cons 'transparent style)
(cons 'transparent (add-scrolls style))
(get-initial-label)))
wx)
(lambda () wx)

View File

@ -97,13 +97,17 @@
(define ignore-redraw-request? #f)
(define hide-scroll-x? (and (memq 'hide-hscroll style) #t))
(define hide-scroll-y? (and (memq 'hide-vscroll style) #t))
(define auto-scroll-x? (and (memq 'auto-hscroll style) #t))
(define auto-scroll-y? (and (memq 'auto-vscroll style) #t))
(define can-scroll-x? (or auto-scroll-x?
hide-scroll-x?
(and (memq 'hscroll style) #t)))
(define can-scroll-y? (or auto-scroll-y?
hide-scroll-y?
(and (memq 'vscroll style) #t)))
(define scroll-x? can-scroll-x?)
@ -450,13 +454,15 @@
;; loop for fix-point on x and y scroll
(let loop ([w w] [h h] [iters 0])
(let ([want-scroll-x?
(if auto-scroll-x?
((car ms) . > . w)
scroll-x?)]
(and (not hide-scroll-x?)
(if auto-scroll-x?
((car ms) . > . w)
scroll-x?))]
[want-scroll-y?
(if auto-scroll-y?
((cadr ms) . > . h)
scroll-y?)])
(and (not hide-scroll-y?)
(if auto-scroll-y?
((cadr ms) . > . h)
scroll-y?))])
(if (and (eq? scroll-x? want-scroll-x?)
(eq? scroll-y? want-scroll-y?))
(values (if can-scroll-x?