- Timestamp:
- May 17, 2010, 6:26:29 PM (14 years ago)
- Location:
- trunk
- Files:
-
- 2 added
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/examples/zoo/binary/tardir.tcl
r702 r1715 21 21 close $fid 22 22 23 catch {exec tar tvzf $file} dir 23 set status [catch {exec tar tvzf $file} result] 24 24 file delete -force $file 25 25 26 if {$status != 0} { 27 puts stderr "ERROR: $result" 28 exit 1 29 } 30 26 31 $driver put output.string(dir).about.label "Contents" 27 $driver put output.string(dir).current $ dir32 $driver put output.string(dir).current $result 28 33 29 34 $driver put output.string(tarball).about.label "Original Tar File" -
trunk/examples/zoo/binary/tool.xml
r684 r1715 19 19 <description>Upload a gzipped tar file (Unix-style archive file).</description> 20 20 </about> 21 <size> 60x10</size>21 <size>binary</size> 22 22 <default></default> 23 23 </string> -
trunk/examples/zoo/image/tool.xml
r1587 r1715 23 23 </loader> 24 24 <image> 25 <about><diffs>ignore</diffs></about> 25 <about> 26 <label>Image</label> 27 <description>Input image that gets rotated.</description> 28 <diffs>ignore</diffs> 29 </about> 30 <convert>bmp</convert> 26 31 </image> 27 32 <number id="angle"> -
trunk/gui/scripts/imageentry.tcl
r1342 r1715 27 27 public method tooltip {} 28 28 29 private method _redraw {} 29 protected method _redraw {} 30 protected method _outline {imh color} 31 protected method _uploadValue {args} 32 protected method _downloadValue {} 30 33 31 34 private variable _owner "" ;# thing managing this control 32 35 private variable _path "" ;# path in XML to this image 36 private variable _data "" ;# current image data 33 37 private variable _imh "" ;# image handle for current value 34 38 private variable _resize "" ;# image for resize operations 39 40 private common _thumbsize 100 ;# std size for thumbnail images 35 41 } 36 42 … … 51 57 set _owner $owner 52 58 set _path $path 59 set _resize [image create photo] 53 60 54 61 # 55 62 # Create the widget and configure it properly based on other 56 # hints in the XML. 63 # hints in the XML. Two ways to display: Old apps use images 64 # without labels as decorations. In that case, show the image 65 # alone, probably full size. Newer apps use images as inputs. 66 # In that case, show a thumbnail of the image with some extra 67 # facts about image type, file size, etc. 57 68 # 58 69 itk_component add image { 59 70 ::label $itk_interior.image -borderwidth 0 60 71 } 61 pack $itk_component(image) -expand yes -fill both 62 bind $itk_component(image) <Configure> [itcl::code $this _redraw] 72 73 itk_component add info { 74 ::label $itk_interior.info -borderwidth 0 -width 5 \ 75 -anchor w -justify left 76 } 77 78 itk_component add rmenu { 79 menu $itk_interior.menu -tearoff 0 80 } { 81 usual 82 ignore -tearoff 83 } 84 $itk_component(rmenu) add command \ 85 -label [Rappture::filexfer::label upload] \ 86 -command [itcl::code $this _uploadValue -start] 87 $itk_component(rmenu) add command \ 88 -label [Rappture::filexfer::label download] \ 89 -command [itcl::code $this _downloadValue] 90 91 92 if {[string length [label]] == 0} { 93 # old mode -- big image 94 pack $itk_component(image) -expand yes -fill both 95 bind $itk_component(image) <Configure> [itcl::code $this _redraw] 96 } else { 97 # new mode -- thumbnail and details 98 pack $itk_component(image) -side left 99 pack $itk_component(info) -side left -expand yes -fill both -padx 4 100 101 bind $itk_component(image) <<PopupMenu>> \ 102 [list tk_popup $itk_component(rmenu) %X %Y] 103 bind $itk_component(info) <<PopupMenu>> \ 104 [list tk_popup $itk_component(rmenu) %X %Y] 105 106 _redraw ;# draw Empty image/info 107 } 63 108 64 109 set str [$_owner xml get $path.current] … … 114 159 } 115 160 set _imh $imh 161 set _data $newval 162 116 163 _redraw 164 117 165 return $newval 118 166 … … 124 172 # Query the value and return. 125 173 # 126 set data "" 127 if {"" != $_imh} { set data [$_imh cget -data] } 128 return $data 174 set bytes $_data 175 set fmt [$_owner xml get $_path.convert] 176 if {"" != $fmt && "" != $_imh} { 177 if {"pgm" == $fmt} { set fmt "ppm -grayscale" } 178 set bytes [eval $_imh data -format $fmt] 179 set bytes [Rappture::encoding::decode -as b64 $bytes] 180 } 181 return $bytes 129 182 } 130 183 … … 164 217 itcl::body Rappture::ImageEntry::_redraw {} { 165 218 if {"" == $_imh} { 166 $itk_component(image) configure -image "" 219 # generate a big diagonal cross-hatch image 220 set diag [Rappture::icon diag] 221 set dw [image width $diag] 222 set dh [image height $diag] 223 $_resize configure -width $_thumbsize -height $_thumbsize 224 for {set i 0} {$i < $_thumbsize/$dw+1} {incr i} { 225 for {set j 0} {$j < $_thumbsize/$dh+1} {incr j} { 226 set x [expr {$i*$dw}] 227 set y [expr {$j*$dh}] 228 $_resize copy $diag -to $x $y 229 } 230 } 231 _outline $_resize black 232 $itk_component(image) configure -image $_resize 233 $itk_component(info) configure -text "Empty" 167 234 return 168 235 } … … 172 239 $itk_component(image) configure -image "" -width $iw -height $ih 173 240 241 # 242 # Build a description of the image if the info is showing. 243 # 244 set desc "" 245 if {[string length [label]] != 0} { 246 # if data is base64-encoded, try to decode it 247 if {![regexp {^[a-zA-Z0-9+/=]+(\n[a-zA-Z0-9+/=]+)*$} $_data] 248 || [catch {Rappture::encoding::decode -as b64 $_data} bytes]} { 249 # oops! not base64 -- use data directly 250 set bytes $_data 251 } 252 set desc [Rappture::utils::datatype $bytes] 253 if {[string equal $desc "Binary data"]} { 254 # generic description -- we can do a little better 255 set iw [image width $_imh] 256 set ih [image height $_imh] 257 set desc "Image, ${iw} x ${ih}" 258 } 259 append desc "\n[Rappture::utils::binsize [string length $_data]]" 260 } 261 $itk_component(info) configure -text $desc 262 263 # 264 # Put up the preview image, resizing if necessary. 265 # 174 266 set str [string trim [$_owner xml get $_path.resize]] 175 267 if {"" == $str} { … … 177 269 } 178 270 switch -glob -- $str { 179 auto {180 if {$_resize == ""} {181 set _resize [image create photo]182 }183 set w [winfo width $itk_component(image)]184 set h [winfo height $itk_component(image)]185 if {$w/double($iw) < $h/double($ih)} {186 set h [expr {round($w/double($iw)*$ih)}]187 } else {188 set w [expr {round($h/double($ih)*$iw)}]189 }190 $_resize configure -width $w -height $h191 blt::winop resample $_imh $_resize192 $itk_component(image) configure -image $_resize193 }194 271 width=* - height=* { 195 if {$_resize == ""} {196 set _resize [image create photo]197 }198 272 if {[regexp {^width=([0-9]+)$} $str match size]} { 199 273 set w $size 200 274 set h [expr {round($w*$ih/double($iw))}] 201 275 $_resize configure -width $w -height $h 202 blt::winop resample $_imh $_resize 276 $_resize blank 277 blt::winop resample $_imh $_resize box 278 _outline $_resize black 203 279 $itk_component(image) configure -image $_resize \ 204 280 -width $w -height $h … … 207 283 set w [expr {round($h*$iw/double($ih))}] 208 284 $_resize configure -width $w -height $h 209 blt::winop resample $_imh $_resize 285 $_resize blank 286 blt::winop resample $_imh $_resize box 287 _outline $_resize black 210 288 $itk_component(image) configure -image $_resize \ 211 289 -width $w -height $h … … 214 292 } 215 293 } 294 auto - none - default { 295 if {[string length [label]] == 0} { 296 # old mode -- big image with no label 297 $itk_component(image) configure -image $_imh 298 } else { 299 # new mode -- thumbnail and image info 300 set w $_thumbsize 301 set h $_thumbsize 302 $itk_component(image) configure -width $w -height $h 303 304 if {$iw <= $_thumbsize && $ih <= $_thumbsize} { 305 $_resize configure -width $iw -height $ih 306 $_resize copy $_imh 307 _outline $_resize black 308 } else { 309 # large image -- scale it down 310 if {$iw > $ih} { 311 set h [expr {round($w/double($iw)*$ih)}] 312 } else { 313 set w [expr {round($h/double($ih)*$iw)}] 314 } 315 $_resize configure -width $w -height $h 316 $_resize blank 317 blt::winop resample $_imh $_resize box 318 _outline $_resize black 319 } 320 $itk_component(image) configure -image $_resize 321 } 322 } 323 } 324 } 325 326 # ---------------------------------------------------------------------- 327 # USAGE: _outline <image> <color> 328 # 329 # Used internally to outline the given <image> with a single-pixel 330 # line of the specified <color>. Updates the image in place. 331 # ---------------------------------------------------------------------- 332 itcl::body Rappture::ImageEntry::_outline {im color} { 333 if {"" != $im} { 334 set w [image width $im] 335 set h [image height $im] 336 $im put $color -to 0 0 $w 1 337 $im put $color -to 0 0 1 $h 338 $im put $color -to 0 [expr {$h-1}] $w $h 339 $im put $color -to [expr {$w-1}] 0 $w $h 340 } 341 } 342 343 # ---------------------------------------------------------------------- 344 # USAGE: _uploadValue -start 345 # USAGE: _uploadValue -assign <key> <value> <key> <value> ... 346 # 347 # Used internally to initiate an upload operation. Prompts the 348 # user to upload into the image area of this widget. 349 # ---------------------------------------------------------------------- 350 itcl::body Rappture::ImageEntry::_uploadValue {args} { 351 set opt [lindex $args 0] 352 switch -- $opt { 353 -start { 354 set tool [Rappture::Tool::resources -appname] 355 set cntls [list $_path [label] [tooltip]] 356 Rappture::filexfer::upload \ 357 $tool $cntls [itcl::code $this _uploadValue -assign] 358 } 359 -assign { 360 array set data [lrange $args 1 end] ;# skip option 361 if {[info exists data(error)]} { 362 Rappture::Tooltip::cue $itk_component(image) $data(error) 363 } 364 if {[info exists data(data)]} { 365 Rappture::Tooltip::cue hide ;# take down note about the popup 366 if {[catch {value $data(data)} err]} { 367 Rappture::Tooltip::cue $itk_component(image) "Upload failed:\n$err" 368 } 369 } 370 } 216 371 default { 217 $itk_component(image) configure -image $_imh 218 } 372 error "bad option \"$opt\": should be -start or -assign" 373 } 374 } 375 } 376 377 # ---------------------------------------------------------------------- 378 # USAGE: _downloadValue 379 # 380 # Used internally to initiate a download operation. Takes the current 381 # value and downloads it to the user in a new browser window. 382 # ---------------------------------------------------------------------- 383 itcl::body Rappture::ImageEntry::_downloadValue {} { 384 set bytes [Rappture::encoding::decode -as b64 [$_imh data -format png]] 385 set mesg [Rappture::filexfer::download $bytes image.png] 386 387 if {"" != $mesg} { 388 Rappture::Tooltip::cue $itk_component(image) $mesg 219 389 } 220 390 } -
trunk/gui/scripts/textentry.tcl
r1342 r1715 17 17 option add *TextEntry.width 0 widgetDefault 18 18 option add *TextEntry.height 0 widgetDefault 19 option add *TextEntry.editable yes widgetDefault20 19 option add *TextEntry.textBackground white widgetDefault 21 20 option add *TextEntry*disabledForeground #a3a3a3 widgetDefault … … 32 31 inherit itk::Widget 33 32 34 itk_option define -editable editable Editable ""35 33 itk_option define -state state State "normal" 34 itk_option define -disabledforeground disabledForeground DisabledForeground "" 35 itk_option define -disabledbackground disabledBackground DisabledBackground "" 36 36 itk_option define -width width Width 0 37 37 itk_option define -height height Height 0 … … 49 49 protected method _newValue {} 50 50 protected method _edit {option args} 51 protected method _fixState {}52 51 protected method _uploadValue {args} 53 52 protected method _downloadValue {} … … 58 57 59 58 private variable _layout "" ;# entry or full text size 60 private variable _mode "ascii" ;# ascii text or binary data61 59 private variable _value "" ;# value inside the widget 62 60 private variable _size "" ;# size hint from XML … … 64 62 65 63 itk::usual TextEntry { 64 keep -foreground -background -textbackground -font -cursor 66 65 } 67 66 … … 98 97 set str [$_owner xml get $path.default] 99 98 if {"" != $str} { 100 _layout ;# must fix layout or value won't take101 99 value $str 102 100 } … … 127 125 set newval [lindex $args 0] 128 126 _setValue $newval 129 130 $_dispatcher event -idle !layout 131 event generate $itk_component(hull) <<Value>> 132 return $newval 127 _newValue 133 128 134 129 } elseif {[llength $args] != 0} { … … 139 134 # Query the value and return. 140 135 # 141 if {$_mode == "ascii"} { 142 if {$_layout == "entry"} { 143 return [$itk_component(entry) get] 144 } elseif {$_layout == "text"} { 145 return [$itk_component(text) get 1.0 end-1char] 146 } 147 } else { 148 return $_value 136 switch -- $_layout { 137 entry { 138 return [$itk_component(entry) get] 139 } 140 text { 141 return [$itk_component(text) get 1.0 end-1char] 142 } 143 binary { 144 return $_value 145 } 149 146 } 150 147 return "" … … 192 189 # and count its lines/characters. 193 190 # 194 set val "" 195 if {$_layout == "entry"} { 196 set val [$itk_component(entry) get] 197 } elseif {$_layout == "text"} { 198 set val [$itk_component(text) get 1.0 end-1char] 199 } 200 201 set chars 0 202 set lines 0 203 foreach line [split $val \n] { 204 incr lines 205 if {[string length $line] > $chars} { 206 set chars [string length $line] 191 if {[string length $_value] > 1920} { 192 # if size is really big, don't bother counting lines 193 set size "80x24" 194 } else { 195 set chars 0 196 set lines 0 197 foreach line [split $_value \n] { 198 incr lines 199 if {[string length $line] > $chars} { 200 set chars [string length $line] 201 } 207 202 } 208 } 209 incr chars 210 211 if {$lines > 1} { 212 set size "${chars}x${lines}" 213 } else { 214 set size $chars 215 } 216 } 217 218 if {[regexp {^[0-9]+$} $size]} { 219 # 220 # If the size is WW, then flip to entry mode, with 221 # a requested size of WW characters. 222 # 223 if {$_layout != "entry"} { 224 set val "" 225 if {$_layout == "text"} { 226 set val [$itk_component(text) get 1.0 end-1char] 227 destroy $itk_component(text) 228 destroy $itk_component(scrollbars) 203 incr chars 204 205 if {$lines > 1} { 206 set size "${chars}x${lines}" 207 } else { 208 set size $chars 229 209 } 230 231 itk_component add entry { 232 entry $itk_interior.entry 233 } { 234 usual 235 rename -background -textbackground textBackground Background 236 rename -foreground -textforeground textForeground Foreground 237 } 210 } 211 } 212 213 if {$size == "binary" || [Rappture::encoding::is binary $_value]} { 214 set newlayout "binary" 215 } elseif {[regexp {^[0-9]+$} $size]} { 216 set newlayout "entry" 217 } elseif {[regexp {^([0-9]+)x([0-9]+)$} $size match w h]} { 218 set newlayout "text" 219 } 220 221 if {$newlayout != $_layout} { 222 set oldval "" 223 if {$_layout == "entry"} { 224 set oldval [$itk_component(entry) get] 225 } elseif {$_layout == "text"} { 226 set oldval [$itk_component(text) get 1.0 end-1char] 227 } 228 229 # take down any existing widget 230 foreach win [pack slaves $itk_interior] { 231 pack forget $win 232 } 233 234 switch -- $newlayout { 235 entry { 236 # don't have the entry widget yet? then create it 237 if {![winfo exists $itk_interior.entry]} { 238 itk_component add entry { 239 entry $itk_interior.entry 240 } { 241 usual 242 rename -background -textbackground textBackground Background 243 rename -foreground -textforeground textForeground Foreground 244 } 245 $itk_component(entry) configure \ 246 -background $itk_option(-textbackground) \ 247 -foreground $itk_option(-textforeground) 248 249 bind $itk_component(entry) <KeyPress> \ 250 [itcl::code $this _newValue] 251 bind $itk_component(entry) <Control-KeyPress-a> \ 252 "[list $itk_component(entry) selection range 0 end]; break" 253 254 itk_component add emenu { 255 menu $itk_component(entry).menu -tearoff 0 256 } 257 $itk_component(emenu) add command \ 258 -label "Cut" -accelerator "^X" \ 259 -command [list event generate $itk_component(entry) <<Cut>>] 260 $itk_component(emenu) add command \ 261 -label "Copy" -accelerator "^C" \ 262 -command [list event generate $itk_component(entry) <<Copy>>] 263 $itk_component(emenu) add command \ 264 -label "Paste" -accelerator "^V" \ 265 -command [list event generate $itk_component(entry) <<Paste>>] 266 $itk_component(emenu) add command \ 267 -label "Select All" -accelerator "^A" \ 268 -command [list $itk_component(entry) selection range 0 end] 269 bind $itk_component(entry) <<PopupMenu>> \ 270 [itcl::code $this _edit menu emenu %X %Y] 271 } 272 273 # show the entry widget 238 274 pack $itk_component(entry) -expand yes -fill both 239 $itk_component(entry) configure \ 240 -background $itk_option(-textbackground) \ 241 -foreground $itk_option(-textforeground) 242 243 bind $itk_component(entry) <KeyPress> [itcl::code $this _newValue] 244 bind $itk_component(entry) <Control-KeyPress-a> \ 245 "[list $itk_component(entry) selection range 0 end]; break" 246 247 itk_component add emenu { 248 menu $itk_component(entry).menu -tearoff 0 249 } 250 $itk_component(emenu) add command -label "Cut" -accelerator "^X" \ 251 -command [list event generate $itk_component(entry) <<Cut>>] 252 $itk_component(emenu) add command -label "Copy" -accelerator "^C" \ 253 -command [list event generate $itk_component(entry) <<Copy>>] 254 $itk_component(emenu) add command -label "Paste" -accelerator "^V" \ 255 -command [list event generate $itk_component(entry) <<Paste>>] 256 $itk_component(emenu) add command -label "Select All" -accelerator "^A" -command [list $itk_component(entry) selection range 0 end] 257 bind $itk_component(entry) <<PopupMenu>> \ 258 [itcl::code $this _edit menu emenu %X %Y] 259 260 set _layout "entry" 261 _setValue $val 262 } 263 $itk_component(entry) configure -width $size 264 265 } elseif {[regexp {^([0-9]+)x([0-9]+)$} $size match w h]} { 266 # 267 # If the size is WWxHH, then flip to text mode, with 268 # a requested size of HH lines by WW characters. 269 # 270 if {$_layout != "text"} { 271 set val "" 272 if {$_layout == "entry"} { 273 set val [$itk_component(entry) get] 274 destroy $itk_component(entry) 275 } 276 277 itk_component add scrollbars { 278 Rappture::Scroller $itk_interior.scrl \ 279 -xscrollmode auto -yscrollmode auto 280 } 275 276 # load any previous value 277 regsub -all "\n" $oldval "" oldval 278 $itk_component(entry) delete 0 end 279 $itk_component(entry) insert end $oldval 280 } 281 282 text { 283 if {![winfo exists $itk_interior.scrl]} { 284 itk_component add scrollbars { 285 Rappture::Scroller $itk_interior.scrl \ 286 -xscrollmode auto -yscrollmode auto 287 } 288 289 itk_component add text { 290 text $itk_component(scrollbars).text \ 291 -width 1 -height 1 -wrap char 292 } { 293 usual 294 rename -background -textbackground textBackground Background 295 rename -foreground -textforeground textForeground Foreground 296 rename -font -codefont codeFont CodeFont 297 } 298 $itk_component(text) configure \ 299 -background $itk_option(-textbackground) \ 300 -foreground $itk_option(-textforeground) \ 301 -font $itk_option(-codefont) 302 $itk_component(scrollbars) contents $itk_component(text) 303 304 bind $itk_component(text) <KeyPress> \ 305 [itcl::code $this _newValue] 306 bind $itk_component(text) <Control-KeyPress-a> \ 307 "[list $itk_component(text) tag add sel 1.0 end]; break" 308 309 itk_component add tmenu { 310 menu $itk_component(text).menu -tearoff 0 311 } 312 $itk_component(tmenu) add command \ 313 -label "Cut" -accelerator "^X" \ 314 -command [list event generate $itk_component(text) <<Cut>>] 315 $itk_component(tmenu) add command \ 316 -label "Copy" -accelerator "^C" \ 317 -command [list event generate $itk_component(text) <<Copy>>] 318 $itk_component(tmenu) add command \ 319 -label "Paste" -accelerator "^V" \ 320 -command [list event generate $itk_component(text) <<Paste>>] 321 $itk_component(tmenu) add command \ 322 -label "Select All" -accelerator "^A" \ 323 -command [list $itk_component(text) tag add sel 1.0 end] 324 $itk_component(tmenu) add separator 325 326 $itk_component(tmenu) add command \ 327 -label [Rappture::filexfer::label upload] \ 328 -command [itcl::code $this _uploadValue -start] 329 $itk_component(tmenu) add command \ 330 -label [Rappture::filexfer::label download] \ 331 -command [itcl::code $this _downloadValue] 332 333 bind $itk_component(text) <<PopupMenu>> \ 334 [itcl::code $this _edit menu tmenu %X %Y] 335 } 336 337 # show the text editor widget 281 338 pack $itk_component(scrollbars) -expand yes -fill both 282 283 itk_component add text { 284 text $itk_component(scrollbars).text \ 285 -width 1 -height 1 -wrap char 286 } { 287 usual 288 rename -background -textbackground textBackground Background 289 rename -foreground -textforeground textForeground Foreground 290 rename -font -codefont codeFont CodeFont 291 } 292 $itk_component(text) configure \ 293 -background $itk_option(-textbackground) \ 294 -foreground $itk_option(-textforeground) \ 295 -font $itk_option(-codefont) 296 $itk_component(scrollbars) contents $itk_component(text) 297 298 bind $itk_component(text) <KeyPress> [itcl::code $this _newValue] 299 bind $itk_component(text) <Control-KeyPress-a> \ 300 "[list $itk_component(text) tag add sel 1.0 end]; break" 301 302 itk_component add tmenu { 303 menu $itk_component(text).menu -tearoff 0 304 } 305 $itk_component(tmenu) add command -label "Cut" -accelerator "^X" \ 306 -command [list event generate $itk_component(text) <<Cut>>] 307 $itk_component(tmenu) add command -label "Copy" -accelerator "^C" \ 308 -command [list event generate $itk_component(text) <<Copy>>] 309 $itk_component(tmenu) add command -label "Paste" -accelerator "^V" \ 310 -command [list event generate $itk_component(text) <<Paste>>] 311 $itk_component(tmenu) add command -label "Select All" -accelerator "^A" -command [list $itk_component(text) tag add sel 1.0 end] 312 $itk_component(tmenu) add separator 313 314 $itk_component(tmenu) add command \ 315 -label [Rappture::filexfer::label upload] \ 316 -command [itcl::code $this _uploadValue -start] 317 $itk_component(tmenu) add command \ 318 -label [Rappture::filexfer::label download] \ 319 -command [itcl::code $this _downloadValue] 320 321 bind $itk_component(text) <<PopupMenu>> \ 322 [itcl::code $this _edit menu tmenu %X %Y] 323 324 set _layout "text" 325 _setValue $val 326 } 327 $itk_component(text) configure -width $w -height $h 339 $itk_component(text) configure -width $w -height $h 340 341 # load any previous value 342 $itk_component(text) delete 1.0 end 343 $itk_component(text) insert end $oldval 344 } 345 346 binary { 347 if {![winfo exists $itk_interior.bin]} { 348 itk_component add binary { 349 frame $itk_interior.bin 350 } 351 352 itk_component add binicon { 353 ::label $itk_component(binary).binicon \ 354 -image [Rappture::icon binary] -borderwidth 0 355 } 356 pack $itk_component(binicon) -side left 357 358 itk_component add bininfo { 359 ::label $itk_component(binary).bininfo \ 360 -text "Empty\n0 bytes" \ 361 -width 5 -justify left -anchor w -borderwidth 0 362 } 363 pack $itk_component(bininfo) -side left -expand yes -fill x -padx 4 364 365 itk_component add bmenu { 366 menu $itk_component(binary).menu -tearoff 0 367 } 368 $itk_component(bmenu) add command \ 369 -label [Rappture::filexfer::label upload] \ 370 -command [itcl::code $this _uploadValue -start] 371 $itk_component(bmenu) add command \ 372 -label [Rappture::filexfer::label download] \ 373 -command [itcl::code $this _downloadValue] 374 375 bind $itk_component(binicon) <<PopupMenu>> \ 376 [itcl::code $this _edit menu bmenu %X %Y] 377 bind $itk_component(bininfo) <<PopupMenu>> \ 378 [itcl::code $this _edit menu bmenu %X %Y] 379 } 380 381 # show the binary mode rep 382 pack $itk_component(binary) -side top -fill x 383 384 } 385 default { 386 error "don't know how to handle mode \"$newlayout\" for string editor" 387 } 388 } 389 set _layout $newlayout 328 390 } 329 391 … … 351 413 if {[Rappture::encoding::is binary $newval]} { 352 414 # looks like a binary file 353 set _mode "binary"354 415 set _value $newval 355 356 if {$_layout == "entry" || [string match {*x[01]} $_size]} {357 set newval [Rappture::utils::hexdump -lines 0 $_value]358 } else {359 set newval [Rappture::utils::hexdump -lines 1000 $_value]360 }361 416 } else { 362 417 # ascii file -- map carriage returns to line feeds 363 set _mode "ascii"364 set _value ""365 418 regsub -all "\r\n" $newval "\n" newval 366 419 regsub -all "\r" $newval "\n" newval 367 } 368 369 if {$_layout == "entry"} { 370 $itk_component(entry) configure -state normal 371 $itk_component(emenu) entryconfigure "Cut" -state normal 372 $itk_component(emenu) entryconfigure "Paste" -state normal 373 $itk_component(entry) delete 0 end 374 $itk_component(entry) insert 0 $newval 375 if {!$itk_option(-editable) || $_mode == "binary"} { 376 $itk_component(entry) configure -state disabled 377 $itk_component(emenu) entryconfigure "Cut" -state disabled 378 $itk_component(emenu) entryconfigure "Paste" -state disabled 379 } 380 } elseif {$_layout == "text"} { 381 $itk_component(text) configure -state normal 382 $itk_component(tmenu) entryconfigure "Cut" -state normal 383 $itk_component(tmenu) entryconfigure "Paste" -state normal 384 $itk_component(text) delete 1.0 end 385 $itk_component(text) insert end $newval 386 if {!$itk_option(-editable) || $_mode == "binary"} { 387 set hull $itk_component(hull) 388 set dfg [option get $hull disabledForeground Foreground] 389 set dbg [option get $hull disabledBackground Background] 390 $itk_component(text) configure -state disabled \ 391 -background $dbg -foreground $dfg 392 $itk_component(tmenu) entryconfigure "Cut" -state disabled 393 $itk_component(tmenu) entryconfigure "Paste" -state disabled 394 } else { 395 $itk_component(text) configure \ 396 -background $itk_option(-textbackground) \ 397 -foreground $itk_option(-textforeground) 398 } 420 set _value $newval 421 } 422 423 # fix up the layout so the display widgets exist, then load the new value 424 _layout 425 426 switch -- $_layout { 427 entry { 428 $itk_component(entry) configure -state normal 429 $itk_component(entry) delete 0 end 430 $itk_component(entry) insert end $_value 431 $itk_component(entry) configure -state $itk_option(-state) 432 } 433 text { 434 $itk_component(text) configure -state normal 435 $itk_component(text) delete 1.0 end 436 $itk_component(text) insert end $_value 437 $itk_component(text) configure -state $itk_option(-state) 438 } 439 binary { 440 set desc [Rappture::utils::datatype $_value] 441 append desc "\n[Rappture::utils::binsize [string length $_value]]" 442 $itk_component(bininfo) configure -text $desc 443 } 399 444 } 400 445 } … … 432 477 error "bad option \"$option\": should be menu" 433 478 } 434 }435 }436 437 # ----------------------------------------------------------------------438 # USAGE: _fixState439 #440 # Used internally to update the internal widgets whenever the441 # -state/-editable options change. Enables or disables various442 # widgets.443 # ----------------------------------------------------------------------444 itcl::body Rappture::TextEntry::_fixState {} {445 if {$itk_option(-editable) && $itk_option(-state) == "normal"} {446 set state normal447 } else {448 set state disabled449 }450 if {$_layout == "entry"} {451 $itk_component(entry) configure -state $state452 $itk_component(emenu) entryconfigure "Cut" -state $state453 $itk_component(emenu) entryconfigure "Copy" -state $state454 $itk_component(emenu) entryconfigure "Paste" -state $state455 } elseif {$_layout == "text"} {456 $itk_component(text) configure -state $state457 $itk_component(tmenu) entryconfigure "Cut" -state $state458 $itk_component(tmenu) entryconfigure "Copy" -state $state459 $itk_component(tmenu) entryconfigure "Paste" -state $state460 479 } 461 480 } … … 520 539 521 540 # ---------------------------------------------------------------------- 522 # CONFIGURATION OPTION: -editable523 # ----------------------------------------------------------------------524 itcl::configbody Rappture::TextEntry::editable {525 if {![string is boolean -strict $itk_option(-editable)]} {526 error "bad value \"$itk_option(-editable)\": should be boolean"527 }528 _fixState529 }530 531 # ----------------------------------------------------------------------532 541 # CONFIGURATION OPTION: -state 533 542 # ---------------------------------------------------------------------- … … 535 544 set valid {normal disabled} 536 545 if {[lsearch -exact $valid $itk_option(-state)] < 0} { 537 error "bad value \"$itk_option(-state)\": should be [join $valid {, }]" 538 } 539 if {$_layout == "text"} { 540 if {$itk_option(-state) == "disabled"} { 541 set fg [option get $itk_component(text) disabledForeground Foreground] 542 } else { 543 set fg $itk_option(-foreground) 544 } 545 $itk_component(text) configure -foreground $fg 546 } 547 _fixState 546 error "bad value \"$itk_option(-state)\": should be [join $valid {, }]" 547 } 548 if {[info exists itk_component(text)]} { 549 $itk_component(text) configure -state $itk_option(-state) 550 $itk_component(tmenu) entryconfigure "Cut" -state $itk_option(-state) 551 $itk_component(tmenu) entryconfigure "Copy" -state $itk_option(-state) 552 $itk_component(tmenu) entryconfigure "Paste" -state $itk_option(-state) 553 if {$itk_option(-state) == "disabled"} { 554 $itk_component(text) configure \ 555 -foreground $itk_option(-disabledforeground) \ 556 -background $itk_option(-disabledbackground) 557 } else { 558 $itk_component(text) configure \ 559 -foreground $itk_option(-foreground) \ 560 -background $itk_option(-textbackground) 561 } 562 } 563 if {[info exists itk_component(entry)]} { 564 $itk_component(entry) configure -state $itk_option(-state) 565 $itk_component(emenu) entryconfigure "Cut" -state $itk_option(-state) 566 $itk_component(emenu) entryconfigure "Copy" -state $itk_option(-state) 567 $itk_component(emenu) entryconfigure "Paste" -state $itk_option(-state) 568 } 548 569 } 549 570 -
trunk/gui/scripts/utils.tcl
r1342 r1715 31 31 set args "" 32 32 33 set size [string length $newval] 34 foreach {factor units} { 35 1073741824 GB 36 1048576 MB 37 1024 kB 38 1 bytes 39 } { 40 if {$size/$factor > 0} { 41 if {$factor > 1} { 42 set size [format "%.2f" [expr {double($size)/$factor}]] 43 } 44 break 45 } 46 } 47 48 set rval "<binary> $size $units" 33 set rval "<binary> [Rappture::utils::binsize [string length $newval]]" 49 34 50 35 if {$params(-lines) != "unlimited" && $params(-lines) <= 0} { … … 84 69 return $rval 85 70 } 71 72 # ---------------------------------------------------------------------- 73 # USAGE: binsize <length> 74 # 75 # Returns a user-friendly expression of data size, like "12 kB" or 76 # "144 MB". 77 # ---------------------------------------------------------------------- 78 proc Rappture::utils::binsize {size} { 79 foreach {factor units} { 80 1073741824 GB 81 1048576 MB 82 1024 kB 83 1 bytes 84 } { 85 if {$size/$factor > 0} { 86 if {$factor > 1} { 87 set size [format "%.1f" [expr {double($size)/$factor}]] 88 } 89 break 90 } 91 } 92 return "$size $units" 93 } 94 95 # ---------------------------------------------------------------------- 96 # USAGE: datatype <binary> 97 # 98 # Examines the given <binary> string and returns a description of 99 # the data format. 100 # ---------------------------------------------------------------------- 101 proc Rappture::utils::datatype {binary} { 102 set fileprog [auto_execok file] 103 if {[string length $binary] == 0} { 104 set desc "Empty" 105 } elseif {"" != $fileprog} { 106 # 107 # Use Unix "file" program to get info about type 108 # HACK ALERT! must send binary data in by creating a tmp file 109 # or else it gets corrupted and misunderstood 110 # 111 set id [pid] 112 while {[file exists /tmp/datatype$id]} { 113 incr id 114 } 115 set fname "/tmp/datatype$id" 116 set fid [open $fname w] 117 fconfigure $fid -translation binary -encoding binary 118 puts -nonewline $fid [string range $binary 0 1024] 119 close $fid 120 if {[catch {exec $fileprog -b $fname} desc]} { 121 set desc "Binary data" 122 } 123 catch {file delete $fname} 124 } else { 125 set desc "Binary data" 126 } 127 return $desc 128 }
Note: See TracChangeset
for help on using the changeset viewer.