1# $Id: selector.tcl,v 2.8 2006/01/27 19:05:52 andreas_kupries Exp $
2
3package require Tk 8.3
4package require stooop
5
6# implements generic selection on a list of unique identifiers
7
8::stooop::class selector {
9
10    proc selector {this args} switched {$args} {
11        ::set ($this,order) 0
12        switched::complete $this
13    }
14
15    proc ~selector {this} {
16        variable ${this}selected
17        variable ${this}order
18
19        catch {::unset ${this}selected ${this}order}
20    }
21
22    proc options {this} {
23        return [::list\
24            [::list -selectcommand {} {}]\
25        ]
26    }
27
28    # nothing to do as value is stored at the switched level
29    proc set-selectcommand {this value} {}
30
31    proc set {this indices selected} {
32        variable ${this}selected
33        variable ${this}order
34
35        ::set select {}
36        ::set deselect {}
37        foreach index $indices {
38            if {\
39                [info exists ${this}selected($index)] &&\
40                ($selected == [::set ${this}selected($index)])\
41            } continue                                              ;# no change
42            if {$selected} {
43                lappend select $index
44                ::set ${this}selected($index) 1
45            } else {
46                lappend deselect $index
47                ::set ${this}selected($index) 0
48            }
49            # keep track of action order
50            ::set ${this}order($index) $($this,order)
51            incr ($this,order)
52        }
53        update $this $select $deselect
54    }
55
56    proc update {this selected deselected} {
57        if {[string length $switched::($this,-selectcommand)] == 0} return
58        if {[llength $selected] > 0} {
59            uplevel #0 $switched::($this,-selectcommand) [::list $selected] 1
60        }
61        if {[llength $deselected] > 0} {
62            uplevel #0 $switched::($this,-selectcommand) [::list $deselected] 0
63        }
64    }
65
66    proc unset {this indices} {
67        variable ${this}selected
68        variable ${this}order
69
70        foreach index $indices {
71            ::unset ${this}selected($index) ${this}order($index)
72        }
73    }
74
75    proc ordered {this index1 index2} {
76        # used for sorting with lsort command according to order
77        variable ${this}order
78
79        return [expr {\
80            [::set ${this}order($index1)] - [::set ${this}order($index2)]\
81        }]
82    }
83
84    ### public procedures follow:
85
86    proc add {this indices} {
87        set $this $indices 0
88    }
89
90    proc remove {this indices} {
91        unset $this $indices
92    }
93
94    proc select {this indices} {
95        clear $this
96        set $this $indices 1
97        # keep track of last selected object for extension
98        ::set ($this,lastSelected) [lindex $indices end]
99    }
100
101    proc deselect {this indices} {
102        set $this $indices 0
103    }
104
105    proc toggle {this indices} {
106        variable ${this}selected
107        variable ${this}order
108
109        ::set select {}
110        ::set deselect {}
111        foreach index $indices {
112            if {[::set ${this}selected($index)]} {
113                lappend deselect $index
114                ::set ${this}selected($index) 0
115                if {\
116                    [info exists ($this,lastSelected)] &&\
117                    ($index == $($this,lastSelected))\
118                } {
119                    # too complicated to find out what was selected last
120                    ::unset ($this,lastSelected)
121                }
122            } else {
123                lappend select $index
124                ::set ${this}selected($index) 1
125                # keep track of last selected object for extension
126                ::set ($this,lastSelected) $index
127            }
128            # keep track of action order
129            ::set ${this}order($index) $($this,order)
130            incr ($this,order)
131        }
132        update $this $select $deselect
133    }
134
135    ::stooop::virtual proc extend {this index} {}
136
137    proc clear {this} {
138        variable ${this}selected
139
140        set $this [array names ${this}selected] 0
141    }
142
143    ::stooop::virtual proc selected {this} {
144        # derived class may want to do some additional processing,
145        # such as sorting, ...
146        variable ${this}selected
147
148        ::set list {}
149        foreach {index value} [array get ${this}selected] {
150            if {$value} {
151                lappend list $index
152            }
153        }
154        return [lsort -command "ordered $this" $list]                 ;# ordered
155    }
156
157    ::stooop::virtual proc list {this} {
158        # derived class may want to do some additional processing,
159        # such as sorting, ...
160        variable ${this}selected
161
162        # ordered:
163        return [lsort -command "ordered $this" [array names ${this}selected]]
164    }
165
166}
167