From d8c8812f8734fe61c5607ec727372753c80183e4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 28 Feb 2011 18:13:52 -0700 Subject: [PATCH] fix `get-column-width' method of `list-box%' by changing the name to match the docs, plus some other bug fixes triggered by better testing Closes PR 11780 original commit: fdef90e482ddd066f8a131343308e856c76df902 --- collects/mred/private/mritem.rkt | 8 ++-- collects/mred/private/wx/cocoa/list-box.rkt | 5 ++- collects/mred/private/wx/gtk/list-box.rkt | 6 +-- collects/scribblings/gui/list-box-class.scrbl | 12 +++--- collects/tests/gracket/windowing.rktl | 37 ++++++++++++++++--- 5 files changed, 48 insertions(+), 20 deletions(-) diff --git a/collects/mred/private/mritem.rkt b/collects/mred/private/mritem.rkt index fa5bc953..b44cd34b 100644 --- a/collects/mred/private/mritem.rkt +++ b/collects/mred/private/mritem.rkt @@ -630,8 +630,8 @@ [(zero? i) (cons str (cdr l))] [else (cons (car l) (loop (sub1 i) (cdr l)))]))) (send wx set-column-label i str)))] - [set-column-size (lambda (i w min-size max-size) - (let ([who '(method list-box% set-column-size)]) + [set-column-width (lambda (i w min-size max-size) + (let ([who '(method list-box% set-column-width)]) (check-column-number who i) (check-dimension who w) (check-dimension who min-size) @@ -649,8 +649,8 @@ w) max-size))) (send wx set-column-size i w min-size max-size))] - [get-column-size (lambda (i) - (check-column-number '(method list-box% get-column-size) i) + [get-column-width (lambda (i) + (check-column-number '(method list-box% get-column-width) i) (send wx get-column-size i))] [delete-column (lambda (i) (let ([who '(method list-box% delete-column)]) diff --git a/collects/mred/private/wx/cocoa/list-box.rkt b/collects/mred/private/wx/cocoa/list-box.rkt index 2083d71a..ceb95b5e 100644 --- a/collects/mred/private/wx/cocoa/list-box.rkt +++ b/collects/mred/private/wx/cocoa/list-box.rkt @@ -143,7 +143,7 @@ (values (int (tell #:type _CGFloat col width)) (int (tell #:type _CGFloat col minWidth)) - (int (tell #:type _CGFloat col maxWidth))))) + (min 10000 (int (tell #:type _CGFloat col maxWidth)))))) (define/override (get-cocoa-content) content-cocoa) (define/override (get-cocoa-control) content-cocoa) @@ -274,7 +274,8 @@ (set! num-columns (sub1 num-columns)) (tellv content-cocoa removeTableColumn: c) (set! column-cocoas (drop-nth column-cocoas i)) - (set! itemss (drop-nth itemss i)))) + (set! itemss (drop-nth itemss i)) + (reset-column-order))) (reset)) (define callback cb) diff --git a/collects/mred/private/wx/gtk/list-box.rkt b/collects/mred/private/wx/gtk/list-box.rkt index 3a1fd1c4..c112f034 100644 --- a/collects/mred/private/wx/gtk/list-box.rkt +++ b/collects/mred/private/wx/gtk/list-box.rkt @@ -62,9 +62,9 @@ (define-gtk gtk_tree_view_column_get_width (_fun _GtkTreeViewColumn -> _int)) (define-gtk gtk_tree_view_column_get_min_width (_fun _GtkTreeViewColumn -> _int)) (define-gtk gtk_tree_view_column_get_max_width (_fun _GtkTreeViewColumn -> _int)) -(define-gtk gtk_tree_view_column_set_fixed_width (_fun _GtkTreeViewColumn _int -> _int)) -(define-gtk gtk_tree_view_column_set_min_width (_fun _GtkTreeViewColumn _int -> _int)) -(define-gtk gtk_tree_view_column_set_max_width (_fun _GtkTreeViewColumn _int -> _int)) +(define-gtk gtk_tree_view_column_set_fixed_width (_fun _GtkTreeViewColumn _int -> _void)) +(define-gtk gtk_tree_view_column_set_min_width (_fun _GtkTreeViewColumn _int -> _void)) +(define-gtk gtk_tree_view_column_set_max_width (_fun _GtkTreeViewColumn _int -> _void)) (define _GList (_cpointer 'List)) (define-glib g_list_foreach (_fun _GList (_fun _pointer -> _void) _pointer -> _void)) diff --git a/collects/scribblings/gui/list-box-class.scrbl b/collects/scribblings/gui/list-box-class.scrbl index ec34ddee..674b72b9 100644 --- a/collects/scribblings/gui/list-box-class.scrbl +++ b/collects/scribblings/gui/list-box-class.scrbl @@ -189,9 +189,9 @@ See also @method[list-box% set-column-order].} @defmethod[(get-column-width [column exact-nonnegative-integer?]) - (values exact-nonnegative-integer? - exact-nonnegative-integer? - exact-nonnegative-integer?)]{ + (values (integer-in 0 10000) + (integer-in 0 10000) + (integer-in 0 10000))]{ Gets the width of the column identified by @racket[column] (in logical positions, as opposed to display positions), which must be between 0 @@ -316,9 +316,9 @@ See also @method[list-box% get-column-order].} @defmethod[(set-column-width [column exact-nonnegative-integer?] - [width exact-nonnegative-integer?] - [min-width exact-nonnegative-integer?] - [max-width exact-nonnegative-integer?]) + [width (integer-in 0 10000)] + [min-width (integer-in 0 10000)] + [max-width (integer-in 0 10000)]) void?]{ Sets the width of the column identified by @racket[column] (in logical diff --git a/collects/tests/gracket/windowing.rktl b/collects/tests/gracket/windowing.rktl index 1f36d1d9..10f307f3 100644 --- a/collects/tests/gracket/windowing.rktl +++ b/collects/tests/gracket/windowing.rktl @@ -830,7 +830,7 @@ (test-control-event e '(list-box)) (set! side-effect 'list-box) 'oops) - (list style))]) + style)]) (label-test l "List Box") (stv l command (make-object control-event% 'list-box)) (test 'list-box 'list-box-callback side-effect) @@ -838,15 +838,42 @@ (stv l set-data 0 'a) (stv l set-data 2 'c-&-d) - (test-list-control l #f (and (memq style '(multiple extended)) #t)) + (test-list-control l #f (and (or (memq 'multiple style) + (memq 'extended style)) + #t)) (containee-window-tests l #t #t parent frame 2) + (st '("Column") l get-column-labels) + (st '(0) l get-column-order) + (let ([check-col-width + (lambda (col) + (let-values ([(val lo hi) (send l get-column-width col)]) + (test #t 'col-width (<= 0 lo val hi 10000))))]) + (check-col-width 0) + + (when (memq 'variable-columns style) + (stv l append-column "Second") + (st '("Column" "Second") l get-column-labels) + (st '(0 1) l get-column-order) + (stv l set-column-order '(1 0)) + (st '(1 0) l get-column-order) + (stv l set-string 0 "A2" 1) + (check-col-width 1) + (stv l append-column "Three") + (check-col-width 2) + (st '("Column" "Second" "Three") l get-column-labels) + (st '(1 0 2) l get-column-order) + (stv l delete-column 1) + (st '("Column" "Three") l get-column-labels) + (st '(0 1) l get-column-order))) + (stv parent delete-child l)))]) - (mk-list 'single) - (mk-list 'multiple) - (mk-list 'extended)) + (mk-list '(single)) + (mk-list '(multiple)) + (mk-list '(extended)) + (mk-list '(single variable-columns))) 'done-lists) (let ([l (make-object list-box% "List Two"