From 0c82f54912a2a2d3e087ab8c8a533b42008d6080 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 4 Nov 2012 07:36:36 -0700 Subject: [PATCH] racket/gui: add `delete' to `choice%' and `list-control<%>' Closes PR 13230 --- collects/mred/private/mritem.rkt | 11 +++++------ collects/mred/private/wx/cocoa/choice.rkt | 2 ++ collects/mred/private/wx/gtk/choice.rkt | 8 +++++++- collects/mred/private/wx/win32/choice.rkt | 8 ++++---- collects/mred/private/wx/win32/const.rkt | 1 + collects/mred/private/wxlitem.rkt | 3 ++- collects/scribblings/gui/list-box-class.scrbl | 10 ---------- .../scribblings/gui/list-control-intf.scrbl | 19 +++++++++++++++---- collects/tests/gracket/item.rkt | 12 +++++------- 9 files changed, 41 insertions(+), 33 deletions(-) diff --git a/collects/mred/private/mritem.rkt b/collects/mred/private/mritem.rkt index 78108061d5..76cb3b5762 100644 --- a/collects/mred/private/mritem.rkt +++ b/collects/mred/private/mritem.rkt @@ -600,7 +600,10 @@ [find-string (entry-point (lambda (x) (check-label-string '(method list-control<%> find-string) x) (do-find-string x)))] - + [delete (entry-point (lambda (n) + (check-item 'delete n) + (send this -delete-list-item n) + (send wx delete n)))] [-append-list-string (lambda (i) (set! content (append content (list i))))] [-set-list-string (lambda (i s) @@ -842,11 +845,7 @@ (set! num-columns (add1 num-columns)) (set! column-labels (append column-labels (list label))) (send wx append-column label))))] - - [delete (entry-point (lambda (n) - (check-item 'delete n) - (send this -delete-list-item n) - (send wx delete n)))] + [get-data (entry-point (lambda (n) (check-item 'get-data n) (send wx get-data n)))] [get-label-font (lambda () (send wx get-label-font))] [get-selections (entry-point (lambda () (send wx get-selections)))] diff --git a/collects/mred/private/wx/cocoa/choice.rkt b/collects/mred/private/wx/cocoa/choice.rkt index c174789da2..c15b724fc8 100644 --- a/collects/mred/private/wx/cocoa/choice.rkt +++ b/collects/mred/private/wx/cocoa/choice.rkt @@ -68,6 +68,8 @@ (tellv (get-cocoa) insertItemWithTitle: #:type _NSString lbl atIndex: #:type _NSInteger (number))) + (define/public (delete i) + (tellv (get-cocoa) removeItemAtIndex: #:type _NSInteger i)) (define/override (maybe-register-as-child parent on?) (register-as-child parent on?))) diff --git a/collects/mred/private/wx/gtk/choice.rkt b/collects/mred/private/wx/gtk/choice.rkt index 39802d2c28..b5c9d9efdc 100644 --- a/collects/mred/private/wx/gtk/choice.rkt +++ b/collects/mred/private/wx/gtk/choice.rkt @@ -78,9 +78,12 @@ (set! ignore-clicked? #t) (gtk_combo_box_set_active gtk i) (set! ignore-clicked? #f))) + (define/public (get-selection) (gtk_combo_box_get_active gtk)) + (define/public (number) count) + (define/public (clear) (atomically (set! ignore-clicked? #t) @@ -88,6 +91,7 @@ (gtk_combo_box_remove_text gtk 0)) (set! count 0) (set! ignore-clicked? #f))) + (public [-append append]) (define (-append l) (atomically @@ -96,5 +100,7 @@ (gtk_combo_box_append_text gtk l) (when (= count 1) (set-selection 0)) - (set! ignore-clicked? #f)))) + (set! ignore-clicked? #f))) + (define/public (delete i) + (gtk_combo_box_remove_text gtk i))) diff --git a/collects/mred/private/wx/win32/choice.rkt b/collects/mred/private/wx/win32/choice.rkt index 74a4c9d293..b14ecb9135 100644 --- a/collects/mred/private/wx/win32/choice.rkt +++ b/collects/mred/private/wx/win32/choice.rkt @@ -102,13 +102,13 @@ (SendMessageW hwnd CB_RESETCONTENT 0 0) (set! num-choices 0))) - (public [append* append]) (define (append* str) (atomically (SendMessageW/str hwnd CB_ADDSTRING 0 str) (set! num-choices (add1 num-choices)) - (when (= 1 num-choices) (set-selection 0)))))) - - + (when (= 1 num-choices) (set-selection 0)))) + (define/public (delete i) + (set! num-choices (sub1 num-choices)) + (void (SendMessageW hwnd CB_DELETESTRING i 0))))) diff --git a/collects/mred/private/wx/win32/const.rkt b/collects/mred/private/wx/win32/const.rkt index 7b96f9f6ab..0ace67bffd 100644 --- a/collects/mred/private/wx/win32/const.rkt +++ b/collects/mred/private/wx/win32/const.rkt @@ -617,6 +617,7 @@ (define CB_SETCURSEL #x014E) (define CB_GETCURSEL #x0147) (define CB_ADDSTRING #x0143) +(define CB_DELETESTRING #x0144) (define CB_RESETCONTENT #x014B) (define CBN_SELENDOK 9) diff --git a/collects/mred/private/wxlitem.rkt b/collects/mred/private/wxlitem.rkt index fa55722ded..b85f75f45c 100644 --- a/collects/mred/private/wxlitem.rkt +++ b/collects/mred/private/wxlitem.rkt @@ -113,7 +113,8 @@ (get-selection) (number) (clear) - (append lbl)) + (append lbl) + (delete i)) (stretchable-in-y #f) (stretchable-in-x #f))) diff --git a/collects/scribblings/gui/list-box-class.scrbl b/collects/scribblings/gui/list-box-class.scrbl index 7506d8598e..1c5d438c22 100644 --- a/collects/scribblings/gui/list-box-class.scrbl +++ b/collects/scribblings/gui/list-box-class.scrbl @@ -157,16 +157,6 @@ style. The new column is logically the last column, and it is initially displayed as the last column.} -@defmethod[(delete [n exact-nonnegative-integer?]) - void?]{ - -Deletes the item indexed by @racket[n]. @|lbnumnote| If @racket[n] is equal - to or larger than the number of items in the control, @|MismatchExn|. - -Selected items that are not deleted remain selected, and no other - items are selected.} - - @defmethod[(delete-column [n exact-nonnegative-integer?]) void?]{ diff --git a/collects/scribblings/gui/list-control-intf.scrbl b/collects/scribblings/gui/list-control-intf.scrbl index 3c03527170..4b04a9309c 100644 --- a/collects/scribblings/gui/list-control-intf.scrbl +++ b/collects/scribblings/gui/list-control-intf.scrbl @@ -36,11 +36,22 @@ Removes all user-selectable items from the control. } +@defmethod[(delete [n exact-nonnegative-integer?]) + void?]{ + +Deletes the item indexed by @racket[n] (where items are indexed + from @racket[0]). If @racket[n] is equal + to or larger than the number of items in the control, @|MismatchExn|. + +Selected items that are not deleted remain selected, and no other + items are selected.} + + @defmethod[(find-string [s string?]) (or/c exact-nonnegative-integer? #f)]{ Finds a user-selectable item matching the given string. If no matching choice is found, @racket[#f] is returned, otherwise the index of the - matching choice is returned (items are indexed from @racket[0]). + matching choice is returned (where items are indexed from @racket[0]). } @@ -53,7 +64,7 @@ Returns the number of user-selectable items in the control (which is @defmethod[(get-selection) (or/c exact-nonnegative-integer? #f)]{ -Returns the index of the currently selected item (items are indexed +Returns the index of the currently selected item (where items are indexed from @racket[0]). If the choice item currently contains no choices or no selections, @racket[#f] is returned. If multiple selections are allowed and multiple items are selected, the index of the first @@ -64,7 +75,7 @@ Returns the index of the currently selected item (items are indexed @defmethod[(get-string [n exact-nonnegative-integer?]) (and/c immutable? label-string?)]{ -Returns the item for the given index (items are indexed from +Returns the item for the given index (where items are indexed from @racket[0]). If the provided index is larger than the greatest index in the list control, @|MismatchExn|. @@ -81,7 +92,7 @@ Returns the currently selected item. If the control currently @defmethod[(set-selection [n exact-nonnegative-integer?]) void?]{ -Selects the item specified by the given index (items are indexed from +Selects the item specified by the given index (where items are indexed from @racket[0]). If the given index larger than the greatest index in the list control, @|MismatchExn|. diff --git a/collects/tests/gracket/item.rkt b/collects/tests/gracket/item.rkt index 7c3da06609..8566a95198 100644 --- a/collects/tests/gracket/item.rkt +++ b/collects/tests/gracket/item.rkt @@ -1556,13 +1556,11 @@ (when (<= 0 p (sub1 (length actual-content))) (set! actual-content (gone actual-content p)) (set! actual-user-data (gone actual-user-data p)))) - (define db (if list? - (make-object button% - "Delete" cdp - (lambda (b e) - (let ([p (send c get-selection)]) - (delete p)))) - null)) + (define db (make-object button% + "Delete" cdp + (lambda (b e) + (let ([p (send c get-selection)]) + (delete p))))) (define dab (if list? (make-object button% "Delete Above" cdp