source: trunk/tcl/scripts/library.tcl @ 11

Last change on this file since 11 was 11, checked in by mmc, 19 years ago

Major reorganization of the entire package. The config.xml file
is now irrelevant. All the action is in the tool.xml file. The
main program now organizes all input into 1) side-by-side pages,
2) input/result (wizard-style) pages, or 3) a series of wizard-
style pages. The <input> can have <phase> parts representing
the various pages.

Added a new ContourResult? widget based on Swaroop's vtk plotting
code.

Also, added easymesh and showmesh to the "tools" directory.
We need these for Eric Polizzi's code.
File size: 29.5 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: library - provides access to the XML library
3#
4#  These routines make it easy to load the XML description for a
5#  series of tool parameters and browse through the results.
6# ======================================================================
7#  AUTHOR:  Michael McLennan, Purdue University
8#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
9# ======================================================================
10package require tdom
11package require Itcl
12
13namespace eval Rappture {
14    variable stdlib ""
15}
16
17# ----------------------------------------------------------------------
18# USAGE: library <file>
19# USAGE: library standard
20# USAGE: library isvalid <object>
21#
22# Used to open a <file> containing an XML description of tool
23# parameters.  Loads the file and returns the name of the LibraryObj
24# file that represents it.
25#
26# If you use the word "standard" in place of the file name, this
27# function returns the standard Rappture library object, which
28# contains material definitions.
29#
30# The isvalid operation checks an <object> to see if it is a valid
31# library object.  Returns 1 if so, and 0 otherwise.
32# ----------------------------------------------------------------------
33proc Rappture::library {args} {
34    # handle the isvalid operation...
35    if {[llength $args] > 1 && [lindex $args 0] == "isvalid"} {
36        if {[llength $args] != 2} {
37            error "wrong # args: should be \"library isvalid object\""
38        }
39        set obj [lindex $args 1]
40        if {[catch {$obj isa ::Rappture::LibraryObj} valid] == 0 && $valid} {
41            return 1
42        }
43        return 0
44    }
45
46    if {[llength $args] != 1} {
47        error "wrong # args: should be \"library file\" or \"library isvalid object\""
48    }
49    set fname [lindex $args 0]
50
51    if {$fname == "standard"} {
52        variable stdlib
53        if {$stdlib != ""} {
54            return $stdlib
55        }
56        set fname [file join $Rappture::installdir lib library.xml]
57
58        set fid [::open $fname r]
59        set info [read $fid]
60        close $fid
61
62        set stdlib [Rappture::LibraryObj ::#auto $info]
63        return $stdlib
64    }
65
66    if {[regexp {^<\?[Xx][Mm][Ll]} $fname]} {
67        set info $fname
68    } else {
69        # otherwise, try to open the file and create its LibraryObj
70        set fid [::open $fname r]
71        set info [read $fid]
72        close $fid
73    }
74
75    set obj [Rappture::LibraryObj ::#auto $info]
76    return $obj
77}
78
79# ----------------------------------------------------------------------
80# USAGE: entities ?-as <fval>? <object> <path>
81#
82# Used to sift through an XML <object> for "entities" within the
83# Rappture description.  Entities are things like strings, numbers,
84# etc., which show up in the GUI as controls.
85#
86# Returns a list of all entities found beneath <path>.
87#
88# By default, this method returns the component name "type(id)".
89# This is changed by setting the -as argument to "id" (for name
90# of the tail element), to "type" (for the type of the tail element),
91# to "object" (for an object representing the DOM node referenced by
92# the path.
93# ----------------------------------------------------------------------
94proc Rappture::entities {args} {
95    array set params {
96        -as component
97    }
98    while {[llength $args] > 1} {
99        set first [lindex $args 0]
100        if {[string index $first 0] == "-"} {
101            set choices [array names params]
102            if {[lsearch $choices $first] < 0} {
103                error "bad option \"$first\": should be [join [lsort $choices] {, }]"
104            }
105            set params($first) [lindex $args 1]
106            set args [lrange $args 2 end]
107        } else {
108            break
109        }
110    }
111    if {[llength $args] > 2} {
112        error "wrong # args: should be \"entities ?-as fval? obj ?path?\""
113    }
114    set xmlobj [lindex $args 0]
115    set path [lindex $args 1]
116
117    set rlist ""
118    lappend queue $path
119    while {[llength $queue] > 0} {
120        set path [lindex $queue 0]
121        set queue [lrange $queue 1 end]
122
123        foreach cpath [$xmlobj children -as path $path] {
124            switch -- [$xmlobj element -as type $cpath] {
125                group {
126                    lappend queue $cpath
127                }
128                structure {
129                    if {[$xmlobj element $cpath.current.parameters] != ""} {
130                        lappend queue $cpath.current.parameters
131                    }
132                }
133                default {
134                    # add this to the return list with the right flavor
135                    if {$params(-as) == "component"} {
136                        lappend rlist $cpath
137                    } else {
138                        lappend rlist [$xmlobj element -as $params(-as) $cpath]
139                    }
140
141                    # if this element has embedded groups, add them to the queue
142                    foreach ccpath [$xmlobj children -as path $cpath] {
143                        if {[$xmlobj element -as type $ccpath] == "group"} {
144                            lappend queue $ccpath
145                        }
146                    }
147                }
148            }
149        }
150    }
151    return $rlist
152}
153
154# ----------------------------------------------------------------------
155itcl::class Rappture::LibraryObj {
156    constructor {info} { # defined below }
157    destructor { # defined below }
158
159    public method element {args}
160    public method parent {args}
161    public method children {args}
162    public method get {{path ""}}
163    public method put {args}
164    public method remove {{path ""}}
165    public method xml {}
166
167    public method diff {libobj}
168    public proc value {libobj path}
169
170    protected method find {path}
171    protected method path2list {path}
172    protected method node2name {node}
173    protected method node2comp {node}
174    protected method node2path {node}
175    protected method childnodes {node type}
176
177    private variable _root 0       ;# non-zero => this obj owns document
178    private variable _document ""  ;# XML DOM tree
179    private variable _node ""      ;# node within
180}
181
182# ----------------------------------------------------------------------
183# CONSTRUCTOR
184# ----------------------------------------------------------------------
185itcl::body Rappture::LibraryObj::constructor {info} {
186    if {[regexp {<?[Xx][Mm][Ll]} $info]} {
187        set _root 1
188        set _document [dom parse $info]
189        set _node [$_document documentElement]
190    } elseif {[regexp {^domNode} $info]} {
191        set _root 0
192        set _document [$info ownerDocument]
193        set _node $info
194    } else {
195        error "bad info: should be XML text or DOM node"
196    }
197}
198
199# ----------------------------------------------------------------------
200# DESTRUCTOR
201# ----------------------------------------------------------------------
202itcl::body Rappture::LibraryObj::destructor {} {
203    if {$_root && $_document != ""} {
204        $_document delete
205    }
206}
207
208# ----------------------------------------------------------------------
209# USAGE: element ?-as <fval>? ?<path>?
210#
211# Clients use this to query a particular element within the entire
212# data structure.  The path is a string of the form
213# "structure.box(source).corner".  This example represents the tag
214# <corner> within a tag <box id="source"> within a tag <structure>,
215# which must be found at the top level within this document.
216#
217# By default, this method returns the component name "type(id)".
218# This is changed by setting the -as argument to "id" (for name
219# of the tail element), to "type" (for the type of the tail element),
220# to "object" (for an object representing the DOM node referenced by
221# the path).
222# ----------------------------------------------------------------------
223itcl::body Rappture::LibraryObj::element {args} {
224    array set params {
225        -as component
226    }
227    while {[llength $args] > 1} {
228        set first [lindex $args 0]
229        if {[string index $first 0] == "-"} {
230            set choices [array names params]
231            if {[lsearch $choices $first] < 0} {
232                error "bad option \"$first\": should be [join [lsort $choices] {, }]"
233            }
234            set params($first) [lindex $args 1]
235            set args [lrange $args 2 end]
236        } else {
237            break
238        }
239    }
240    if {[llength $args] > 1} {
241        error "wrong # args: should be \"element ?-as fval? ?path?\""
242    }
243    set path [lindex $args 0]
244
245    set node [find $path]
246    if {$node == ""} {
247        return ""
248    }
249
250    switch -- $params(-as) {
251      object {
252          return [::Rappture::LibraryObj ::#auto $node]
253      }
254      component {
255          return [node2comp $node]
256      }
257      id {
258          return [node2name $node]
259      }
260      path {
261          return [node2path $node]
262      }
263      type {
264          return [$node nodeName]
265      }
266      default {
267          error "bad flavor \"$params(-as)\": should be component, id, object, path, type"
268      }
269    }
270}
271
272# ----------------------------------------------------------------------
273# USAGE: parent ?-as <fval>? ?<path>?
274#
275# Clients use this to query the parent of a particular element.
276# This is just like the "element" method, but it returns the parent
277# of the element instead of the element itself.
278#
279# By default, this method returns a list of component names "type(id)".
280# This is changed by setting the -as argument to "id" (for tail
281# names of all children), to "type" (for the types of all children),
282# to "object" (for a list of objects representing the DOM nodes for
283# all children).
284# ----------------------------------------------------------------------
285itcl::body Rappture::LibraryObj::parent {args} {
286    array set params {
287        -as component
288    }
289    while {[llength $args] > 1} {
290        set first [lindex $args 0]
291        if {[string index $first 0] == "-"} {
292            set choices [array names params]
293            if {[lsearch $choices $first] < 0} {
294                error "bad option \"$first\": should be [join [lsort $choices] {, }]"
295            }
296            set params($first) [lindex $args 1]
297            set args [lrange $args 2 end]
298        } else {
299            break
300        }
301    }
302    if {[llength $args] > 1} {
303        error "wrong # args: should be \"parent ?-as fval? ?path?\""
304    }
305    set path [lindex $args 0]
306
307    set node [find $path]
308    if {$node == ""} {
309        return ""
310    }
311    set node [$node parentNode]
312
313    switch -- $params(-as) {
314      object {
315          return [::Rappture::LibraryObj ::#auto $node]
316      }
317      component {
318          return [node2comp $node]
319      }
320      id {
321          return [node2name $node]
322      }
323      path {
324          return [node2path $node]
325      }
326      type {
327          return [$node nodeName]
328      }
329      default {
330          error "bad flavor \"$params(-as)\": should be component, id, object, path, type"
331      }
332    }
333}
334
335# ----------------------------------------------------------------------
336# USAGE: children ?-as <fval>? ?-type <name>? ?<path>?
337#
338# Clients use this to query the children of a particular element
339# within the entire data structure.  This is just like the "element"
340# method, but it returns the children of the element instead of the
341# element itself.  If the optional -type argument is specified, then
342# the return list is restricted to children of the specified type.
343#
344# By default, this method returns a list of component names "type(id)".
345# This is changed by setting the -as argument to "id" (for tail
346# names of all children), to "type" (for the types of all children),
347# to "object" (for a list of objects representing the DOM nodes for
348# all children).
349# ----------------------------------------------------------------------
350itcl::body Rappture::LibraryObj::children {args} {
351    array set params {
352        -as component
353        -type ""
354    }
355    while {[llength $args] > 1} {
356        set first [lindex $args 0]
357        if {[string index $first 0] == "-"} {
358            set choices [array names params]
359            if {[lsearch $choices $first] < 0} {
360                error "bad option \"$first\": should be [join [lsort $choices] {, }]"
361            }
362            set params($first) [lindex $args 1]
363            set args [lrange $args 2 end]
364        } else {
365            break
366        }
367    }
368    if {[llength $args] > 1} {
369        error "wrong # args: should be \"children ?-as fval? ?-type name? ?path?\""
370    }
371    set path [lindex $args 0]
372
373    set node [find $path]
374    if {$node == ""} {
375        return ""
376    }
377
378    set nlist ""
379    foreach n [$node childNodes] {
380        set type [$n nodeName]
381        if {[regexp {^#} $type]} {
382            continue
383        }
384        if {$params(-type) != "" && $params(-type) != $type} {
385            continue
386        }
387        lappend nlist $n
388    }
389
390    set rlist ""
391    switch -- $params(-as) {
392      object {
393          foreach n $nlist {
394              lappend rlist [::Rappture::LibraryObj ::#auto $n]
395          }
396      }
397      component {
398          foreach n $nlist {
399              lappend rlist [node2comp $n]
400          }
401      }
402      id {
403          foreach n $nlist {
404              lappend rlist [node2name $n]
405          }
406      }
407      path {
408          foreach n $nlist {
409              lappend rlist [node2path $n]
410          }
411      }
412      type {
413          foreach n $nlist {
414              lappend rlist [$n nodeName]
415          }
416      }
417      default {
418          error "bad flavor \"$params(-as)\": should be component, id, object, type"
419      }
420    }
421    return $rlist
422}
423
424# ----------------------------------------------------------------------
425# USAGE: get ?<path>?
426#
427# Clients use this to query the value of a node.  If the path is not
428# specified, it returns the value associated with the root node.
429# Otherwise, it returns the value for the element specified by the
430# path.
431# ----------------------------------------------------------------------
432itcl::body Rappture::LibraryObj::get {{path ""}} {
433    set node [find $path]
434    if {$node == ""} {
435        return ""
436    }
437    return [string trim [$node text]]
438}
439
440# ----------------------------------------------------------------------
441# USAGE: put ?-append yes? ?-id num? ?<path>? <string>
442#
443# Clients use this to set the value of a node.  If the path is not
444# specified, it sets the value for the root node.  Otherwise, it sets
445# the value for the element specified by the path.  If the value is a
446# string, then it is treated as the text within the tag at the tail
447# of the path.  If it is a DOM node or a library, then it is inserted
448# into the tree at the specified path.
449#
450# If the optional id is specified, then it sets the identifier for
451# the tag at the tail of the path.  If the optional append flag is
452# specified, then the value is appended to the current value.
453# Otherwise, the value replaces the current value.
454# ----------------------------------------------------------------------
455itcl::body Rappture::LibraryObj::put {args} {
456    array set params {
457        -id ""
458        -append no
459    }
460    while {[llength $args] > 1} {
461        set first [lindex $args 0]
462        if {[string index $first 0] == "-"} {
463            set choices [array names params]
464            if {[lsearch $choices $first] < 0} {
465                error "bad option \"$first\": should be [join [lsort $choices] {, }]"
466            }
467            set params($first) [lindex $args 1]
468            set args [lrange $args 2 end]
469        } else {
470            break
471        }
472    }
473    if {[llength $args] > 2} {
474        error "wrong # args: should be \"put ?-append bval? ?-id num? ?path? string\""
475    }
476    if {[llength $args] == 2} {
477        set path [lindex $args 0]
478        set str [lindex $args 1]
479    } else {
480        set path ""
481        set str [lindex $args 0]
482    }
483    set node [find -create $path]
484
485    #
486    # Clean up any nodes that don't belong.  If we're appending
487    # the value, then clean up only child <tag> nodes.  Otherwise,
488    # clean up all nodes.
489    #
490    set nlist ""
491    if {$params(-append)} {
492        foreach n [$node childNodes] {
493            if {[$n nodeType] != "TEXT_NODE"} {
494                lappend nlist $n
495            }
496        }
497    } else {
498        set nlist [$node childNodes]
499    }
500    foreach n $nlist {
501        $n delete
502    }
503
504    if {[Rappture::library isvalid $str]} {
505        foreach n [[$str info variable _node -value] childNodes] {
506            $node appendXML [$n asXML]
507        }
508    } else {
509        set n [$_document createText $str]
510        $node appendChild $n
511        if {"" != $params(-id)} {
512            $node setAttribute id $params(-id)
513        }
514    }
515    return ""
516}
517
518# ----------------------------------------------------------------------
519# USAGE: remove ?<path>?
520#
521# Clients use this to remove the specified node.  Removes the node
522# from the tree.
523# ----------------------------------------------------------------------
524itcl::body Rappture::LibraryObj::remove {{path ""}} {
525    set node [find $path]
526    if {$node != ""} {
527        $node delete
528    }
529}
530
531# ----------------------------------------------------------------------
532# USAGE: xml
533#
534# Returns a string representing the XML information for the information
535# in this library.
536# ----------------------------------------------------------------------
537itcl::body Rappture::LibraryObj::xml {} {
538    return [$_node asXML]
539}
540
541# ----------------------------------------------------------------------
542# USAGE: diff <libobj>
543#
544# Compares the entities in this object to those in another and
545# returns a list of differences.  The result is a list of the form:
546# {op1 path1 oldval1 newval1 ...} where each "op" is +/-/c for
547# added/subtracted/changed, "path" is the path within the library
548# that is different, and "oldval"/"newval" give the values for the
549# object at the path.
550# ----------------------------------------------------------------------
551itcl::body Rappture::LibraryObj::diff {libobj} {
552    set rlist ""
553
554    # query the values for all entities in both objects
555    set thisv [Rappture::entities $this input]
556    set otherv [Rappture::entities $libobj input]
557
558    # scan through values for this object, and compare against other one
559    foreach path $thisv {
560        set i [lsearch -exact $otherv $path]
561        if {$i < 0} {
562            foreach {raw norm} [value $this $path] break
563            lappend rlist - $path $raw ""
564        } else {
565            foreach {traw tnorm} [value $this $path] break
566            foreach {oraw onorm} [value $libobj $path] break
567            if {![string equal $tnorm $onorm]} {
568                lappend rlist c $path $traw $oraw
569            }
570            set otherv [lreplace $otherv $i $i]
571        }
572    }
573
574    # add any values left over in the other object
575    foreach path $otherv {
576        foreach {oraw onorm} [value $libobj $path] break
577        lappend rlist + $path "" $oraw
578    }
579    return $rlist
580}
581
582# ----------------------------------------------------------------------
583# USAGE: value <object> <path>
584#
585# Used to query the "value" associated with the <path> in an XML
586# <object>.  This is a little more complicated than the object's
587# "get" method.  It handles things like structures and values
588# with normalized units.
589#
590# Returns a list of two items:  {raw norm} where "raw" is the raw
591# value from the "get" method and "norm" is the normalized value
592# produced by this routine.  Example:  {300K 300}
593#
594# Right now, it is a handy little utility used by the "diff" method.
595# Eventually, it should be moved to a better object-oriented
596# implementation, where each Rappture type could overload the
597# various bits of processing below.  So we leave it as a "proc"
598# now instead of a method, since it should be deprecated soon.
599# ----------------------------------------------------------------------
600itcl::body Rappture::LibraryObj::value {libobj path} {
601    switch -- [$libobj element -as type $path] {
602        structure {
603            set raw $path
604            # try to find a label to represent the structure
605            set val [$libobj get $path.about.label]
606            if {"" == $val} {
607                set val [$libobj get $path.current.about.label]
608            }
609            if {"" == $val} {
610                if {[$libobj element $path.current] != ""} {
611                    set comps [$libobj children $path.current.components]
612                    set val "<structure> with [llength $comps] components"
613                } else {
614                    set val "<structure>"
615                }
616            }
617            return [list $raw $val]
618        }
619        number {
620            # get the usual value...
621            set raw ""
622            if {"" != [$libobj element $path.current]} {
623                set raw [$libobj get $path.current]
624            } elseif {"" != [$libobj element $path.default]} {
625                set raw [$libobj get $path.default]
626            }
627            if {"" != $raw} {
628                set val $raw
629                # then normalize to default units
630                set units [$libobj get $path.units]
631                if {"" != $units} {
632                    set val [Rappture::Units::convert $val \
633                        -context $units -to $units -units off]
634                }
635            }
636            return [list $raw $val]
637        }
638    }
639
640    # for all other types, get the value (current, or maybe default)
641    set raw ""
642    if {"" != [$libobj element $path.current]} {
643        set raw [$libobj get $path.current]
644    } elseif {"" != [$libobj element $path.default]} {
645        set raw [$libobj get $path.default]
646    }
647    return [list $raw $raw]
648}
649
650# ----------------------------------------------------------------------
651# USAGE: find ?-create? <path>
652#
653# Used internally to find a particular element within the root node
654# according to the path, which is a string of the form
655# "typeNN(id).typeNN(id). ...", where each "type" is a tag <type>;
656# if the optional NN is specified, it indicates an index for the
657# <type> tag within its parent; if the optional (id) part is included,
658# it indicates a tag of the form <type id="id">.
659#
660# By default, it looks for an element along the path and returns None
661# if not found.  If the create flag is set, it creates various elements
662# along the path as it goes.  This is useful for "put" operations.
663#
664# If you include "#" instead of a specific number, a node will be
665# created automatically with a new number.  For example, the path
666# "foo.bar#" called the first time will create "foo.bar", the second
667# time "foo.bar1", the third time "foo.bar2" and so forth.
668#
669# Returns an object representing the element indicated by the path,
670# or "" if the path is not found.
671# ----------------------------------------------------------------------
672itcl::body Rappture::LibraryObj::find {args} {
673    set create 0
674    while {[llength $args] > 1} {
675        set first [lindex $args 0]
676        set args [lrange $args 1 end]
677        if {$first == "-create"} {
678            set create 1
679        } else {
680            error "bad option \"$first\": should be -create"
681        }
682    }
683    if {[llength $args] != 1} {
684        error "wrong # args: should be \"find ?-create? path\""
685    }
686    set path [lindex $args 0]
687
688    if {$path == ""} {
689        return $_node
690    }
691    set path [path2list $path]
692
693    #
694    # Follow the given path and look for all of the parts.
695    #
696    set lastnode $_node
697    set node $lastnode
698    foreach part $path {
699        if {![regexp {^(([a-zA-Z_]+#?)([0-9]*))?(\((.*)\))?$} $part \
700               match dummy type index dummy name]} {
701            error "bad path component \"$part\""
702        }
703        #
704        # If the name is like "type2", then look for elements with
705        # the type name and return the one with the given index.
706        # If the name is like "type", then assume the index is 0.
707        #
708        if {$name == ""} {
709            if {$index == ""} {
710                set index 0
711            }
712            set nlist [childnodes $node $type]
713            set node [lindex $nlist $index]
714        } else {
715            #
716            # If the name is like "type(id)", then look for elements
717            # that match the type and see if one has the requested name.
718            # if the name is like "(id)", then look for any elements
719            # with the requested name.
720            #
721            if {$type != ""} {
722                set nlist [childnodes $node $type]
723            } else {
724                set nlist [$node childNodes]
725            }
726            set found 0
727            foreach n $nlist {
728                if {[catch {$n getAttribute id} tag]} { set tag "" }
729                if {$tag == $name} {
730                    set found 1
731                    break
732                }
733            }
734            set node [expr {($found) ? $n : ""}]
735        }
736
737        if {$node == ""} {
738            if {!$create} {
739                return ""
740            }
741
742            #
743            # If the "create" flag is set, then create a node
744            # with the specified "type(id)" and continue on.
745            # If the type is "type#", then create a node with
746            # an automatic number.
747            #
748            if {![regexp {^([^\(]+)\(([^\)]+)\)$} $part match type name]} {
749                set type $part
750                set name ""
751            }
752
753            if {[string match *# $type]} {
754                set type [string trimright $type #]
755                set node [$_document createElement $type]
756
757                # find the last node of same type and append there
758                set pos ""
759                foreach n [$lastnode childNodes] {
760                    if {[$n nodeName] == $type} {
761                        set pos $n
762                    }
763                }
764                if {$pos != ""} {
765                    set pos [$pos nextSibling]
766                }
767                if {$pos != ""} {
768                    $lastnode insertBefore $node $pos
769                } else {
770                    $lastnode appendChild $node
771                }
772            } else {
773                set node [$_document createElement $type]
774                $lastnode appendChild $node
775            }
776            if {"" != $name} {
777                $node setAttribute id $name
778            }
779        }
780        set lastnode $node
781    }
782    return $node
783}
784
785# ----------------------------------------------------------------------
786# USAGE: path2list <path>
787#
788# Converts a path of the form "foo(a).bar.baz" into a list of the
789# form "foo(a) bar baz".  This is a little more complicated than
790# splitting on the .'s, since the stuff in ()'s might have embedded
791# .'s.  Returns a proper Tcl list for all elements of the path.
792# ----------------------------------------------------------------------
793itcl::body Rappture::LibraryObj::path2list {path} {
794    #
795    # Normally, we just split on .'s within the path.  But there
796    # might be some .'s embedded within ()'s in the path.  Change
797    # any embedded .'s to an out-of-band character, then split on
798    # the .'s, and change the embedded .'s back.
799    #
800    if {[regexp {(\([^\)]*)\.([^\)]*\))} $path]} {
801        while {[regsub -all {(\([^\)]*)\.([^\)]*\))} $path "\\1\007\\2" path]} {
802            # keep fixing...
803        }
804    }
805    set path [split $path .]
806    regsub -all {\007} $path {.} path
807
808    return $path
809}
810
811# ----------------------------------------------------------------------
812# USAGE: node2name <node>
813#
814# Used internally to create a name for the specified node.  If the
815# node doesn't have a specific name ("id" attribute) then a name of
816# the form "type123" is constructed.
817# ----------------------------------------------------------------------
818itcl::body Rappture::LibraryObj::node2name {node} {
819    if {[catch {$node getAttribute id} name]} { set name "" }
820    if {$name == ""} {
821        set pnode [$node parentNode]
822        if {$pnode == ""} {
823            return ""
824        }
825        set type [$node nodeName]
826        set siblings [childnodes $pnode $type]
827        set index [lsearch $siblings $node]
828        if {$index == 0} {
829            set name $type
830        } else {
831            set name "$type$index"
832        }
833    }
834    return $name
835}
836
837# ----------------------------------------------------------------------
838# USAGE: node2comp <node>
839#
840# Used internally to create a path component name for the specified
841# node.  A path component name has the form "type(id)" or just
842# "type##" if the node doesn't have a name.  This name can be used
843# in a path to uniquely address the component.
844# ----------------------------------------------------------------------
845itcl::body Rappture::LibraryObj::node2comp {node} {
846    set type [$node nodeName]
847    if {[catch {$node getAttribute id} name]} { set name "" }
848    if {$name == ""} {
849        set pnode [$node parentNode]
850        if {$pnode == ""} {
851            return ""
852        }
853        set siblings [childnodes $pnode $type]
854        set index [lsearch $siblings $node]
855        if {$index == 0} {
856            set name $type
857        } else {
858            set name "$type$index"
859        }
860    } else {
861        set name "${type}($name)"
862    }
863    return $name
864}
865
866# ----------------------------------------------------------------------
867# USAGE: node2path <node>
868#
869# Used internally to create a full path name for the specified node.
870# The path is relative to the current object, so it stops when the
871# parent is the root node for this object.
872# ----------------------------------------------------------------------
873itcl::body Rappture::LibraryObj::node2path {node} {
874    set path [node2comp $node]
875    set node [$node parentNode]
876    while {$node != "" && $node != $_node} {
877        set path "[node2comp $node].$path"
878        set node [$node parentNode]
879    }
880    return $path
881}
882
883# ----------------------------------------------------------------------
884# USAGE: childnodes <node> <type>
885#
886# Used internally to return a list of children for the given <node>
887# that match a specified <type>.  Similar to XML getElementsByTagName,
888# but returns only direct children of the <node>.
889# ----------------------------------------------------------------------
890itcl::body Rappture::LibraryObj::childnodes {node type} {
891    set rlist ""
892    foreach cnode [$node childNodes] {
893        if {[$cnode nodeName] == $type} {
894            lappend rlist $cnode
895        }
896    }
897    return $rlist
898}
Note: See TracBrowser for help on using the repository browser.