Changeset 1614 for trunk/gui/scripts


Ignore:
Timestamp:
Nov 16, 2009, 3:02:37 PM (15 years ago)
Author:
dkearney
Message:

tabs

Location:
trunk/gui/scripts
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/tooltip.tcl

    r1418 r1614  
    5353
    5454    bind RapptureTooltip <Enter> \
    55         [list ::Rappture::Tooltip::tooltip pending %W]
     55        [list ::Rappture::Tooltip::tooltip pending %W]
    5656    bind RapptureTooltip <Leave> \
    57         [list ::Rappture::Tooltip::tooltip cancel]
     57        [list ::Rappture::Tooltip::tooltip cancel]
    5858    bind RapptureTooltip <ButtonPress> \
    59         [list ::Rappture::Tooltip::tooltip cancel]
     59        [list ::Rappture::Tooltip::tooltip cancel]
    6060    bind RapptureTooltip <KeyPress> \
    61         [list ::Rappture::Tooltip::tooltip cancel]
     61        [list ::Rappture::Tooltip::tooltip cancel]
    6262}
    6363
    … …  
    7777
    7878    itk_component add icon {
    79         label $itk_interior.icon -anchor n
     79        label $itk_interior.icon -anchor n
    8080    }
    8181
    8282    itk_component add text {
    83         label $itk_interior.text -justify left
     83        label $itk_interior.text -justify left
    8484    } {
    85         usual
    86         keep -wraplength
     85        usual
     86        keep -wraplength
    8787    }
    8888    pack $itk_component(text) -expand yes -fill both -ipadx 4 -ipady 4
    … …  
    109109
    110110    if {[regexp {^@([0-9]+),([0-9]+)$} $where match x y]} {
    111         set xpos $x
    112         set ypos $y
     111        set xpos $x
     112        set ypos $y
    113113    } elseif {[regexp {^(.*)([-+])([0-9]+),([-+]?)([0-9]+)$} $where match win signx x signy y]} {
    114         if {$signy == ""} { set signy $signx }
    115         set xpos [expr {[winfo rootx $win] + $x}]
    116         set ypos [expr {[winfo rooty $win] + $y}]
     114        if {$signy == ""} { set signy $signx }
     115        set xpos [expr {[winfo rootx $win] + $x}]
     116        set ypos [expr {[winfo rooty $win] + $y}]
    117117    } elseif {[winfo exists $where]} {
    118         set xpos [expr {[winfo rootx $where]+10}]
    119         set ypos [expr {[winfo rooty $where]+[winfo height $where]}]
    120     } else {
    121         error "bad position \"$where\": should be widget+x,y, or @x,y"
     118        set xpos [expr {[winfo rootx $where]+10}]
     119        set ypos [expr {[winfo rooty $where]+[winfo height $where]}]
     120    } else {
     121        error "bad position \"$where\": should be widget+x,y, or @x,y"
    122122    }
    123123
    124124    if {[string index $itk_option(-message) 0] == "@"} {
    125         set cmd [string range $itk_option(-message) 1 end]
    126         if {[catch $cmd mesg] != 0} {
    127             bgerror $mesg
    128             return
    129         }
    130     } else {
    131         set mesg $itk_option(-message)
     125        set cmd [string range $itk_option(-message) 1 end]
     126        if {[catch $cmd mesg] != 0} {
     127            bgerror $mesg
     128            return
     129        }
     130    } else {
     131        set mesg $itk_option(-message)
    132132    }
    133133
    134134    # if there's no message to show, forget it
    135135    if {[string length $mesg] == 0} {
    136         return
     136        return
    137137    }
    138138
    … …  
    140140    set pos 0
    141141    ::for {set i 0} {$pos >= 0 && $i < 20} {incr i} {
    142         incr pos
    143         set pos [string first \n $mesg $pos]
     142        incr pos
     143        set pos [string first \n $mesg $pos]
    144144    }
    145145    if {$pos > 0} {
    146         set mesg "[string range $mesg 0 $pos]..."
     146        set mesg "[string range $mesg 0 $pos]..."
    147147    }
    148148    if {[string length $mesg] > 1000} {
    149         set mesg "[string range $mesg 0 1500]..."
     149        set mesg "[string range $mesg 0 1500]..."
    150150    }
    151151    $itk_component(text) configure -text $mesg
    … …  
    156156    update idletasks
    157157    if {$signx == "+"} {
    158         if {$xpos+[winfo reqwidth $hull] > [winfo screenwidth $hull]} {
    159             set xpos [expr {[winfo screenwidth $hull]-[winfo reqwidth $hull]}]
    160         }
    161         if {$xpos < 0} { set xpos 0 }
    162     } else {
    163         if {$xpos-[winfo reqwidth $hull] < 0} {
    164             set xpos [expr {[winfo screenwidth $hull]-[winfo reqwidth $hull]}]
    165         }
    166         set xpos [expr {[winfo screenwidth $hull]-$xpos}]
     158        if {$xpos+[winfo reqwidth $hull] > [winfo screenwidth $hull]} {
     159            set xpos [expr {[winfo screenwidth $hull]-[winfo reqwidth $hull]}]
     160        }
     161        if {$xpos < 0} { set xpos 0 }
     162    } else {
     163        if {$xpos-[winfo reqwidth $hull] < 0} {
     164            set xpos [expr {[winfo screenwidth $hull]-[winfo reqwidth $hull]}]
     165        }
     166        set xpos [expr {[winfo screenwidth $hull]-$xpos}]
    167167    }
    168168
    169169    if {$signy == "+"} {
    170         if {$ypos+[winfo reqheight $hull] > [winfo screenheight $hull]} {
    171             set ypos [expr {[winfo screenheight $hull]-[winfo reqheight $hull]}]
    172         }
    173         if {$ypos < 0} { set ypos 0 }
    174     } else {
    175         if {$ypos-[winfo reqheight $hull] < 0} {
    176             set ypos [expr {[winfo screenheight $hull]-[winfo reqheight $hull]}]
    177         }
    178         set ypos [expr {[winfo screenheight $hull]-$ypos}]
     170        if {$ypos+[winfo reqheight $hull] > [winfo screenheight $hull]} {
     171            set ypos [expr {[winfo screenheight $hull]-[winfo reqheight $hull]}]
     172        }
     173        if {$ypos < 0} { set ypos 0 }
     174    } else {
     175        if {$ypos-[winfo reqheight $hull] < 0} {
     176            set ypos [expr {[winfo screenheight $hull]-[winfo reqheight $hull]}]
     177        }
     178        set ypos [expr {[winfo screenheight $hull]-$ypos}]
    179179    }
    180180
    … …  
    187187    set py [winfo pointery $hull]
    188188    if {$px >= $xpos && $px <= $xpos+[winfo reqwidth $hull]
    189           && $py >= $ypos && $py <= $ypos+[winfo reqheight $hull]} {
    190 
    191         if {$px > [winfo screenwidth $hull]/2} {
    192             set signx "-"
    193             set xpos [expr {[winfo screenwidth $hull]-$px+4}]
    194         } else {
    195             set signx "+"
    196             set xpos [expr {$px+4}]
    197         }
    198         if {$py > [winfo screenheight $hull]/2} {
    199             set signy "-"
    200             set ypos [expr {[winfo screenheight $hull]-$py+4}]
    201         } else {
    202             set signy "+"
    203             set ypos [expr {$py+4}]
    204         }
     189          && $py >= $ypos && $py <= $ypos+[winfo reqheight $hull]} {
     190
     191        if {$px > [winfo screenwidth $hull]/2} {
     192            set signx "-"
     193            set xpos [expr {[winfo screenwidth $hull]-$px+4}]
     194        } else {
     195            set signx "+"
     196            set xpos [expr {$px+4}]
     197        }
     198        if {$py > [winfo screenheight $hull]/2} {
     199            set signy "-"
     200            set ypos [expr {[winfo screenheight $hull]-$py+4}]
     201        } else {
     202            set signy "+"
     203            set ypos [expr {$py+4}]
     204        }
    205205    }
    206206
    … …  
    242242    set i [lsearch $btags RapptureTooltip]
    243243    if {$i < 0} {
    244         set i [lsearch $btags [winfo class $widget]]
    245         if {$i < 0} {set i 0}
    246         set btags [linsert $btags $i RapptureTooltip]
    247         bindtags $widget $btags
     244        set i [lsearch $btags [winfo class $widget]]
     245        if {$i < 0} {set i 0}
     246        set btags [linsert $btags $i RapptureTooltip]
     247        bindtags $widget $btags
    248248    }
    249249}
    … …  
    258258itcl::body Rappture::Tooltip::text {widget args} {
    259259    if {[llength $args] == 0} {
    260         if {[info exists catalog($widget)]} {
    261             return $catalog($widget)
    262         }
    263         return ""
     260        if {[info exists catalog($widget)]} {
     261            return $catalog($widget)
     262        }
     263        return ""
    264264    } elseif {[llength $args] == 1} {
    265         set str [lindex $args 0]
    266         set catalog($widget) $str
    267     } else {
    268         error "wrong # args: should be \"text widget ?str?\""
     265        set str [lindex $args 0]
     266        set catalog($widget) $str
     267    } else {
     268        error "wrong # args: should be \"text widget ?str?\""
    269269    }
    270270}
    … …  
    283283itcl::body Rappture::Tooltip::tooltip {option args} {
    284284    switch -- $option {
    285         pending {
    286             if {[llength $args] < 1 || [llength $args] > 2} {
    287                 error "wrong # args: should be \"tooltip pending widget ?@x,y?\""
    288             }
    289             set widget [lindex $args 0]
    290             set loc [lindex $args 1]
    291 
    292             if {![info exists catalog($widget)]} {
    293                 return;                 # No tooltip for widget.
    294             }
    295             if {$pending != ""} {
    296                 after cancel $pending
    297             }
    298             set pending [after 750 [itcl::code tooltip show $widget $loc]]
    299         }
    300         show {
    301             if {[llength $args] < 1 || [llength $args] > 2} {
    302                 error "wrong # args: should be \"tooltip show tag loc\""
    303             }
    304             set tag [lindex $args 0]
    305             set loc [lindex $args 1]
    306 
    307             # tag name may be .g-axis -- get widget ".g" part
    308             set widget $tag
    309             if {[regexp {^(\.[^-]+)-[^\.]+$} $widget match wname]} {
    310                 set widget $wname
    311             }
    312 
    313             if {[winfo exists $widget] && [info exists catalog($tag)]} {
    314                 .rappturetooltip configure -message $catalog($tag)
    315                 if {[string index $loc 0] == "@"} {
    316                     .rappturetooltip show $loc
    317                 } elseif {[regexp {^[-+]} $loc]} {
    318                     .rappturetooltip show $widget$loc
    319                 } else {
    320                     .rappturetooltip show $widget
    321                 }
    322             }
    323         }
    324         cancel {
    325             if {$pending != ""} {
    326                 after cancel $pending
    327                 set pending ""
    328             }
    329             .rappturetooltip hide
    330         }
    331         default {
    332             error "bad option \"$option\": should be show, pending, cancel"
    333         }
     285        pending {
     286            if {[llength $args] < 1 || [llength $args] > 2} {
     287                error "wrong # args: should be \"tooltip pending widget ?@x,y?\""
     288            }
     289            set widget [lindex $args 0]
     290            set loc [lindex $args 1]
     291
     292            if {![info exists catalog($widget)]} {
     293                return;                        # No tooltip for widget.
     294            }
     295            if {$pending != ""} {
     296                after cancel $pending
     297            }
     298            set pending [after 750 [itcl::code tooltip show $widget $loc]]
     299        }
     300        show {
     301            if {[llength $args] < 1 || [llength $args] > 2} {
     302                error "wrong # args: should be \"tooltip show tag loc\""
     303            }
     304            set tag [lindex $args 0]
     305            set loc [lindex $args 1]
     306
     307            # tag name may be .g-axis -- get widget ".g" part
     308            set widget $tag
     309            if {[regexp {^(\.[^-]+)-[^\.]+$} $widget match wname]} {
     310                set widget $wname
     311            }
     312
     313            if {[winfo exists $widget] && [info exists catalog($tag)]} {
     314                .rappturetooltip configure -message $catalog($tag)
     315                if {[string index $loc 0] == "@"} {
     316                    .rappturetooltip show $loc
     317                } elseif {[regexp {^[-+]} $loc]} {
     318                    .rappturetooltip show $widget$loc
     319                } else {
     320                    .rappturetooltip show $widget
     321                }
     322            }
     323        }
     324        cancel {
     325            if {$pending != ""} {
     326                after cancel $pending
     327                set pending ""
     328            }
     329            .rappturetooltip hide
     330        }
     331        default {
     332            error "bad option \"$option\": should be show, pending, cancel"
     333        }
    334334    }
    335335}
    … …  
    345345itcl::body Rappture::Tooltip::cue {option args} {
    346346    if {"hide" == $option} {
    347         grab release .rappturetoolcue
    348         .rappturetoolcue hide
     347        grab release .rappturetoolcue
     348        .rappturetoolcue hide
    349349    } elseif {[regexp {^@[0-9]+,[0-9]+$} $option] || [winfo exists $option]} {
    350         if {[llength $args] != 1} {
    351             error "wrong # args: should be \"cue location message\""
    352         }
    353         set loc $option
    354         set mesg [lindex $args 0]
    355 
    356         .rappturetoolcue configure -message $mesg
    357         .rappturetoolcue show $loc
    358 
    359         #
    360         # Add a binding to all widgets so that any keypress will
    361         # take this cue down.
    362         #
    363         set cmd [bind all <KeyPress>]
    364         if {![regexp {Rappture::Tooltip::cue} $cmd]} {
    365             bind all <KeyPress> "+[list ::Rappture::Tooltip::cue hide]"
    366             bind all <KeyPress-Return> "+ "
    367         }
    368 
    369         #
    370         # If nobody has the pointer, then grab it.  Otherwise,
    371         # we assume the pop-up editor or someone like that has
    372         # the grab, so we don't need to impose a grab here.
    373         #
    374         if {"" == [grab current]} {
    375             update
    376             while {[catch {grab set -global .rappturetoolcue}]} {
    377                 after 100
    378             }
    379         }
    380     } else {
    381         error "bad option \"$option\": should be hide, a widget name, or @x,y"
     350        if {[llength $args] != 1} {
     351            error "wrong # args: should be \"cue location message\""
     352        }
     353        set loc $option
     354        set mesg [lindex $args 0]
     355
     356        .rappturetoolcue configure -message $mesg
     357        .rappturetoolcue show $loc
     358
     359        #
     360        # Add a binding to all widgets so that any keypress will
     361        # take this cue down.
     362        #
     363        set cmd [bind all <KeyPress>]
     364        if {![regexp {Rappture::Tooltip::cue} $cmd]} {
     365            bind all <KeyPress> "+[list ::Rappture::Tooltip::cue hide]"
     366            bind all <KeyPress-Return> "+ "
     367        }
     368
     369        #
     370        # If nobody has the pointer, then grab it.  Otherwise,
     371        # we assume the pop-up editor or someone like that has
     372        # the grab, so we don't need to impose a grab here.
     373        #
     374        if {"" == [grab current]} {
     375            update
     376            while {[catch {grab set -global .rappturetoolcue}]} {
     377                after 100
     378            }
     379        }
     380    } else {
     381        error "bad option \"$option\": should be hide, a widget name, or @x,y"
    382382    }
    383383}
    … …  
    388388itcl::configbody Rappture::Tooltip::icon {
    389389    if {"" == $itk_option(-icon)} {
    390         $itk_component(icon) configure -image ""
    391         pack forget $itk_component(icon)
    392     } else {
    393         $itk_component(icon) configure -image $itk_option(-icon)
    394         pack $itk_component(icon) -before $itk_component(text) \
    395             -side left -fill y
     390        $itk_component(icon) configure -image ""
     391        pack forget $itk_component(icon)
     392    } else {
     393        $itk_component(icon) configure -image $itk_option(-icon)
     394        pack $itk_component(icon) -before $itk_component(text) \
     395            -side left -fill y
    396396    }
    397397}

  • trunk/gui/scripts/xyresult.tcl

    r1606 r1614  
    488488                # if we haven't created the popup yet, do it now
    489489                Rappture::Balloon $popup \
    490                     -title "[Rappture::filexfer::label downloadWord] as..."
     490                    -title "[Rappture::filexfer::label downloadWord] as..."
    491491                set inner [$popup component inner]
    492492                label $inner.summary -text "" -anchor w
    … …  
    559559                }
    560560                image {
    561                     set popup .xyprintdownload
    562                     if { ![winfo exists $popup] } {
    563                         # Create a popup for the print dialog
    564                         Rappture::Balloon $popup -title "Save as image..."
    565                         set inner [$popup component inner]
    566                         # Create the print dialog widget and add it to the
    567                         # the balloon popup.
    568                         Rappture::XyPrint $inner.print
    569                         $popup configure \
    570                             -deactivatecommand [list $inner.print reset]
    571                         blt::table $inner 0,0 $inner.print -fill both
    572                     }
    573                     update
    574                     # Activate the popup and call for the output.
    575                     foreach { widget toolName plotName } $args break
    576                     $popup activate $widget left
    577                     set inner [$popup component inner]
    578                     set output [$inner.print print $itk_component(plot) \
    579                                     $toolName $plotName]
    580                     $popup deactivate
     561                    set popup .xyprintdownload
     562                    if { ![winfo exists $popup] } {
     563                        # Create a popup for the print dialog
     564                        Rappture::Balloon $popup -title "Save as image..."
     565                        set inner [$popup component inner]
     566                        # Create the print dialog widget and add it to the
     567                        # the balloon popup.
     568                        Rappture::XyPrint $inner.print
     569                        $popup configure \
     570                            -deactivatecommand [list $inner.print reset]
     571                        blt::table $inner 0,0 $inner.print -fill both
     572                    }
     573                    update
     574                    # Activate the popup and call for the output.
     575                    foreach { widget toolName plotName } $args break
     576                    $popup activate $widget left
     577                    set inner [$popup component inner]
     578                    set output [$inner.print print $itk_component(plot) \
     579                                    $toolName $plotName]
     580                    $popup deactivate
    581581                    return $output
    582582                }
    … …  
    721721            set elem "elem[incr count]"
    722722            set _elem2curve($elem) $curve
    723             lappend label2elem($label) $elem
     723            lappend label2elem($label) $elem
    724724            $g element create $elem -x $xv -y $yv \
    725725                -symbol $sym -pixels $pixels -linewidth $lwidth \
    726                 -label $label \
     726                -label $label \
    727727                -color $color -dashes $dashes \
    728728                -mapx $mapx -mapy $mapy
    … …  
    732732    # Fix duplicate labels by appending the simulation number
    733733    foreach label [array names label2elem] {
    734         if { [llength $label2elem($label)] == 1 } {
    735             continue
    736         }
    737         foreach elem $label2elem($label) {
    738             set curve $_elem2curve($elem)
    739             scan [$curve hints xmlobj] "::libraryObj%d" suffix
    740             incr suffix
    741             set elabel [format "%s \#%d" $label $suffix]
    742             $g element configure $elem -label $elabel
    743         }
    744     }   
     734        if { [llength $label2elem($label)] == 1 } {
     735            continue
     736        }
     737        foreach elem $label2elem($label) {
     738            set curve $_elem2curve($elem)
     739            scan [$curve hints xmlobj] "::libraryObj%d" suffix
     740            incr suffix
     741            set elabel [format "%s \#%d" $label $suffix]
     742            $g element configure $elem -label $elabel
     743        }
     744    }       
    745745
    746746    foreach curve $_clist {
    … …  
    827827                    set logmin [expr {floor(log10(abs($min)))}]
    828828                    set logmax [expr {ceil(log10(abs($max)))}]
    829                     if 0 {
     829                    if 0 {
    830830                    if {[string match y* $axis]} {
    831831                        # add a little padding
    … …  
    835835                        set logmax [expr {$logmax+0.05*$delta}]
    836836                    }
    837                     }
     837                    }
    838838                }
    839839                if {$logmin < -300} {
    … …  
    856856                set max $_limits(${axis}lin-max)
    857857
    858                 if 0 {
     858                if 0 {
    859859                if {[string match y* $axis]} {
    860860                    # add a little padding
    … …  
    863863                    set max [expr {$max+0.05*$delta}]
    864864                }
    865                 }
     865                }
    866866            }
    867867            if {$min < $max} {
Note: See TracChangeset for help on using the changeset viewer.