Script Library: drop-list2.r

Script Library: 1240 scripts
drop-list2.r

rebol [
    title: "drop-list2 widget for REBGUI"
    author: "Robert Paluch 2009"
    nick: "bobik"
    email: "%robert--paluch--seznam--cz"
    version: 0.1.0
        date: 9-aug-2009
        file: %drop-list2.r
    Purpose: {
     Extension of original drop-list widget.
     Widget receives data as pairs [value1 text1 value2 text2 ...]
     Widget has extension of function PICKED with options /values returning block of selected row(pair)
    }
    Note: "Totally based on Ashley's widget drop-list :-)"
        Need: "rebgui"
]

do %rebgui.r

append-widget [
drop-list2: make rebface [
    tip:    {
        USAGE:
            drop-list2 "a" data [1 "a" 22 "b" 333 "c"]
            drop-list2  data [1 "a" 22 "b" 333 "c"]
            drop-list2 data (SQL "select id,name from names")

        DESCRIPTION:
            Single column selection list with hidden values list.
            Values in 'data' are structured as pairs [value1 text1 value2 text2 ....]
            To get current choice use function PICKED with option /values
    }
    indexes: copy []
    size:   25x5
    text:   ""
    color:  CTX-REBGUI/colors/outline-light
    data:   []
    edge:   outline-edge
    font:   default-font
    para:   make default-para [margin: as-pair CTX-REBGUI/sizes/slider + 2 2]
    feel:   make default-feel [
        engage: make function! [face action event][
            face/pane/feel/engage face/pane action event
        ]
    ]
    action: make default-action [
        on-unfocus: make function! [face] [
            hide-popup
            face/hidden-text: face/hidden-caret: none
            true
            ;face/action face   ; causes problems when set-focus used from another widget to assign and then shift focus
        ]
    ]
    options:    [info]
    hidden-caret: hidden-text: none
    ;   Accessor functions
    picked: make function! [/values /local i] [
        i: attempt [index? find data text]
        if none? i [return none]
        if values [return reduce [(pick indexes i)  (pick data i)] ]
        return i
    ]
    
    rebind: make function! [] [
        color: colors/outline-light
        para/margin/x: CTX-REBGUI/sizes/line + 2
    ]
    init:   make function! [/local p tBlk] [
        unless block? data [gui-error "drop-list expected data block"]
        
        indexes: copy []
        tBlk: copy []
        foreach [a b] data [
            append indexes a
            append tBlk b
        ]
        data: copy tBlk
        
        para: make para []  ; avoid shared para object for scrollable input widget
        p: self
        pane: make arrow [
            tip:    none
            offset: as-pair p/size/x - p/size/y + 1 1
            size:   as-pair p/size/y - 4 p/size/y - 4
            span:   if all [p/span find p/span #W] [#X]
            edge:   none
            action: make default-action [
                on-click: make function! [face /filter-data fd [block!] /local data p v lines oft] [
                    unless filter-data [ctx-rebgui/edit/unfocus]    ; unfocus if arrow pressed
                    p: face/parent-face
                    all [find p/options 'no-click exit]
                    data: either fd [fd] [p/data]
                    unless zero? lines: length? data [
                        oft: either (lines * CTX-REBGUI/sizes/line) < (p/parent-face/size/y - p/offset/y - p/size/y) [
                            ;   fits below
                            p/offset + as-pair 0 p/size/y - 1
                        ][
                            either (lines * CTX-REBGUI/sizes/line) <= (p/parent-face/size/y - 4) [
                                ;   fits bottom
                                as-pair p/offset/x p/parent-face/size/y - 2 - (lines * CTX-REBGUI/sizes/line)
                            ][
                                ;   align to bottom
                                as-pair p/offset/x p/parent-face/size/y - 2 - (CTX-REBGUI/sizes/line * to integer! p/parent-face/size/y / CTX-REBGUI/sizes/line)
                            ]
                        ]
                        if v: choose p p/size/x oft data [
                            p/text: form v
                            p/hidden-text: p/hidden-caret: none
                            p/action/on-click p
                            either p/type = 'drop-list [show p ctx-rebgui/edit/unfocus] [set-focus p]
                        ]
                    ]
                ]
            ]
        ]
        pane/init   ; draw arrow
    ]
]
]

;;here is example of usage...
comment {
display "DROP-LIST2 Example" [
    dl1: drop-list2 "a" data [1 "a" 22 "b" 333 "c"] 
    button 50 "Picked/values" [alert mold dl1/picked/values]
    return
    
    dl2: drop-list2 data [100 "aaa" 200 "bbb" 333 "ccc"] 
    button 50 "Picked/values" [alert mold dl2/picked/values]
]

do-events
}
Notes
email address(es) have been munged to protect them from spam harvesters. If you are a Library member, you can log on and view this script without the munging.
(robert:paluch:seznam:cz)