#!/usr/bin/env wish

namespace eval xml {
    proc inspect {xml title} {
      package require Tk
      package require tdom

      # parse XML
      set doc [dom parse $xml]
      set nsprefixlist {}
      foreach {item} [$doc selectNodes {//namespace::*}] {
        lassign $item fullprefix uri
        lassign [split $fullprefix :] _ prefix
        lappend nsprefixlist $prefix $uri
      }

      # build ui
      set tl [toplevel .$doc]
      wm protocol $tl WM_DELETE_WINDOW [namespace code [list cleanup $doc $tl]]
      ttk::panedwindow $tl.pane -orient horizontal
      ttk::treeview $tl.tv -selectmode extended -show tree
      bind $tl.tv <<TreeviewSelect>> [namespace code [list updateText $tl.txt %W]]
      text $tl.txt
      fillTree $tl.tv [list [$doc documentElement]]
      $tl.pane add $tl.tv -weight 1
      $tl.pane add $tl.txt -weight 2
      entry $tl.entry
      pack $tl.pane -expand 1 -fill both
      pack $tl.entry -expand 0 -fill x
      bind $tl.entry <Return> [namespace code [list evaluateXPath $doc $nsprefixlist %W $tl.tv]]

      if {$title ne {}} {
        wm title $tl $title
      }

      return $tl

    }

    proc evaluateXPath {doc nsprefixlist xpathWidget tv} {
      set xpath [$xpathWidget get]
      if {$xpath eq {} } {
        set nodes [list [$doc documentElement]]
      } else {
        set nodes [$doc selectNodes -namespaces $nsprefixlist $xpath]
      }
      fillTree $tv $nodes
    }

    proc cleanup {doc tl} {
      $doc delete
      destroy $tl
    }

    proc fillTree {tv nodes} {
      # puts stderr "Adding [llength $nodes] nodes"
      foreach item [$tv children {}] {
        $tv detach $item
      }
      $tv selection remove [$tv selection]
      if {[catch {addNodes $tv {} $nodes } result]} {
      # Just add the text of the XPath result if it's not a list of nodes.
      # Call it in a callback because the clearing of the selection will clear the txt view.
        puts stderr $result
        after 0 [list [winfo parent $tv].txt insert end [join $nodes \n]]
      }
    }

    proc updateText {txt lv} {
      $txt delete 1.0 end
      foreach node [$lv selection] {
        $txt insert end [$node asXML]
        $txt insert end \n
      }

    }

    proc addNodes {tv parent nodes} {
      set index 0
      # puts stderr $parent-$nodes
      foreach node $nodes {
        set name [$node nodeName]
        if {$name eq "#text"} {
          continue
        }
        if [$tv exists $node] {
          $tv move $node $parent $index
        } else {
          $tv insert $parent $index -id $node -text $name
        }
        set children [$node childNodes]
        # puts stderr "Children -> $children"
        if {$children ne {}} {
          addNodes $tv $node $children
        }
        incr index
      }
    }
  }

# Example usage to open an XML file

set file [lindex $argv 0]


set f [open $file]
set xml [read $f]
close $f
xml::inspect $xml $file