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