Changeset 1715


Ignore:
Timestamp:
May 17, 2010, 6:26:29 PM (14 years ago)
Author:
mmc
Message:

Fixed the image object to act more like a true input. If an image has a
label, it will show a thumbnail along with image info, and users can
right-click to get upload/download options. If there's no label, then
the image is shown full-size as before, so it acts like a decoration.

Changed binary string values to look like the image, with an icon representing
binary data and an info string showing info about the data type. This is
a little nicer than the hex dump we used to show for binary strings. String
size can be set to "binary" to force the string into the binary display
mode.

Location:
trunk
Files:
2 added
6 edited

Legend:

Unmodified
Added
Removed

  • trunk/examples/zoo/binary/tardir.tcl

    r702 r1715  
    2121close $fid
    2222
    23 catch {exec tar tvzf $file} dir
     23set status [catch {exec tar tvzf $file} result]
    2424file delete -force $file
    2525
     26if {$status != 0} {
     27    puts stderr "ERROR: $result"
     28    exit 1
     29}
     30
    2631$driver put output.string(dir).about.label "Contents"
    27 $driver put output.string(dir).current $dir
     32$driver put output.string(dir).current $result
    2833
    2934$driver put output.string(tarball).about.label "Original Tar File"

  • trunk/examples/zoo/binary/tool.xml

    r684 r1715  
    1919      <description>Upload a gzipped tar file (Unix-style archive file).</description>
    2020    </about>
    21     <size>60x10</size>
     21    <size>binary</size>
    2222    <default></default>
    2323  </string>

  • trunk/examples/zoo/image/tool.xml

    r1587 r1715  
    2323  </loader>
    2424  <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>
    2631  </image>
    2732  <number id="angle">

  • trunk/gui/scripts/imageentry.tcl

    r1342 r1715  
    2727    public method tooltip {}
    2828
    29     private method _redraw {}
     29    protected method _redraw {}
     30    protected method _outline {imh color}
     31    protected method _uploadValue {args}
     32    protected method _downloadValue {}
    3033
    3134    private variable _owner ""    ;# thing managing this control
    3235    private variable _path ""     ;# path in XML to this image
     36    private variable _data ""     ;# current image data
    3337    private variable _imh ""      ;# image handle for current value
    3438    private variable _resize ""   ;# image for resize operations
     39
     40    private common _thumbsize 100 ;# std size for thumbnail images
    3541}
    3642
    … …  
    5157    set _owner $owner
    5258    set _path $path
     59    set _resize [image create photo]
    5360
    5461    #
    5562    # 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.
    5768    #
    5869    itk_component add image {
    5970        ::label $itk_interior.image -borderwidth 0
    6071    }
    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    }
    63108
    64109    set str [$_owner xml get $path.current]
    … …  
    114159        }
    115160        set _imh $imh
     161        set _data $newval
     162
    116163        _redraw
     164
    117165        return $newval
    118166
    … …  
    124172    # Query the value and return.
    125173    #
    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
    129182}
    130183
    … …  
    164217itcl::body Rappture::ImageEntry::_redraw {} {
    165218    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"
    167234        return
    168235    }
    … …  
    172239    $itk_component(image) configure -image "" -width $iw -height $ih
    173240
     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    #
    174266    set str [string trim [$_owner xml get $_path.resize]]
    175267    if {"" == $str} {
    … …  
    177269    }
    178270    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 $h
    191             blt::winop resample $_imh $_resize
    192             $itk_component(image) configure -image $_resize
    193         }
    194271        width=* - height=* {
    195             if {$_resize == ""} {
    196                 set _resize [image create photo]
    197             }
    198272            if {[regexp {^width=([0-9]+)$} $str match size]} {
    199273                set w $size
    200274                set h [expr {round($w*$ih/double($iw))}]
    201275                $_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
    203279                $itk_component(image) configure -image $_resize \
    204280                    -width $w -height $h
    … …  
    207283                set w [expr {round($h*$iw/double($ih))}]
    208284                $_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
    210288                $itk_component(image) configure -image $_resize \
    211289                    -width $w -height $h
    … …  
    214292            }
    215293        }
     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# ----------------------------------------------------------------------
     332itcl::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# ----------------------------------------------------------------------
     350itcl::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        }
    216371        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# ----------------------------------------------------------------------
     383itcl::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
    219389    }
    220390}

  • trunk/gui/scripts/textentry.tcl

    r1342 r1715  
    1717option add *TextEntry.width 0 widgetDefault
    1818option add *TextEntry.height 0 widgetDefault
    19 option add *TextEntry.editable yes widgetDefault
    2019option add *TextEntry.textBackground white widgetDefault
    2120option add *TextEntry*disabledForeground #a3a3a3 widgetDefault
    … …  
    3231    inherit itk::Widget
    3332
    34     itk_option define -editable editable Editable ""
    3533    itk_option define -state state State "normal"
     34    itk_option define -disabledforeground disabledForeground DisabledForeground ""
     35    itk_option define -disabledbackground disabledBackground DisabledBackground ""
    3636    itk_option define -width width Width 0
    3737    itk_option define -height height Height 0
    … …  
    4949    protected method _newValue {}
    5050    protected method _edit {option args}
    51     protected method _fixState {}
    5251    protected method _uploadValue {args}
    5352    protected method _downloadValue {}
    … …  
    5857
    5958    private variable _layout ""     ;# entry or full text size
    60     private variable _mode "ascii"  ;# ascii text or binary data
    6159    private variable _value ""      ;# value inside the widget
    6260    private variable _size ""       ;# size hint from XML
    … …  
    6462                                                                               
    6563itk::usual TextEntry {
     64    keep -foreground -background -textbackground -font -cursor
    6665}
    6766
    … …  
    9897    set str [$_owner xml get $path.default]
    9998    if {"" != $str} {
    100         _layout  ;# must fix layout or value won't take
    10199        value $str
    102100    }
    … …  
    127125        set newval [lindex $args 0]
    128126        _setValue $newval
    129 
    130         $_dispatcher event -idle !layout
    131         event generate $itk_component(hull) <<Value>>
    132         return $newval
     127        _newValue
    133128
    134129    } elseif {[llength $args] != 0} {
    … …  
    139134    # Query the value and return.
    140135    #
    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        }
    149146    }
    150147    return ""
    … …  
    192189        # and count its lines/characters.
    193190        #
    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                }
    207202            }
    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
    229209            }
    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
    238274            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
    281338            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
    328390    }
    329391
    … …  
    351413    if {[Rappture::encoding::is binary $newval]} {
    352414        # looks like a binary file
    353         set _mode "binary"
    354415        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         }
    361416    } else {
    362417        # ascii file -- map carriage returns to line feeds
    363         set _mode "ascii"
    364         set _value ""
    365418        regsub -all "\r\n" $newval "\n" newval
    366419        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        }
    399444    }
    400445}
    … …  
    432477            error "bad option \"$option\": should be menu"
    433478        }
    434     }
    435 }
    436 
    437 # ----------------------------------------------------------------------
    438 # USAGE: _fixState
    439 #
    440 # Used internally to update the internal widgets whenever the
    441 # -state/-editable options change.  Enables or disables various
    442 # widgets.
    443 # ----------------------------------------------------------------------
    444 itcl::body Rappture::TextEntry::_fixState {} {
    445     if {$itk_option(-editable) && $itk_option(-state) == "normal"} {
    446         set state normal
    447     } else {
    448         set state disabled
    449     }
    450     if {$_layout == "entry"} {
    451         $itk_component(entry) configure -state $state
    452         $itk_component(emenu) entryconfigure "Cut" -state $state
    453         $itk_component(emenu) entryconfigure "Copy" -state $state
    454         $itk_component(emenu) entryconfigure "Paste" -state $state
    455     } elseif {$_layout == "text"} {
    456         $itk_component(text) configure -state $state
    457         $itk_component(tmenu) entryconfigure "Cut" -state $state
    458         $itk_component(tmenu) entryconfigure "Copy" -state $state
    459         $itk_component(tmenu) entryconfigure "Paste" -state $state
    460479    }
    461480}
    … …  
    520539
    521540# ----------------------------------------------------------------------
    522 # CONFIGURATION OPTION: -editable
    523 # ----------------------------------------------------------------------
    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     _fixState
    529 }
    530 
    531 # ----------------------------------------------------------------------
    532541# CONFIGURATION OPTION: -state
    533542# ----------------------------------------------------------------------
    … …  
    535544    set valid {normal disabled}
    536545    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    }
    548569}
    549570

  • trunk/gui/scripts/utils.tcl

    r1342 r1715  
    3131    set args ""
    3232
    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]]"
    4934
    5035    if {$params(-lines) != "unlimited" && $params(-lines) <= 0} {
    … …  
    8469    return $rval
    8570}
     71
     72# ----------------------------------------------------------------------
     73# USAGE: binsize <length>
     74#
     75# Returns a user-friendly expression of data size, like "12 kB" or
     76# "144 MB".
     77# ----------------------------------------------------------------------
     78proc 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# ----------------------------------------------------------------------
     101proc 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.