From 399cfe9c5b5d1b248cd2315d128e6685991babd3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 18 May 2016 15:27:35 -0600 Subject: [PATCH] add 'hide-hscroll and 'hide-vscroll for `panel%` --- gui-doc/scribblings/gui/panel-class.scrbl | 15 +++++++++------ gui-lib/info.rkt | 2 +- gui-lib/mred/private/mrpanel.rkt | 21 ++++++++++++++++++--- gui-lib/mred/private/wxpanel.rkt | 18 ++++++++++++------ 4 files changed, 40 insertions(+), 16 deletions(-) diff --git a/gui-doc/scribblings/gui/panel-class.scrbl b/gui-doc/scribblings/gui/panel-class.scrbl index 625c7b23..3e72d9ae 100644 --- a/gui-doc/scribblings/gui/panel-class.scrbl +++ b/gui-doc/scribblings/gui/panel-class.scrbl @@ -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].}]}} diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt index 2e38d4bc..b4b508b1 100644 --- a/gui-lib/info.rkt +++ b/gui-lib/info.rkt @@ -30,4 +30,4 @@ (define pkg-authors '(mflatt robby)) -(define version "1.24") +(define version "1.25") diff --git a/gui-lib/mred/private/mrpanel.rkt b/gui-lib/mred/private/mrpanel.rkt index 63905849..c7a552b8 100644 --- a/gui-lib/mred/private/mrpanel.rkt +++ b/gui-lib/mred/private/mrpanel.rkt @@ -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) diff --git a/gui-lib/mred/private/wxpanel.rkt b/gui-lib/mred/private/wxpanel.rkt index 88321d85..71aa9c41 100644 --- a/gui-lib/mred/private/wxpanel.rkt +++ b/gui-lib/mred/private/wxpanel.rkt @@ -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?