- Timestamp:
- Jul 30, 2010, 8:34:57 AM (14 years ago)
- Location:
- trunk/gui/scripts
- Files:
-
- 2 edited
-
editor.tcl (modified) (12 diffs)
-
gauge.tcl (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/gui/scripts/editor.tcl
r1342 r1850 58 58 protected variable _loc ;# array of editor location parameters 59 59 } 60 60 61 61 itk::usual Editor { 62 62 keep -cursor -font … … 74 74 75 75 itk_component add editor { 76 76 entry $itk_interior.editor -highlightthickness 0 77 77 } { 78 79 80 81 82 78 usual 79 keep -relief 80 ignore -highlightthickness 81 ignore -highlightcolor 82 ignore -highlightbackground 83 83 } 84 84 pack $itk_component(editor) -expand yes -fill both 85 85 86 86 bind $itk_component(editor) <KeyPress> \ 87 87 [itcl::code $this _resize] 88 88 bind $itk_component(editor) <KeyPress-Return> \ 89 89 [itcl::code $this deactivate] 90 90 bind $itk_component(editor) <KeyPress-Escape> \ 91 91 [itcl::code $this deactivate -abort] 92 92 bind $itk_component(editor) <ButtonPress> \ 93 93 [itcl::code $this _click %X %Y] 94 94 95 95 itk_component add emenu { 96 96 menu $itk_component(editor).menu -tearoff 0 97 97 } { 98 99 100 98 usual 99 ignore -tearoff 100 ignore -background -foreground 101 101 } 102 102 $itk_component(emenu) add command -label "Cut" -accelerator "^X" \ 103 103 -command [list event generate $itk_component(editor) <<Cut>>] 104 104 $itk_component(emenu) add command -label "Copy" -accelerator "^C" \ 105 105 -command [list event generate $itk_component(editor) <<Copy>>] 106 106 $itk_component(emenu) add command -label "Paste" -accelerator "^V" \ 107 107 -command [list event generate $itk_component(editor) <<Paste>>] 108 108 bind $itk_component(editor) <<PopupMenu>> { 109 109 tk_popup %W.menu %X %Y 110 110 } 111 111 … … 124 124 set e $itk_component(editor) 125 125 if {[winfo ismapped $e]} { 126 126 return ;# already mapped -- nothing to do 127 127 } 128 128 129 129 set info "" 130 130 if {[string length $itk_option(-activatecommand)] > 0} { 131 132 133 134 135 131 set status [catch {uplevel #0 $itk_option(-activatecommand)} info] 132 if {$status != 0} { 133 bgerror $info 134 return 135 } 136 136 } 137 137 … … 145 145 array set vals $info 146 146 if {![info exists vals(x)] || ![info exists vals(y)]} { 147 147 return 148 148 } 149 149 set _loc(x) $vals(x) … … 154 154 $itk_component(editor) delete 0 end 155 155 if {[info exists vals(text)]} { 156 156 $itk_component(editor) insert end $vals(text) 157 157 } 158 158 $itk_component(editor) select from 0 … … 167 167 update 168 168 while {[catch {grab set -global $itk_component(editor)}]} { 169 169 after 100 170 170 } 171 171 } … … 188 188 189 189 if {$args == "-abort"} { 190 191 192 190 grab release $itk_component(editor) 191 wm withdraw $itk_component(hull) 192 return 193 193 } 194 194 … … 200 200 # 201 201 if {[string length $itk_option(-validatecommand)] > 0} { 202 203 204 205 206 207 208 209 210 211 212 213 214 202 set cmd "uplevel #0 [list $itk_option(-validatecommand) [list $str]]" 203 if {[catch $cmd result]} { 204 bgerror $result 205 set result 1 206 } 207 if {$result == 0} { 208 bell 209 $itk_component(editor) select from 0 210 $itk_component(editor) select to end 211 $itk_component(editor) icursor end 212 focus $itk_component(editor) 213 return 214 } 215 215 } 216 216 … … 223 223 # 224 224 if {[string length $itk_option(-applycommand)] > 0} { 225 226 227 228 229 225 set cmd "uplevel #0 [list $itk_option(-applycommand) [list $str]]" 226 if {[catch $cmd result]} { 227 bgerror $result 228 return 229 } 230 230 } 231 231 } … … 255 255 itcl::body Rappture::Editor::_click {x y} { 256 256 if {[winfo containing $x $y] != $itk_component(editor)} { 257 257 deactivate 258 258 } else { 259 260 261 259 # make sure the editor has keyboard focus! 260 # it loses focus sometimes during cut/copy/paste operations 261 focus -force $itk_component(editor) 262 262 } 263 263 } … … 278 278 set w [expr {($w < $_loc(w)) ? $_loc(w) : $w}] 279 279 if {$w+$_loc(x) >= [winfo screenwidth $e]} { 280 280 set w [expr {[winfo screenwidth $e]-$_loc(x)}] 281 281 } 282 282 … … 284 284 set h [expr {($h < $_loc(h)) ? $_loc(h) : $h}] 285 285 if {$h+$_loc(y) >= [winfo screenheight $e]} { 286 287 } 286 set h [expr {[winfo screenheight $e]-$_loc(y)}] 287 } 288 288 # Temporary fix to prevent Opps. Don't deal with negative dimensions. 289 289 if { $w <= 0 || $h <= 0 } { 290 290 wm geometry $itk_component(hull) "+$_loc(x)+$_loc(y)" 291 291 } else { 292 292 wm geometry $itk_component(hull) "${w}x${h}+$_loc(x)+$_loc(y)" 293 293 } 294 294 } -
trunk/gui/scripts/gauge.tcl
r1483 r1850 55 55 56 56 blt::bitmap define GaugeArrow-up { 57 58 59 60 57 #define up_width 8 58 #define up_height 4 59 static unsigned char up_bits[] = { 60 0x10, 0x38, 0x7c, 0xfe}; 61 61 } 62 62 blt::bitmap define GaugeArrow-down { 63 64 65 66 63 #define arrow_width 8 64 #define arrow_height 4 65 static unsigned char arrow_bits[] = { 66 0xfe, 0x7c, 0x38, 0x10}; 67 67 } 68 68 69 69 blt::bitmap define GaugeArrow { 70 71 72 73 74 } 75 } 76 70 #define arrow_width 9 71 #define arrow_height 4 72 static unsigned char arrow_bits[] = { 73 0x7f, 0x00, 0x3e, 0x00, 0x1c, 0x00, 0x08, 0x00}; 74 } 75 } 76 77 77 itk::usual Gauge { 78 78 keep -cursor -font -foreground -background … … 85 85 itcl::body Rappture::Gauge::constructor {args} { 86 86 itk_component add icon { 87 88 87 canvas $itk_interior.icon -width 1 -height 1 \ 88 -borderwidth 0 -highlightthickness 0 89 89 } { 90 91 90 usual 91 ignore -highlightthickness -highlightbackground -highlightcolor 92 92 } 93 93 pack $itk_component(icon) -side left … … 95 95 96 96 itk_component add -protected vframe { 97 97 frame $itk_interior.vframe 98 98 } 99 99 100 100 itk_component add value { 101 102 101 label $itk_component(vframe).value -borderwidth 1 -width 7 \ 102 -textvariable [itcl::scope _value] 103 103 } { 104 104 rename -background -textbackground textBackground Background 105 105 } 106 106 pack $itk_component(value) -side left -expand yes -fill both … … 114 114 115 115 itk_component add emenu { 116 116 menu $itk_component(value).menu -tearoff 0 117 117 } { 118 119 118 usual 119 ignore -tearoff 120 120 } 121 121 $itk_component(emenu) add command -label "Cut" -accelerator "^X" \ 122 122 -command [list event generate $itk_component(value) <<Cut>>] 123 123 $itk_component(emenu) add command -label "Copy" -accelerator "^C" \ 124 124 -command [list event generate $itk_component(value) <<Copy>>] 125 125 $itk_component(emenu) add command -label "Paste" -accelerator "^V" \ 126 126 -command [list event generate $itk_component(value) <<Paste>>] 127 127 bind $itk_component(value) <<PopupMenu>> \ 128 128 [itcl::code $this _editor menu %X %Y] 129 129 130 130 itk_component add editor { 131 132 133 134 131 Rappture::Editor $itk_interior.editor \ 132 -activatecommand [itcl::code $this _editor activate] \ 133 -validatecommand [itcl::code $this _editor validate] \ 134 -applycommand [itcl::code $this _editor apply] 135 135 } 136 136 bind $itk_component(value) <ButtonPress> \ 137 137 [itcl::code $this _editor popup] 138 138 139 139 140 140 itk_component add spinner { 141 141 frame $itk_component(vframe).spinner 142 142 } 143 143 144 144 itk_component add spinup { 145 146 147 145 button $itk_component(spinner).up -bitmap GaugeArrow-up \ 146 -borderwidth 1 -relief raised -highlightthickness 0 \ 147 -command [itcl::code $this bump 1] 148 148 } { 149 150 149 usual 150 ignore -borderwidth -highlightthickness 151 151 } 152 152 pack $itk_component(spinup) -side top -expand yes -fill both 153 153 154 154 itk_component add spindn { 155 156 157 155 button $itk_component(spinner).down -bitmap GaugeArrow-down \ 156 -borderwidth 1 -relief raised -highlightthickness 0 \ 157 -command [itcl::code $this bump -1] 158 158 } { 159 160 159 usual 160 ignore -borderwidth -highlightthickness 161 161 } 162 162 pack $itk_component(spindn) -side bottom -expand yes -fill both … … 164 164 165 165 itk_component add presets { 166 167 166 button $itk_component(vframe).psbtn -bitmap GaugeArrow \ 167 -borderwidth 1 -highlightthickness 0 -relief flat 168 168 } { 169 170 171 169 usual 170 ignore -borderwidth -relief -highlightthickness 171 rename -background -textbackground textBackground Background 172 172 } 173 173 … … 176 176 177 177 itk_component add presetlist { 178 179 180 178 Rappture::Dropdownlist $itk_component(presets).plist \ 179 -postcommand [itcl::code $this _presets post] \ 180 -unpostcommand [itcl::code $this _presets unpost] \ 181 181 } 182 182 183 183 bind $itk_component(presetlist) <<DropdownlistSelect>> \ 184 184 [itcl::code $this _presets select] 185 185 186 186 $itk_component(presets) configure -command \ 187 187 [list $itk_component(presetlist) post $itk_component(vframe) left] 188 188 189 189 eval itk_initialize $args … … 203 203 set i [lsearch -exact $args -check] 204 204 if {$i >= 0} { 205 206 205 set onlycheck 1 206 set args [lreplace $args $i $i] 207 207 } 208 208 209 209 if {[llength $args] == 1} { 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 210 # 211 # If this gauge has -units, try to convert the incoming 212 # value to that system of units. Also, make sure that 213 # the value is bound by any min/max value constraints. 214 # 215 # Keep track of the inputted units so we can give a 216 # response about min and max values in familiar units. 217 # 218 set newval [set nv [lindex $args 0]] 219 set units $itk_option(-units) 220 if {"" != $units} { 221 set newval [Rappture::Units::convert $newval -context $units] 222 set nvUnits [Rappture::Units::Search::for $newval] 223 if { "" == $nvUnits} { 224 set msg [Rappture::Units::description $units] 225 error "Unrecognized units: $newval\nEnter value with units of $msg" 226 } 227 set nv [Rappture::Units::convert $nv \ 228 -context $units -to $units -units off] 229 230 # Normalize the units name 231 set newval [Rappture::Units::convert $newval -units off]$nvUnits 232 } 233 234 switch -- $itk_option(-type) { 235 integer { 236 if { [scan $nv "%g" value] != 1 || int($nv) != $value } { 237 error "bad value \"$nv\": should be an integer value" 238 } 239 } 240 real { 241 if {[string length $nv] <= 0 242 || ![string is double $nv] 243 || [regexp -nocase {^(inf|nan)$} $nv]} { 244 error "bad value \"$nv\": should be a real number" 245 } 246 } 247 } 248 249 if {"" != $itk_option(-minvalue)} { 250 set convMinVal [set minv $itk_option(-minvalue)] 251 if {"" != $units} { 252 set minv [Rappture::Units::convert $minv \ 253 -context $units -to $units -units off] 254 set convMinVal [Rappture::Units::convert \ 255 $itk_option(-minvalue) -context $units -to $nvUnits] 256 } else { 257 set newval [format "%g" $newval] 258 } 259 260 # fix for the case when the user tries to 261 # compare values like minv=-500 nv=-0600 262 set nv [format "%g" $nv] 263 set minv [format "%g" $minv] 264 265 if {$nv < $minv} { 266 error "minimum value allowed here is $convMinVal" 267 } 268 } 269 270 if {"" != $itk_option(-maxvalue)} { 271 set convMaxVal [set maxv $itk_option(-maxvalue)] 272 if {"" != $units} { 273 set maxv [Rappture::Units::convert $maxv \ 274 -context $units -to $units -units off] 275 set convMaxVal [Rappture::Units::convert \ 276 $itk_option(-maxvalue) -context $units -to $nvUnits] 277 } else { 278 set newval [format "%g" $newval] 279 } 280 281 # fix for the case when the user tries to 282 # compare values like maxv=500 nv=0600 283 set nv [format "%g" $nv] 284 set maxv [format "%g" $maxv] 285 286 if {$nv > $maxv} { 287 error "maximum value allowed here is $convMaxVal" 288 } 289 } 290 291 if {$onlycheck} { 292 return 293 } 294 295 set _value $newval 296 297 _redraw 298 event generate $itk_component(hull) <<Value>> 299 299 300 300 } elseif {[llength $args] != 0} { 301 301 error "wrong # args: should be \"value ?-check? ?newval?\"" 302 302 } 303 303 return $_value … … 315 315 itcl::body Rappture::Gauge::edit {option} { 316 316 if {$itk_option(-state) == "disabled"} { 317 317 return ;# disabled? then bail out here! 318 318 } 319 319 switch -- $option { 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 320 cut { 321 edit copy 322 _editor popup 323 $itk_component(editor) value "" 324 $itk_component(editor) deactivate 325 } 326 copy { 327 clipboard clear 328 clipboard append $_value 329 } 330 paste { 331 _editor popup 332 $itk_component(editor) value [clipboard get] 333 $itk_component(editor) deactivate 334 } 335 default { 336 error "bad option \"$option\": should be cut, copy, paste" 337 } 338 338 } 339 339 } … … 349 349 set val $_value 350 350 if {$val == ""} { 351 351 set val 0 352 352 } 353 353 if {[catch {value [expr {$val+$delta}]} result]} { 354 355 356 357 358 359 360 361 362 363 364 354 if {[regexp {allowed here is (.+)} $result match newval]} { 355 set _value $newval 356 $itk_component(value) configure -text $newval 357 } 358 if {[regexp {^bad.*: +(.)(.+)} $result match first tail] 359 || [regexp {(.)(.+)} $result match first tail]} { 360 set result "[string toupper $first]$tail" 361 } 362 bell 363 Rappture::Tooltip::cue $itk_component(value) $result 364 return 0 365 365 } 366 366 } … … 380 380 381 381 if {"" == [$c find all]} { 382 383 384 385 382 # first time around, create the items 383 $c create rectangle 0 0 1 1 -outline black -tags block 384 $c create image 0 0 -anchor center -image "" -tags bimage 385 $c create rectangle 0 0 1 1 -outline "" -fill "" -stipple gray50 -tags screen 386 386 } 387 387 388 388 if {"" != $itk_option(-spectrum)} { 389 389 set color [$itk_option(-spectrum) get $_value] 390 390 } else { 391 391 set color "" 392 392 } 393 393 … … 400 400 401 401 if {$itk_option(-state) == "disabled"} { 402 402 $c itemconfigure screen -fill white 403 403 } else { 404 404 $c itemconfigure screen -fill "" 405 405 } 406 406 } … … 417 417 418 418 if {"" != $itk_option(-image) || "" != $itk_option(-spectrum)} { 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 419 if {$itk_option(-samplewidth) > 0} { 420 set w $itk_option(-samplewidth) 421 } else { 422 if {$itk_option(-image) != ""} { 423 set w [expr {[image width $itk_option(-image)]+4}] 424 } else { 425 set w [winfo reqheight $itk_component(value)] 426 } 427 } 428 429 if {$itk_option(-sampleheight) > 0} { 430 set h $itk_option(-sampleheight) 431 } else { 432 if {$itk_option(-image) != ""} { 433 set h [expr {[image height $itk_option(-image)]+4}] 434 } else { 435 set h [winfo reqheight $itk_component(value)] 436 } 437 } 438 438 } 439 439 440 440 if {$w > 0 && $h > 0} { 441 441 $itk_component(icon) configure -width $w -height $h 442 442 } 443 443 } … … 451 451 itcl::body Rappture::Gauge::_hilite {comp state} { 452 452 if {$itk_option(-state) == "disabled"} { 453 453 set state 0 ;# disabled? then don't hilite 454 454 } 455 455 if {$comp == "value" && !$itk_option(-editable)} { 456 457 456 $itk_component(value) configure -relief flat 457 return 458 458 } 459 459 460 460 if {$state} { 461 461 $itk_component($comp) configure -relief solid 462 462 } else { 463 463 $itk_component($comp) configure -relief flat 464 464 } 465 465 } … … 477 477 itcl::body Rappture::Gauge::_editor {option args} { 478 478 if {$itk_option(-state) == "disabled"} { 479 479 return ;# disabled? then bail out here! 480 480 } 481 481 switch -- $option { 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 482 popup { 483 if {$itk_option(-editable)} { 484 $itk_component(editor) activate 485 } 486 } 487 activate { 488 return [list text $_value \ 489 x [winfo rootx $itk_component(value)] \ 490 y [winfo rooty $itk_component(value)] \ 491 w [winfo width $itk_component(value)] \ 492 h [winfo height $itk_component(value)]] 493 } 494 validate { 495 if {[llength $args] != 1} { 496 error "wrong # args: should be \"_editor validate val\"" 497 } 498 set val [lindex $args 0] 499 500 if {[catch {value -check $val} result]} { 501 if {[regexp {allowed here is (.+)} $result match newval]} { 502 $itk_component(editor) value $newval 503 } 504 if {[regexp {^bad.*: +(.)(.+)} $result match first tail] 505 || [regexp {(.)(.+)} $result match first tail]} { 506 set result "[string toupper $first]$tail" 507 } 508 bell 509 Rappture::Tooltip::cue $itk_component(editor) $result 510 return 0 511 } 512 } 513 apply { 514 if {[llength $args] != 1} { 515 error "wrong # args: should be \"_editor apply val\"" 516 } 517 value [lindex $args 0] 518 } 519 menu { 520 eval tk_popup $itk_component(emenu) $args 521 } 522 default { 523 error "bad option \"$option\": should be popup, activate, validate, apply, and menu" 524 } 525 525 } 526 526 } … … 539 539 itcl::body Rappture::Gauge::_presets {option} { 540 540 switch -- $option { 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 541 post { 542 set i [$itk_component(presetlist) index $_value] 543 if {$i >= 0} { 544 $itk_component(presetlist) select clear 0 end 545 $itk_component(presetlist) select set $i 546 } 547 after 10 [list $itk_component(presets) configure -relief sunken] 548 } 549 unpost { 550 $itk_component(presets) configure -relief flat 551 } 552 select { 553 set val [$itk_component(presetlist) current] 554 if {"" != $val} { 555 value $val 556 } 557 } 558 default { 559 error "bad option \"$option\": should be post, unpost, select" 560 } 561 561 } 562 562 } … … 572 572 itcl::body Rappture::Gauge::_layout {} { 573 573 foreach w [pack slaves $itk_component(hull)] { 574 574 pack forget $w 575 575 } 576 576 577 577 array set side2anchor { 578 579 580 581 578 left e 579 right w 580 top s 581 bottom n 582 582 } 583 583 set pos $itk_option(-valueposition) 584 584 pack $itk_component(vframe) -side $pos \ 585 585 -expand yes -fill both -ipadx 2 586 586 $itk_component(value) configure -anchor $side2anchor($pos) 587 587 588 588 if {"" != $itk_option(-image) || "" != $itk_option(-spectrum)} { 589 589 pack $itk_component(icon) -side $pos 590 590 } 591 591 } … … 596 596 itcl::configbody Rappture::Gauge::editable { 597 597 if {![string is boolean -strict $itk_option(-editable)]} { 598 598 error "bad value \"$itk_option(-editable)\": should be boolean" 599 599 } 600 600 if {!$itk_option(-editable) && [winfo ismapped $itk_component(editor)]} { 601 601 $itk_component(editor) deactivate -abort 602 602 } 603 603 } … … 609 609 set valid {normal disabled} 610 610 if {[lsearch -exact $valid $itk_option(-state)] < 0} { 611 611 error "bad value \"$itk_option(-state)\": should be [join $valid {, }]" 612 612 } 613 613 $itk_component(value) configure -state $itk_option(-state) … … 623 623 itcl::configbody Rappture::Gauge::spectrum { 624 624 if {$itk_option(-spectrum) != "" 625 626 627 625 && ([catch {$itk_option(-spectrum) isa ::Rappture::Spectrum} valid] 626 || !$valid)} { 627 error "bad option \"$itk_option(-spectrum)\": should be Rappture::Spectrum object" 628 628 } 629 629 _resize … … 637 637 itcl::configbody Rappture::Gauge::image { 638 638 if {$itk_option(-image) != "" 639 640 639 && [catch {image width $itk_option(-image)}]} { 640 error "bad value \"$itk_option(-image)\": should be Tk image" 641 641 } 642 642 _resize … … 650 650 itcl::configbody Rappture::Gauge::units { 651 651 if {$itk_option(-units) != "" 652 653 652 && [::Rappture::Units::System::for $itk_option(-units)] == ""} { 653 error "unrecognized system of units \"$itk_option(-units)\"" 654 654 } 655 655 } … … 662 662 set opts {left right top bottom} 663 663 if {[lsearch -exact $opts $pos] < 0} { 664 664 error "bad value \"$pos\": should be [join $opts {, }]" 665 665 } 666 666 _layout … … 672 672 itcl::configbody Rappture::Gauge::presets { 673 673 if {"" == $itk_option(-presets)} { 674 674 pack forget $itk_component(presets) 675 675 } else { 676 677 678 679 680 681 682 683 684 685 676 if {$itk_option(-valueposition) == "left"} { 677 set s "left" 678 } else { 679 set s "right" 680 } 681 set first [lindex [pack slaves $itk_component(vframe)] 0] 682 pack $itk_component(presets) -before $first -side $s -fill y 683 684 $itk_component(presetlist) delete 0 end 685 $itk_component(presetlist) insert end $itk_option(-presets) 686 686 } 687 687 } … … 692 692 itcl::configbody Rappture::Gauge::type { 693 693 switch -- $itk_option(-type) { 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 } 709 } 694 integer { 695 set first [lindex [pack slaves $itk_component(vframe)] 0] 696 if {$first == $itk_component(presets)} { 697 pack $itk_component(spinner) -after $first -side left -fill y 698 } else { 699 pack $itk_component(spinner) -before $first -side right -fill y 700 } 701 } 702 real { 703 pack forget $itk_component(spinner) 704 } 705 default { 706 error "bad number type \"$itk_option(-type)\": should be integer or real" 707 } 708 } 709 }
Note: See TracChangeset
for help on using the changeset viewer.
