source: trunk/tester/scripts/objview.tcl @ 4503

Last change on this file since 4503 was 3177, checked in by mmc, 8 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.

File size: 12.2 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: objview - show an overview of a Rappture object
3#
4#  This component is used when examining the details of a particular
5#  diff.  It shows an overview of the affected object, so the user
6#  can understand where the diff is coming from.  The overview can be
7#  short or long, and the widget can show the object itself or any
8#  diffs in the test object.
9# ======================================================================
10#  AUTHOR:  Michael McLennan, Purdue University
11#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
12#
13#  See the file "license.terms" for information on usage and
14#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15# ======================================================================
16package require Itk
17package require RapptureGUI
18
19namespace eval Rappture::Tester { # forward declaration }
20
21option add *ObjView.headingFont {Arial -12 bold} widgetDefault
22option add *ObjView.infoFont {Arial -12} widgetDefault
23option add *ObjView.codeFont {Courier -12} widgetDefault
24option add *ObjView.addedBackground #ccffcc widgetDefault
25option add *ObjView.deletedBackground #ffcccc widgetDefault
26
27itcl::class Rappture::Tester::ObjView {
28    inherit itk::Widget
29
30    itk_option define -testobj testObj TestObj ""
31    itk_option define -path path Path ""
32    itk_option define -details details Details "min"
33    itk_option define -showdiffs showDiffs ShowDiffs "off"
34
35    itk_option define -addedbackground addedBackground Background ""
36    itk_option define -deletedbackground deletedBackground Background ""
37    itk_option define -infofont infoFont Font ""
38    itk_option define -codefont codeFont Font ""
39
40    constructor {args} { # defined later }
41
42    protected method _reload {}
43
44    private variable _dispatcher ""  ;# dispatcher for !events
45}
46
47# ----------------------------------------------------------------------
48# CONSTRUCTOR
49# ----------------------------------------------------------------------
50itcl::body Rappture::Tester::ObjView::constructor {args} {
51    Rappture::dispatcher _dispatcher
52    $_dispatcher register !reload
53    $_dispatcher dispatch $this !reload "[itcl::code $this _reload]; list"
54
55    # object icon on the left-hand side
56    itk_component add icon {
57        label $itk_interior.icon
58    }
59
60    # create label/value for "path" parameter -- this is a special case
61    itk_component add lpath {
62        label $itk_interior.lpath -text "Identifier:"
63    } {
64        usual
65        rename -font -headingfont headingFont Font
66    }
67
68    itk_component add vpath {
69        label $itk_interior.vpath -justify left -anchor w
70    } {
71        usual
72        rename -font -codefont codeFont Font
73    }
74
75    # set up the layout to resize properly
76    grid columnconfigure $itk_interior 2 -weight 1
77
78    eval itk_initialize $args
79}
80
81itk::usual ObjView {
82    keep -background -foreground -cursor
83}
84
85# ----------------------------------------------------------------------
86# USAGE: _reload
87#
88# Called internally to load information from the object at the
89# current -path in the -testobj XML definition.
90# ----------------------------------------------------------------------
91itcl::body Rappture::Tester::ObjView::_reload {} {
92    set testobj $itk_option(-testobj)
93    set path $itk_option(-path)
94
95    # clear everything out
96    foreach win [grid slaves $itk_interior] {
97        grid forget $win
98    }
99    grid $itk_component(icon) -row 0 -rowspan 6 -column 0 \
100        -sticky ne -padx {0 20}
101
102    # look for an object at the path
103    set type ""
104    if {$testobj ne "" && $path ne ""} {
105        set type [$testobj getTestInfo element -as type $path]
106        if {$type eq ""} {
107            set type [$testobj getRunInfo element -as type $path]
108        }
109    }
110
111    if {$type eq ""} {
112        $itk_component(icon) configure -image ""
113    } else {
114        set icon [Rappture::objects::get $type -image]
115        $itk_component(icon) configure -image $icon
116
117        # decide what to show -- short or long format
118        set items {label description path}
119        foreach rec [Rappture::objects::get $type -attributes] {
120            set name [lindex $rec 0]
121            array set attr [lrange $rec 1 end]
122            set titles($name) $attr(-title)
123            set loc($name) $path.$attr(-path)
124            set path2attr($path.$attr(-path)) $name
125
126            if {$itk_option(-details) == "max" && [lsearch $items $name] < 0} {
127                lappend items $name
128            }
129        }
130
131        # if we're showing diffs, query them now
132        if {$itk_option(-showdiffs)} {
133            foreach rec [$testobj getDiffs $path] {
134                catch {unset df}
135                array set df $rec
136                if {[lindex $df(-what) 0] eq "attr"} {
137                    set apath $df(-path).[lindex $df(-what) 2]
138
139                    if {[info exists path2attr($apath)]} {
140                        # store the diff for this attribute -- we need it below
141                        set name $path2attr($apath)
142                        set diffs($name) [list [lindex $df(-what) 1] $df(-v1) $df(-v2)]
143                    }
144                }
145            }
146        }
147
148        # run through the items and show values
149        set row 0
150        foreach aname $items {
151            set show 0
152            if {$aname == "path"} {
153                # use a special widget to handle the "path" report
154                set lcomp "lpath"
155                set vcomp "vpath"
156                $itk_component(vpath) configure -text $path
157                set show 1
158            } else {
159                # get a label with the attribute name for this row
160                set lcomp "lattr$row"
161                if {![info exists itk_component($lcomp)]} {
162                    itk_component add $lcomp {
163                        label $itk_interior.$lcomp
164                    } {
165                        usual
166                        rename -font -headingfont headingFont Font
167                    }
168                }
169                $itk_component($lcomp) configure -text "$titles($aname):"
170
171                set vcomp ""
172                set bg [cget -background]
173                set fn $itk_option(-infofont)
174
175                if {[info exists diffs($aname)]} {
176                    set show 1
177                    set fn $itk_option(-codefont)
178
179                    foreach {op v1 v2} $diffs($aname) break
180                    switch -- $op {
181                        - {
182                            # use a normal label below, but change the bg
183                            set bg $itk_option(-deletedbackground)
184                            set str $v1
185                        }
186                        + {
187                            # use a normal label below, but change the bg
188                            set bg $itk_option(-addedbackground)
189                            set str $v2
190                        }
191                        c {
192                            # get a value that can show diffs on this row
193                            set vcomp "vdiff$row"
194                            if {![info exists itk_component($vcomp)]} {
195                                itk_component add $vcomp {
196                                    Rappture::Scroller \
197                                        $itk_interior.$vcomp \
198                                        -xscrollmode auto -yscrollmode auto \
199                                        -height 1i
200                                }
201                                itk_component add ${vcomp}val {
202                                    Rappture::Diffview \
203                                        $itk_component($vcomp).dv \
204                                        -borderwidth 0 \
205                                        -diff 1->2 -layout inline
206                                }
207                                $itk_component($vcomp) contents \
208                                    $itk_component(${vcomp}val)
209                            }
210                            set dv $itk_component(${vcomp}val)
211                            $dv text 1 $v1
212                            $dv text 2 $v2
213
214                            # more than a 1-line diff? then show scrollbars
215                            if {[llength [split $v1 \n]] > 1
216                                 || [llength [split $v2 \n]] > 1} {
217                                $itk_component($vcomp) configure \
218                                    -yscrollmode auto -height 1i
219                            } else {
220                                foreach {x0 y0 x1 y1} [$dv bbox all] break
221                                set bd [$dv cget -borderwidth]
222                                set yht [expr {$y1-$y0+2*$bd}]
223                                $itk_component($vcomp) configure \
224                                    -yscrollmode off -height $yht
225                            }
226                        }
227                    }
228                } else {
229                    # no diff -- get the attribute value
230                    set str [$testobj getTestInfo $loc($aname)]
231                }
232
233                # don't have a diff comp from above? then create a viewer here
234                if {$vcomp eq "" && $str ne ""} {
235                    set show 1
236                    set lines [split $str \n]
237                    if {[llength $lines] > 2
238                          || [string length [lindex $lines 0]] > 40
239                          || [string length [lindex $lines 1]] > 40} {
240
241                        # long string -- use a scroller and a text area
242                        set vcomp "vattrlong$row"
243                        if {![info exists itk_component($vcomp)]} {
244                            itk_component add $vcomp {
245                                Rappture::Scroller $itk_interior.$vcomp \
246                                    -xscrollmode auto -yscrollmode auto \
247                                    -height 1i
248                            }
249                            itk_component add ${vcomp}val {
250                                text $itk_component($vcomp).tx -wrap word
251                            }
252                            $itk_component($vcomp) contents \
253                                $itk_component(${vcomp}val)
254                        }
255                        set tx $itk_component(${vcomp}val)
256                        $tx configure -state normal
257                        $tx delete 1.0 end
258                        $tx insert end $str
259                        $tx configure -state disabled -background $bg -font $fn
260                    } else {
261                        # short string -- use a 1-line label
262                        set vcomp "vattr$row"
263                        if {![info exists itk_component($vcomp)]} {
264                            itk_component add $vcomp {
265                                label $itk_interior.$vcomp \
266                                    -justify left -anchor w
267                            } {
268                                usual
269                                rename -font -infofont infoFont Font
270                            }
271                        }
272                        $itk_component($vcomp) configure -text $str \
273                            -background $bg -font $fn
274                    }
275                }
276
277            }
278            grid rowconfigure $itk_interior $row -weight 0
279
280            if {$show} {
281                grid $itk_component($lcomp) -row $row -column 1 \
282                    -sticky e -pady 2
283                grid $itk_component($vcomp) -row $row -column 2 \
284                    -sticky ew -pady 2
285                incr row
286            }
287        }
288        grid rowconfigure $itk_interior $row -weight 1
289    }
290}
291
292# ----------------------------------------------------------------------
293# CONFIGURATION OPTIONS
294# ----------------------------------------------------------------------
295itcl::configbody Rappture::Tester::ObjView::testobj {
296    $_dispatcher event -idle !reload
297}
298itcl::configbody Rappture::Tester::ObjView::path {
299    $_dispatcher event -idle !reload
300}
301itcl::configbody Rappture::Tester::ObjView::details {
302    if {[lsearch {min max} $itk_option(-details)] < 0} {
303        error "bad value \"$itk_option(-details)\": should be min, max"
304    }
305    $_dispatcher event -idle !reload
306}
307itcl::configbody Rappture::Tester::ObjView::showdiffs {
308    if {![string is boolean -strict $itk_option(-showdiffs)]} {
309        error "bad value \"$itk_option(-showdiffs)\": should be boolean"
310    }
311    $_dispatcher event -idle !reload
312}
Note: See TracBrowser for help on using the repository browser.