package require Tcl 8.5
 package require Tk;
 package require tdom;
 package require BWidget;
 package require tablelist;

 namespace import ::tablelist::*;

 #-----------------------------------------------------------------------------
 # helper procedures
 #
 proc ExcelDateToClock {excelDate} {
     return [clock scan $excelDate -format {%Y-%m-%dT%H:%M:%SZ}];
 }

 # syntax: processNodes nodeToken ?commandPrefix? ?arg arg ...?
 # desc:   this procedure uses the given node name as command name
 #         probably prepending the commandPrefix to process the
 #         children of the given node
 #
 proc processNodes {node args} {
     # separate the command prefix and the optional arguments
     #
     if {[llength $args] > 0} {
         set args    [lassign $args commandPrefix];
     } else {
         set commandPrefix   "";
     }

     # loop over all child nodes, working currently only on ELEMENT_NODE's
     #
     set result      [dict create];
     set child       [$node firstChild];
     set lastChild   [$node lastChild];

     while {1} {
         if {[$child nodeType] eq "ELEMENT_NODE"} {
             # build the procedure/command name
             #
             set procedureName   ${commandPrefix}[$child nodeName];

             if {[llength [info procs $procedureName]] == 1} {
                 # execute the procedure/command to process the child node
                 #
                 set childData   [$procedureName $child {*}$args];

                 # use the results
                 #
                 if {[llength $childData] == 1} {
                     set childData   [list [$child nodeName] $childData];
                 }

                 foreach {token data} $childData {
                     if {[dict exists $result $token] == 1} {
                         dict lappend result $token $data;
                     } else {
                         dict set result $token $data;
                     }
                 }
             }
         }

         if {$child eq $lastChild} {
             break;
         }

         set child   [$child nextSibling];
     }

     return $result;
 }

 proc tableSort {args} {
     lassign $args first second;

     if {$first eq $second} {
         return 0;
     }

     set args    [lsort -dictionary $args];

     if {[lindex $args 0] eq $second} {
         return 1;
     }

     return -1;
 }

 proc createTable {w tableName tableLabel columns} {
     set w               [$w insert end $tableName -text $tableLabel];
     set columnsCount    [expr {[llength $columns] / 2}];

     labelframe $w.lf1   -text $tableLabel;
         set table   $w.lf1.tlSheet

         tablelist   $w.lf1.tlSheet  \
             -listvariable       ::data($tableName) \
             -height             20 \
             -width              100 \
             -stretch            all \
             -selectmode         browse \
             -selecttype         cell \
             -movablerows        1 \
             -movablecolumns     1 \
             -resizablecolumns   1 \
             -showseparators     1 \
             -showarrow          1 \
             -labelcommand       ::tablelist::sortByColumn \
             -labelcommand2      ::tablelist::addToSortColumns \
             -sortcommand        tableSort \
             -columns            $columns \
             -xscrollcommand     [list $w.lf1.sbx set] \
             -yscrollcommand     [list $w.lf1.sby set];
         scrollbar $w.lf1.sby \
             -orient     vertical \
             -command    [list $w.lf1.tlSheet yview];
         scrollbar $w.lf1.sbx \
             -orient     horizontal \
             -command    [list $w.lf1.tlSheet xview];

         $w.lf1.tlSheet columnconfigure 0 \
             -showlinenumbers    1 \
             -resizable          0 \
             -stretchable        0;

         for {set index 1} {$index < $columnsCount} {incr index} {
             $w.lf1.tlSheet columnconfigure $index -maxwidth 0;
         }

         if {[$w.lf1.tlSheet columncount] >= 2} {
             $w.lf1.tlSheet sortbycolumn 1 -increasing;
         }
     grid $w.lf1.tlSheet  -column 0   -row 0  -sticky nesw    -padx {3 0} -pady {3 0};
     grid $w.lf1.sby      -column 1   -row 0  -sticky nes     -padx {0 3} -pady {3 0};
     grid $w.lf1.sbx      -column 0   -row 1  -sticky new     -padx {3 0} -pady {0 3};
     grid columnconfigure    $w.lf1 0    -weight 1;
     grid rowconfigure       $w.lf1 0    -weight 1;

     pack $w.lf1  -side top   -fill both  -expand 1   -padx 3 -pady 3;

     return;
 }

 #-----------------------------------------------------------------------------
 # node processing procedures
 #
 proc DocumentProperties {node} {
     return [list documentProperties [processNodes $node DocumentProperties.]];
 }

 proc DocumentProperties.Author {node} {
     return [list author [$node text]];
 }

 proc DocumentProperties.Created {node} {
     return [list ctime [ExcelDateToClock [$node text]]];
 }

 proc DocumentProperties.Company {node} {
     return [list company [$node text]];
 }

 proc DocumentProperties.Version {node} {
     return [list version [$node text]];
 }

 proc Worksheet {node} {
     # accessing the name attribute to get the worksheet name
     #
     set worksheetName   [$node getAttribute ss:Name];
     set tableData       [processNodes $node Worksheet. $worksheetName];

     if {[llength $tableData] == 0} {
         # there was a worksheet without data, so a dummy data structure
         # must be created
         #
         set tableData   [list \
             $worksheetName \
             [dict create \
                 attributes      [dict create] \
                 data            [list] \
                 rowsCount       0 \
                 columnsCount    0 \
             ] \
         ];
     }

     return [dict create \
         worksheets $worksheetName \
         {*}$tableData \
     ];
 }

 proc Worksheet.Table {node worksheetName} {
     # handling the table attributes
     #
     set attributes  [dict create];

     foreach attribute [$node attributes] {
         lassign $attribute attributeName "" attributeNameSpaceUri;

         set attributeValue  [$node getAttributeNS $attributeNameSpaceUri $attributeName];

         dict set attributes $attributeName $attributeValue;

         switch -exact -- $attributeName {
             ExpandedColumnCount {
                 set columnsCount    $attributeValue;
             }
             ExpandedRowCount    {
                 set rowsCount   $attributeValue;
             }
         }
     }

     # collecting the table data
     #
     set tableData   [list];

     foreach rowNode [$node getElementsByTagName Row] {
         set rowData [list];

         foreach cellNode [$rowNode getElementsByTagName Cell] {
             set dataNode    [$cellNode getElementsByTagName Data];

             lappend rowData [$dataNode text];
         }

         lappend tableData $rowData;
     }

     return [list \
         $worksheetName \
         [dict create \
             attributes      $attributes \
             rowsCount       $rowsCount \
             columnsCount    $columnsCount \
             data            $tableData \
         ] \
     ];
 }

 #-----------------------------------------------------------------------------
 # main procedure
 #
 proc main {argc args} {
     wm withdraw .;

     if {$argc != 1} {
         tk_messageBox \
             -parent    . \
             -icon      error \
             -title     "wrong # args" \
             -message   "wrong # args: should be \"[file rootname [file tail [info nameofexecutable]]] xmlFileName\"";
         exit 1;
     }

     if {[catch {
         # read the xml file
         #
         set xmlFile     [lindex $args 0];
         set xml         [tDOM::xmlReadFile $xmlFile]

         # parse the xml data
         #
         set document    [dom parse $xml];
     } reason] == 1} {
         tk_messageBox \
             -parent    . \
             -icon      error \
             -title     "invalid XML file or data" \
             -message   "couldn't load and/or parse the xml file ...\n\n... \"[file nativename $xmlFile]\":\n\n$reason";
         exit 2;
     }

     # process the parsed XML data
     #
     set root               [$document documentElement];
     set processedContents  [processNodes $root];

     if {[dict exists $processedContents worksheets] == 0} {
         error "no such defined worksheets";
     }

     # cleanup the xml document tree
     #
     $document delete;

     # create tables using the tablelist package,
     # inside the BWidget NoteBook widget
     #
     wm title . "MS Excel to tablelist";

     NoteBook .worksheets -homogeneous 1;

     # create the NoteBook page with the read document properties
     #
     set columns [list \
         0 "" \
         0 "Property Name" \
         0 "Property Value" \
     ];

     set ::data(properties)  [list];

     foreach {token value} [dict get $processedContents documentProperties] {
         if {$token eq "ctime"} {
             set value   [clock format $value -format {%Y-%m-%d, %T}];
         }

         lappend ::data(properties)  [list "" $token $value];
     }

     createTable .worksheets properties "Document Properties" $columns;

     # create each worksheet table as NoteBook page
     #
     foreach worksheet [dict get $processedContents worksheets] {
         set table               [dict get $processedContents $worksheet];
         set ::data($worksheet)  [dict get $table data];

         # create the columns description list
         #
         set columnsCount    [dict get $table columnsCount];
         set A               [scan "A" {%c}];
         set columns         [list 0 ""];

         for {set index 0} {$index < $columnsCount} {incr index} {
             lappend columns 0 [format {%c} [expr {$index + $A}]];
         }

         # prepare the data to be able to contain the line numbers column
         #
         set rowIndex    0;

         foreach row $::data($worksheet) {
             lset ::data($worksheet) $rowIndex [linsert $row -1 ""];

             incr rowIndex;
         }

         # add a new page to the NoteBook containing the current worksheet
         #
         createTable .worksheets $worksheet $worksheet $columns;
     }

     pack .worksheets -side top   -fill both  -expand 1   -padx 3 -pady 3;

     .worksheets raise properties;

     update;

     wm minsize . 640 480;
     wm deiconify .;

     grab  .worksheets;
     focus .worksheets;
     raise .;

     return;
 }

 main $argc $argv;