Changeset 1342 for trunk/gui/scripts/table.tcl
- Timestamp:
- Mar 18, 2009, 2:59:21 PM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/table.tcl
r115 r1342 36 36 itcl::body Rappture::Table::constructor {xmlobj path} { 37 37 if {![Rappture::library isvalid $xmlobj]} { 38 38 error "bad value \"$xmlobj\": should be Rappture::library" 39 39 } 40 40 set _table [$xmlobj element -as object $path] … … 45 45 set _tuples [Rappture::Tuples ::#auto] 46 46 foreach cname [$_table children -type column] { 47 48 47 set label [$_table get $cname.label] 48 $_tuples column insert end -name $cname -label $label 49 49 } 50 50 … … 52 52 set nline 1 53 53 foreach line [split [$_table get data] \n] { 54 55 56 57 58 59 60 61 54 if {[llength $line] == 0} { 55 continue 56 } 57 if {[llength $line] != $cols} { 58 error "bad data at line $nline: expected $cols columns but got \"[string trim $line]\"" 59 } 60 $_tuples insert end $line 61 incr nline 62 62 } 63 63 } … … 88 88 itcl::body Rappture::Table::columns {args} { 89 89 Rappture::getopts args params { 90 91 92 90 flag switch -component 91 flag switch -label default 92 flag switch -units 93 93 } 94 94 if {[llength $args] == 0} { 95 96 97 98 99 95 set cols [llength [$_tuples column names]] 96 set plist "" 97 for {set i 0} {$i < $cols} {incr i} { 98 lappend plist $i 99 } 100 100 } elseif {[llength $args] == 1} { 101 102 103 104 105 106 107 108 109 110 101 set p [lindex $args 0] 102 if {[string is integer $p]} { 103 lappend plist $p 104 } else { 105 set pos [lsearch -exact [$_tuples column names] $p] 106 if {$pos < 0} { 107 error "bad column \"$p\": should be column name or integer index" 108 } 109 lappend plist $pos 110 } 111 111 } else { 112 112 error "wrong # args: should be \"columns ?-component|-label|-units? ?pos?\"" 113 113 } 114 114 115 115 set rlist "" 116 116 switch -- $params(switch) { 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 117 -component { 118 set names [$_tuples column names] 119 foreach p $plist { 120 lappend rlist [lindex $names $p] 121 } 122 } 123 -label { 124 set names [$_tuples column names] 125 foreach p $plist { 126 set name [lindex $names $p] 127 catch {unset opts} 128 array set opts [$_tuples column info $name] 129 lappend rlist $opts(-label) 130 } 131 } 132 -units { 133 set names [$_tuples column names] 134 foreach p $plist { 135 set comp [lindex $names $p] 136 lappend rlist [$_table get $comp.units] 137 } 138 } 139 139 } 140 140 return $rlist … … 152 152 itcl::body Rappture::Table::values {args} { 153 153 Rappture::getopts args params { 154 155 154 value -row "" 155 value -column "" 156 156 } 157 157 if {[llength $args] > 0} { 158 158 error "wrong # args: should be \"values ?-row r? ?-column c?\"" 159 159 } 160 160 if {"" == $params(-row) && "" == $params(-column)} { 161 161 return [$_tuples get] 162 162 } elseif {"" == $params(-column)} { 163 163 return [lindex [$_tuples get $params(-row)] 0] 164 164 } 165 165 166 166 if {[string is integer $params(-column)]} { 167 167 set col [lindex [$_tuples column names] $params(-column)] 168 168 } else { 169 170 171 172 169 set col $params(-column) 170 if {"" == [$_tuples column names $col]} { 171 error "bad column name \"$col\": should be [join [$_tuples column names] {, }]" 172 } 173 173 } 174 174 175 175 if {"" == $params(-row)} { 176 177 176 # return entire column 177 return [$_tuples get -format $col] 178 178 } 179 179 # return a particular cell … … 192 192 set max "" 193 193 foreach v [values -column $column] { 194 195 196 197 198 199 200 194 if {"" == $min} { 195 set min $v 196 set max $v 197 } else { 198 if {$v < $min} { set min $v } 199 if {$v > $max} { set max $v } 200 } 201 201 } 202 202 return [list $min $max] … … 212 212 itcl::body Rappture::Table::hints {{keyword ""}} { 213 213 foreach {key path} { 214 215 216 214 label about.label 215 color about.color 216 style about.style 217 217 } { 218 219 220 221 218 set str [$_table get $path] 219 if {"" != $str} { 220 set hints($key) $str 221 } 222 222 } 223 223 224 224 if {$keyword != ""} { 225 226 227 228 225 if {[info exists hints($keyword)]} { 226 return $hints($keyword) 227 } 228 return "" 229 229 } 230 230 return [array get hints]
Note: See TracChangeset
for help on using the changeset viewer.