diff --git a/collects/hierlist/hierlist.ss b/collects/hierlist/hierlist.ss index 065f11d0..db448c64 100644 --- a/collects/hierlist/hierlist.ss +++ b/collects/hierlist/hierlist.ss @@ -1,72 +1,4 @@ +#lang scheme/base -(module hierlist mzscheme - (require mzlib/unit - (lib "mred-sig.ss" "mred") - (lib "mred-unit.ss" "mred")) - - (require "hierlist-sig.ss" - "hierlist-unit.ss") - - (define-compound-unit/infer hl - (import) - (export hierlist^) - (link standard-mred@ hierlist@)) - - (define-values/invoke-unit/infer hl) - - (provide-signature-elements hierlist^)) - -#| - -;; Testing -(define f (make-object frame% "test")) -(define p (make-object horizontal-panel% f)) -(define c (make-object (class hierarchical-list% args - (override - [on-item-opened - (lambda (i) - (let ([f (send i user-data)]) - (when f (f i))))] - [on-select - (lambda (i) - (printf "Selected: ~a~n" - (if i - (send (send i get-editor) get-flattened-text) - i)))] - [on-double-select - (lambda (s) - (printf "Double-click: ~a~n" - (send (send s get-editor) get-flattened-text)))]) - (sequence (apply super-init args))) - p)) - -(define a (send c new-list)) -(send (send a get-editor) insert "First Item: List") -(send (send (send a new-item) get-editor) insert "Sub1") -(send (send (send a new-item) get-editor) insert "Sub2") -(define a.1 (send a new-list)) -(send (send a.1 get-editor) insert "Deeper List") -(send (send (send a.1 new-item) get-editor) insert "Way Down") - -(define b (send c new-item)) -(send (send b get-editor) insert "Second Item") - -(define d (send c new-list)) -(send (send d get-editor) insert "dynamic") -(send d user-data (lambda (d) - (time (let loop ([i 30]) - (unless (zero? i) - (send (send (send d new-item) get-editor) insert (number->string i)) - (loop (sub1 i))))))) - -(define x (send c new-list)) -(send (send x get-editor) insert "x") - -(define y (send c new-item)) -(send (send y get-editor) insert "y") - -(send f show #t) - -(yield (make-semaphore)) - -|# +(require mrlib/hierlist) +(provide (all-from-out mrlib/hierlist)) diff --git a/collects/mrlib/hierlist.ss b/collects/mrlib/hierlist.ss new file mode 100644 index 00000000..475f38b6 --- /dev/null +++ b/collects/mrlib/hierlist.ss @@ -0,0 +1,65 @@ +#lang scheme/base + +(require mzlib/unit + scheme/gui/base + hierlist/hierlist-sig + hierlist/hierlist-unit) + +(define-values/invoke-unit/infer hierlist@) + +(provide-signature-elements hierlist^) + +#| + +;; Testing +(define f (make-object frame% "test")) +(define p (make-object horizontal-panel% f)) +(define c (make-object (class hierarchical-list% args + (override + [on-item-opened + (lambda (i) + (let ([f (send i user-data)]) + (when f (f i))))] + [on-select + (lambda (i) + (printf "Selected: ~a~n" + (if i + (send (send i get-editor) get-flattened-text) + i)))] + [on-double-select + (lambda (s) + (printf "Double-click: ~a~n" + (send (send s get-editor) get-flattened-text)))]) + (sequence (apply super-init args))) + p)) + +(define a (send c new-list)) +(send (send a get-editor) insert "First Item: List") +(send (send (send a new-item) get-editor) insert "Sub1") +(send (send (send a new-item) get-editor) insert "Sub2") +(define a.1 (send a new-list)) +(send (send a.1 get-editor) insert "Deeper List") +(send (send (send a.1 new-item) get-editor) insert "Way Down") + +(define b (send c new-item)) +(send (send b get-editor) insert "Second Item") + +(define d (send c new-list)) +(send (send d get-editor) insert "dynamic") +(send d user-data (lambda (d) + (time (let loop ([i 30]) + (unless (zero? i) + (send (send (send d new-item) get-editor) insert (number->string i)) + (loop (sub1 i))))))) + +(define x (send c new-list)) +(send (send x get-editor) insert "x") + +(define y (send c new-item)) +(send (send y get-editor) insert "y") + +(send f show #t) + +(yield (make-semaphore)) + +|# diff --git a/collects/mrlib/scribblings/hierlist/compound-item.scrbl b/collects/mrlib/scribblings/hierlist/compound-item.scrbl new file mode 100644 index 00000000..02dacf06 --- /dev/null +++ b/collects/mrlib/scribblings/hierlist/compound-item.scrbl @@ -0,0 +1,61 @@ +#lang scribble/doc +@(require "../common.ss" + (for-label mrlib/hierlist)) + +@definterface/title[hierarchical-list-compound-item<%> + (hierarchical-list-item<%>)]{ + +Instantiate this interface via @method[hierarchical-list% new-list]. + + +@defmethod[(new-item [mixin ((implementation?/c hierarchical-list-item<%>) + . -> . + (implementation?/c hierarchical-list-item<%>)) + (lambda (%) %)]) + (is-a?/c hierarchical-list-item<%>)]{ + +Like @xmethod[hierarchical-list% new-item].} + + +@defmethod[(set-no-sublists [no-sublists? any/c]) void?]{ + +Like @xmethod[hierarchical-list% set-no-sublists].} + + +@defmethod[(new-list [mixin ((implementation?/c hierarchical-list-compound-item<%>) + . -> . + (implementation?/c hierarchical-list-compound-item<%>)) + (lambda (%) %)]) + (is-a?/c hierarchical-list-compound-item<%>)]{ + +Like @xmethod[hierarchical-list% new-list].} + + +@defmethod[(delete-item [i (is-a?/c hierarchical-list-item<%>)]) void?]{ + +Deletes immediate item or sub-list @scheme[i] from the sub-list.} + + +@defmethod[(get-items) (listof (is-a?/c hierarchical-list-item<%>))]{ + +Returns a list of all immediate items in the sub-list.} + + +@defmethod*[([(open) void?] + [(close) void?] + [(toggle-open/closed) void?])]{ + +Shows or hides the items of this sub-list.} + + +@defmethod[(is-open) boolean?]{ + +Reports whether the items of this sub-list are visible.} + + +@defmethod[(get-arrow-snip) (is-a?/c snip%)]{ + +Returns a snip that corresponds to the arrow to hide/show items of the +sub-list. The result is intended for use by automatic test suites.} + +} diff --git a/collects/mrlib/scribblings/hierlist/hierlist.scrbl b/collects/mrlib/scribblings/hierlist/hierlist.scrbl new file mode 100644 index 00000000..b6af86f7 --- /dev/null +++ b/collects/mrlib/scribblings/hierlist/hierlist.scrbl @@ -0,0 +1,36 @@ +#lang scribble/doc +@(require "../common.ss" + (for-label mrlib/hierlist)) + +@title[#:style 'toc]{Hierarchical List Control} + +@defmodule[mrlib/hierlist] + +A @scheme[hierarchical-list%] control is a list of items, some of +which can themselves be hierarchical lists. Each such sub-list has an +arrow that the user can click to hide or show the sub-list's items. + +The list control supports the following default keystrokes: + +@itemize{ + + @item{Down: move to the next entry at the current level (skipping lower levels).} + + @item{Up: move to the previous entry at the current level (skipping lower levels).} + + @item{Left: move to the enclosing level (only valid at embedded levels).} + + @item{Right: move down in one level (only valid for lists).} + + @item{Return: open/close the current selected level (only valid for lists).} + +} + + +@local-table-of-contents[] + +@include-section["list.scrbl"] +@include-section["item.scrbl"] +@include-section["compound-item.scrbl"] +@include-section["snips.scrbl"] + diff --git a/collects/mrlib/scribblings/hierlist/item.scrbl b/collects/mrlib/scribblings/hierlist/item.scrbl new file mode 100644 index 00000000..1a938c74 --- /dev/null +++ b/collects/mrlib/scribblings/hierlist/item.scrbl @@ -0,0 +1,46 @@ +#lang scribble/doc +@(require "../common.ss" + (for-label mrlib/hierlist)) + +@definterface/title[hierarchical-list-item<%> ()]{ + +Instantiate this interface via @method[hierarchical-list% new-item]. + +@defmethod[(get-editor) (is-a?/c text%)]{ + +Returns a text-editor buffer whose content is the display +representation of the item. In other words, fill in this text editor +to set the item's label.} + + +@defmethod[(is-selected?) boolean?]{ + +Reports whether the item is selected.} + + +@defmethod*[([(select [on? any/c]) void?] + [(click-select [on? any/c]) void?])]{ + +Calls @method[hierarchical-list% select] or @method[hierarchical-list% +click-select]. The @scheme[on?] argument can be @scheme[#f] only if +@xmethod[hierarchical-list% allow-deselect] allows it.} + + +@defmethod*[([(user-data) any/c] + [(user-data [data any/c]) void?])]{ + +Gets/sets arbitrary data associated with the item.} + + +@defmethod[(get-clickable-snip) (is-a?/c snip%)]{ + +Returns the snip that (when clicked) selects this element the +list. This method is intended for use with an automatic test suite.} + + +@defmethod*[([(get-allow-selection?) boolean?] + [(set-allow-selection [allow? any/c]) void?])]{ + +Gets/sets whether this item is allowed to be selected.} + +} diff --git a/collects/mrlib/scribblings/hierlist/list.scrbl b/collects/mrlib/scribblings/hierlist/list.scrbl new file mode 100644 index 00000000..3bd11c1d --- /dev/null +++ b/collects/mrlib/scribblings/hierlist/list.scrbl @@ -0,0 +1,188 @@ +#lang scribble/doc +@(require "../common.ss" + (for-label mrlib/hierlist)) + +@defclass/title[hierarchical-list% editor-canvas% ()]{ + +Creates a hierarchical-list control. + + +@defconstructor[([parent (or/c (is-a?/c frame%) (is-a?/c dialog%) + (is-a?/c panel%) (is-a?/c pane%))] + [style (listof (one-of/c 'no-border 'control-border 'combo + 'no-hscroll 'no-vscroll + 'hide-hscroll 'hide-vscroll + 'auto-vscroll 'auto-hscroll + 'resize-corner 'deleted 'transparent)) + '(no-hscroll)])]{ + +Creates the control.} + + +@defmethod[(selected) (or/c (is-a?/c hierarchical-list-item<%>) + false/c)]{ + +Returns the currently selected item, if any.} + + +@defmethod[(new-item [mixin ((implementation?/c hierarchical-list-item<%>) + . -> . + (implementation?/c hierarchical-list-item<%>)) + (lambda (%) %)]) + (is-a?/c hierarchical-list-item<%>)]{ + +Creates and returns a new (empty) item in the list. See +@scheme[hierarchical-list-item<%>] for methods to fill in the item's +label. + +The @scheme[mixin] argument is applied to a class implementing +@scheme[hierarchical-list-item<%>], and the resulting class is +instantiated as the list item.} + + +@defmethod[(set-no-sublists [no-sublists? any/c]) void?]{ + +Enables/disables sublist mode. When sublists are disabled, space to +the left of the list items (that would normally align non-list items +with list items) is omitted. This method can be called only when the +list is empty.} + + +@defmethod[(new-list [mixin ((implementation?/c hierarchical-list-compound-item<%>) + . -> . + (implementation?/c hierarchical-list-compound-item<%>)) + (lambda (%) %)]) + (is-a?/c hierarchical-list-compound-item<%>)]{ + +Creates and returns a new (empty) sub-list in the list. See +@scheme[hierarchical-list-compound-item<%>] for methods to fill in the +item's label and content. + +The @scheme[mixin] argument is applied to a class implementing +@scheme[hierarchical-list-compound-item<%>], and the resulting class +is instantiated as the sub-list.} + + +@defmethod[(delete-item [i (is-a?/c hierarchical-list-item<%>)]) void?]{ + +Deletes immediate item or sub-list @scheme[i] from the list.} + + +@defmethod[(get-items) (listof (is-a?/c hierarchical-list-item<%>))]{ + +Returns a list of all immediate items in the list control.} + + +@defmethod*[([(selectable) boolean?] + [(selectable [on? any/c]) void?])]{ + +Reports whether items are selectable, or enables/disables item +selection.} + + +@defmethod[(on-select [i (or/c (is-a?/c hierarchical-list-item<%>) false/c)]) any]{ + +Called for new select of @scheme[i], where @scheme[i] is @scheme[#f] +if no item is now selected.} + + +@defmethod[(on-click [i (is-a?/c hierarchical-list-item<%>)]) any]{ + +Called when an item is clicked on, but selection for that item is not +allowed. Selection can be disallowed by @method[hierarchical-list% +selectable] or @xmethod[hierarchical-list-item<%> +set-allow-selection].} + + +@defmethod[(on-double-select [i (is-a?/c hierarchical-list-item<%>)]) any]{ + +Called for a double-click on @scheme[i].} + + +@defmethod[(on-item-opened [i (is-a?/c hierarchical-list-compound-item<%>)]) any]{ + +Called when the arrow for @scheme[i] is turned down.} + + +@defmethod[(on-item-closed [i (is-a?/c hierarchical-list-compound-item<%>)]) any]{ + +Called when the arrow for @scheme[i] is turned up.} + + +@defmethod[(sort [less-than-proc ((is-a?/c hierarchical-list-item<%>) + (is-a?/c hierarchical-list-item<%>) + . -> . any/c)] + [recur? any/c #t]) + void?]{ + +Sorts items in the list by calling @scheme[less-than-proc] on pairs of +items. If @scheme[recur?] is true, items in sub-lists are sorted +recursively.} + + +@defmethod[(can-do-edit-operation? [op symbol?] [recursive? any/c #t]) + boolean?]{ + +Like @xmethod[editor<%> can-do-edit-operation?]. The default +implementation always returns @scheme[#f].} + + +@defmethod[(do-edit-operation [op symbol?] [recursive? any/c #t]) + void?]{ + +Like @xmethod[editor<%> do-edit-operation]. The default implementation +does nothing.} + + +@defmethod*[([(select-prev) void?] + [(select-next) void?] + [(select-first) void?] + [(select-last) void?] + [(select-in) void?] + [(select-out) void?] + [(page-up) void?] + [(page-down) void?])]{ + +Move the selection, scroll, and call @method[hierarchical-list +on-select].} + + +@defmethod[(select [i (or/c (is-a?/c hierarchical-list-item<%>) false/c)]) void?]{ + +Moves the selection, scrolls as necessary to show it, and calls +@method[hierarchical-list% on-select] unless disabled via +@method[hierarchical-list% on-select-always]. + +The @method[hierarchical-list% allow-deselect] method controls whether +@scheme[i] is allowed to be @scheme[#f] to deselect the currently +selected item.} + + +@defmethod[(click-select [i (or/c (is-a?/c hierarchical-list-item<%>) false/c)]) void?]{ + +Like @method[hierarchical-list% select], but always calls +@method[hierarchical-list% on-select].} + + +@defmethod*[([(on-select-always) boolean?] + [(on-select-always [always? any/c]) void?])]{ + +Gets/sets whether the @method[hierarchical-list% on-select] method is +called in response to @method[hierarchical-list% select] (as opposed +to @method[hierarchical-list% click-select]). + +The initial mode enables @method[hierarchical-list% on-select] calls +always.} + + +@defmethod*[([(allow-deselect) boolean?] + [(allow-deselect [allow? any/c]) void?])]{ + + +Gets/sets whether the @method[hierarchical-list% on-select] can be +called with a @scheme[#f] argument to deselect the current item +(leaving none selected). + +The initial mode does not allow deselection.} + +} diff --git a/collects/mrlib/scribblings/hierlist/snips.scrbl b/collects/mrlib/scribblings/hierlist/snips.scrbl new file mode 100644 index 00000000..7b3558ca --- /dev/null +++ b/collects/mrlib/scribblings/hierlist/snips.scrbl @@ -0,0 +1,32 @@ +#lang scribble/doc +@(require "../common.ss" + (for-label mrlib/hierlist)) + +@title{Snips in a @scheme[hierarchical-list%] Instance} + +The @xmethod[text% find-snip] method of the editor in a +@scheme[hierarchical-list%] return instances of +@scheme[hierarchical-item-snip%] and @scheme[hierarchical-list-snip%]. + +@defclass[hierarchical-item-snip% editor-snip% ()]{ + + @defmethod[(get-item) (is-a?/c hierarchical-list-item<%>)]{ + + Returns the @scheme[hierarchical-list-item<%>] corresponding to the + snip.} + +} + + +@defclass[hierarchical-list-snip% editor-snip% ()]{ + + @defmethod[(get-item) (is-a?/c hierarchical-list-compound-item<%>)]{ + + Returns the @scheme[hierarchical-list-compound-item<%>] corresponding to the + snip.} + + @defmethod[(get-content-buffer) (is-a?/c text%)]{ + + Returns the text% that contains the sub-item snips.} + +} diff --git a/collects/mrlib/scribblings/mrlib.scrbl b/collects/mrlib/scribblings/mrlib.scrbl index 95681982..6fb5e155 100644 --- a/collects/mrlib/scribblings/mrlib.scrbl +++ b/collects/mrlib/scribblings/mrlib.scrbl @@ -8,10 +8,11 @@ @include-section["aligned-pasteboard/aligned-pasteboard.scrbl"] @include-section["bitmap-label.scrbl"] @include-section["cache-image-snip.scrbl"] -@include-section["interactive-value-port.scrbl"] @include-section["gif.scrbl"] @include-section["graph/graph.scrbl"] +@include-section["hierlist/hierlist.scrbl"] @include-section["include-bitmap.scrbl"] +@include-section["interactive-value-port.scrbl"] @include-section["name-message.scrbl"] @include-section["path-dialog.scrbl"] @include-section["plot.scrbl"]