[http://mini.net/files/stardom03.jpg]
----
[Rolf Ade], [Richard Suchenwirth]  2002-08-16 - 
starDOM is going to be [a little XML browser] packaged as a [Starkit]. Though compact in code, it is quite powerful because it stands on the shoulders of several giants:
   * [tDOM] is the leanest, fastest DOM engine in the (open) market
   * [BWidgets] supply a strong Tree widget here
   * and of course [Tcl]/[Tk] lay great groundwork for all...
Here is version 0.3 for public code review and discussion, which features cyclic searching in various modes (case-sensitive full text; case-insensitive full-text; [regexp]; or [XPath]). Search term goes into the upper entry; <Return> starts the search. With the (...) button you get a file selector for opening. Enjoy, comment, improve!
----
 namespace eval starDOM {
    set version 0.3
    set about "<about>
        <name       >starDom</name>
        <version    >$version</version>
        <description>A little XML browser</description>
        <authors>
           <author>Rolf Ade</author>
           <author>Richard Suchenwirth</author>
        </authors>
    </about>"
 }
 package require BWidget
 package require tdom

 proc starDOM::insertNode {w parent node} {
    set drawcross "auto"
    if {[$node nodeType] != "ELEMENT_NODE"} {
        # text, cdata, comment and PI nodes
        set text [string map {\n " "} [$node nodeValue]]
    } else {
        set name "[$node nodeName]"
        set text "<$name"
        foreach att [$node attributes] {
            catch {append text " $att=\"[$node getAttribute $att]\""}
        }
        append text ">"
        if {[$node hasChildNodes]} {
            set children [$node childNodes]
            if {[llength $children]==1 && [$children nodeName]=="#text"} {
                append text [string map {\n " "} [$children nodeValue]] </$name> 
            } else {
                set drawcross "allways" ;# bad English, but needed by BWidget
            }
        }
    }
    $w insert end $parent $node -text $text -drawcross $drawcross
 }
 proc starDOM::showNode {w nodes} {
    variable next; variable hilited; variable info
    set nr $next
    set nrOfNodes [llength $nodes]
    set node [lindex $nodes $nr]
    if {($nr + 1) == $nrOfNodes} {
	set next 0
    } else {
	incr next
    }
    foreach prevHilited $hilited {$w itemconfigure $prevHilited -fill black}
    set hilited {}
    set info [expr {$nr+1}]/$nrOfNodes
    set ancestorNodes [$node selectNodes ancestor::*]
    foreach ancestor $ancestorNodes {
        openCross $w $ancestor
        $w itemconfigure $ancestor -open 1
    }
    set parent [$node parentNode]
    set children [$parent childNodes]
    if {[llength $children]==1 && [$children nodeName]=="#text"} {
	set node $parent
    }
    $w itemconfigure $node -fill "blue"
    $w see $node
    $w xview moveto 0 ;# scroll to flush left
    lappend hilited $node
 }
 proc starDOM::search {w} {
    variable mode; variable query; variable info; 
    variable changed; variable next; variable root
    switch -- $mode {
	case   -
        XPath  {
	    set q [expr {$mode=="case"? 
                 "descendant-or-self::text()\[contains(.,'$query')\]": $query}]
            set nodes  [$root selectNodes $q]
        }
        nocase -
        regexp {
            set allText [$root selectNodes //text()]
            set nodes {}
            if {$mode == "nocase"} {
                set s [string tolower $query]
                foreach n $allText {
                    if {[string first $s [string tolower [$n nodeValue]]]>=0} {
                        lappend nodes $n
                    }
                }
            } else {
                foreach n $allText {
                    if {[regexp $query [$n nodeValue]]} {
                        lappend nodes $n
                    }
                }
            }
        }
    }
    set nrOfNodes [llength $nodes]
    set info "$nrOfNodes hit(s)"
    if {$nrOfNodes} {
	if $changed {set next 0; set changed 0}
	showNode $w $nodes 
    }
 }
 proc starDOM::openCross {w node} {
    if {[$w itemcget $node -drawcross] == "allways"} {
        foreach child [$node childNodes] {
            insertNode $w $node $child
        }
        $w itemconfigure $node -drawcross "auto"
    }
 }
 proc starDOM::Open {w {filename ""}} {
    if {$filename == ""} {
	set filename [tk_getOpenFile -filetypes {
	    {{XML file} *.xml} {{All files} *.*}}]
    }
    if {$filename != ""} {
	starDOM::show $w $filename
	wm title . "$filename - starDOM"
    }
 }
 proc starDOM::show {w string {isText 0}} {
    variable hilited {} root
    if {!$isText} {
	set fd  [tDOM::xmlOpenFile $string]
	set doc [dom parse -channel $fd]
	close $fd
    } else {
	set doc [dom parse $string]
    }
    $doc documentElement root
    $w delete [$w nodes root]
    insertNode $w root $root
    openCross $w $root   ;# Show children of root right after startup
    $w itemconfigure $root -open 1
 }
 proc starDOM::UI {} {
    variable changed 0 mode "case" query "" info ""
    frame  .f
    button .f.open -text ... -command {starDOM::Open .t} -pady 0\
	-borderwidth 1
    entry  .f.e -width 25 -textvar starDOM::query
    bind   .f.e <Key>    {set starDOM::changed 1}
    bind   .f.e <Return> {starDOM::search .t}
    foreach {txt} {case nocase regexp XPath} {
	radiobutton .f.r$txt -text $txt -variable starDOM::mode \
	    -value $txt -padx 0
    }
    label .f.info -textvar starDOM::info -width 10
    eval pack [winfo children .f] -side left -padx 0
    pack  .f.e -fill x -expand 1

    Tree .t -yscrollcommand ".y set" -xscrollcommand ".x set" -padx 0 \
        -opencmd "starDOM::openCross .t" -height 24
    scrollbar .x -ori hori -command ".t xview"
    scrollbar .y -ori vert -command ".t yview"
    grid .f - -sticky ew
    grid .t .y  -sticky news
    grid .x    -sticky news
    grid rowconfig    . 1 -weight 1
    grid columnconfig . 0 -weight 1
    if {$::tcl_platform(platform)=="windows"} {
	bind .t.c <MouseWheel> {
	    %W yview scroll [expr {int(pow(%D/-120,3))}] units
	}
	focus .t.c
    }
 }
 #---------------------------------------- "main"
 starDOM::UI
 if {[llength $argv]} {
    starDOM::show .t [lindex $argv 0]
 } else {
    starDOM::show .t $starDOM::about 1
 }
----
[Arts and crafts of Tcl-Tk programming]