#!/bin/sh
# \
exec wish "$0" "$@"

# tkxmllint --
#
#	Simple GUI for xmllint-style processing of XML documents
#
# Copyright (c) 2005-2009 Explain
# http://www.explain.com.au/
# Copyright (c) 2003-2004 Zveno
# http://www.zveno.com/
#
# See the file "LICENSE" in this distribution for information on usage and
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# $Id: tkxmllint.tcl,v 1.11 2005/05/20 14:07:33 balls Exp $

# Global initialisation

set VERSION 1.9

# Temporary hack for TclApp-wrapped executables
lappend auto_path [file dirname [info nameofexecutable]]

package require dom

package require msgcat
namespace import ::msgcat::mc

package require uri 1.2

tk appname tkxmllint

# We need the code shared with tkxsltproc
source [file join [file dirname [info script]] common.tcl]

# Init --
#
#	Create the GUI
#
# Arguments:
#	win	toplevel window
#
# Results:
#	Tk widgets created

proc Init win {
    upvar \#0 State$win state

    set w [expr {$win == "." ? {} : $win}]

    array set state {
	url {}
	cwd {}
	noent 0
	nonet 0

	display:entrefs 0
    }

    wm title $win "Tk XML Lint"

    switch [tk windowingsystem] {
	aqua -
	classic {
	    set metakey Command
	    set metakeylabel Command-
	}
	default {
	    set metakey Control
	    set metakeylabel Ctrl+
	}
    }

    menu $w.menu -tearoff 0
    $win configure -menu $w.menu
    $w.menu add cascade -label [mc File] -menu $w.menu.file
    menu $w.menu.file -tearoff 1
    $w.menu.file add command -label [mc {New Window}] -command NewWindow -accel ${metakeylabel}N
    bind $win <${metakey}-n> NewWindow
    $w.menu.file add separator
    $w.menu.file add command -label [mc {Save As...}] -command [list SaveAs $win] -state disabled
    $w.menu.file add separator
    $w.menu.file add command -label [mc Quit] -command {destroy .} -accel ${metakeylabel}Q
    bind $win <${metakey}-q> {destroy .}

    $w.menu add cascade -label [mc Help] -menu $w.menu.help
    menu $w.menu.help -tearoff 0
    $w.menu.help add command -label [mc {About tkxmllint}] -command tkAboutDialog -accel ${metakeylabel}?
    # This fails on Linux
    catch {bind $win <${metakey}-?> tkAboutDialog}

    if {$::tcl_platform(platform) == "macintosh" ||
	($::tcl_platform(platform) == "unix" && $::tcl_platform(os) == "Darwin")} {
	$w.menu add cascade -label tkxmllint -menu $w.menu.apple
	menu $w.menu.apple -tearoff 0
	$w.menu.apple add command -label [mc {About tkxmllint}] -command tkAboutDialog
    }

    frame $w.controls
    grid $w.controls - -row 0 -column 0 -sticky ew
    button $w.controls.check -text [mc Check] -command [list Check $win]
    # TODO: add a nice icon
    grid $w.controls.check -row 0 -column 0 -sticky w
    grid columnconfigure $w.controls 0 -weight 1

    labelframe $w.doc -text [mc Document]
    grid $w.doc - -row 1 -column 0 -sticky ew
    label $w.doc.url -text [mc URL:]
    entry $w.doc.urlentry -width 60 -textvariable State${win}(url)
    button $w.doc.browse -text [mc Browse] -command [list Browse $win url -title {Select XML Document}]
    grid $w.doc.url -row 0 -column 0 -sticky w
    grid $w.doc.urlentry -row 0 -column 1 -sticky ew
    grid $w.doc.browse -row 0 -column 2 -sticky e
    grid columnconfigure $w.doc 1 -weight 1

    labelframe $w.options -text [mc Options]
    grid $w.options - -row 2 -column 0 -sticky news
    checkbutton $w.options.noout -text [mc {Display document}] -variable State${win}(display)
    checkbutton $w.options.timing -text [mc {Display timing}] -variable State${win}(timing)
    checkbutton $w.options.xinclude -text [mc XInclude] -variable State${win}(xinclude)
    checkbutton $w.options.noent -text [mc {Substitute entities}] -variable State${win}(noent)
    checkbutton $w.options.logentities -text [mc {Log entities}] -variable State${win}(display:entrefs)
    checkbutton $w.options.nonet -text [mc {No network}] -variable State${win}(nonet)
    menubutton $w.options.encode -text [mc Encoding...] -menu $w.options.encode.menu
    set m [menu $w.options.encode.menu -tearoff 0]
    $m add radiobutton -label [mc utf-8] -variable ::State${win}(encoding) -value utf-8
    $m add radiobutton -label [mc ascii] -variable ::State${win}(encoding) -value ascii
    entry $w.options.encoding -textvariable ::State${win}(encoding)
    set state(encoding) utf-8
    grid $w.options.noout -row 0 -column 0 -sticky w
    grid $w.options.timing -row 1 -column 0 -sticky w
    grid $w.options.logentities -row 2 -column 0 -sticky w
    grid $w.options.xinclude -row 0 -column 1 -sticky w
    grid $w.options.noent -row 1 -column 1 -sticky w
    grid $w.options.nonet -row 2 -column 1 -sticky w
    grid $w.options.encode -row 0 -column 2 -sticky w
    grid $w.options.encoding -row 0 -column 3 -sticky ew
    grid columnconfigure $w.options 3 -weight 1

    labelframe $w.validation -text [mc Validation]
    grid $w.validation - -row 3 -column 0 -sticky news
    radiobutton $w.validation.none -text [mc none] -variable State${win}(validate) -value no
    radiobutton $w.validation.dtd -text [mc DTD] -variable State${win}(validate) -value dtd
    radiobutton $w.validation.wxs -text [mc WXS] -variable State${win}(validate) -value wxs
    radiobutton $w.validation.rng -text [mc RNG] -variable State${win}(validate) -value rng
    labelframe $w.validation.doc -text [mc {Schema Document}]
    label $w.validation.doc.url -text [mc URL:]
    entry $w.validation.doc.urlentry -width 40 -textvariable State${win}(schemaurl)
    button $w.validation.doc.browse -text [mc Browse] -command [list Browse $win schemaurl -title {Select Schema Document}]
    grid $w.validation.doc.url -row 0 -column 0 -sticky w
    grid $w.validation.doc.urlentry -row 0 -column 1 -sticky ew
    grid $w.validation.doc.browse -row 0 -column 2 -sticky e
    grid columnconfigure $w.validation.doc 1 -weight 1
    set state(validate) no
    grid $w.validation.none -row 0 -column 0 -sticky w
    grid $w.validation.dtd -row 0 -column 1 -sticky w
    grid $w.validation.wxs -row 0 -column 2 -sticky w
    grid $w.validation.rng -row 0 -column 3 -sticky w
    grid $w.validation.doc - - - -row 1 -sticky ew
    grid columnconfigure $w.validation 2 -weight 1

    set state(messages) [labelframe $w.messages -text [mc Messages]]
    grid $w.messages - -row 4 -column 0 -sticky news
    text $w.messages.log -wrap none \
	-state disabled \
	-xscrollcommand [list $w.messages.xscroll set] \
	-yscrollcommand [list $w.messages.yscroll set]
    scrollbar $w.messages.xscroll -orient horizontal \
	-command [list $w.messages.log xview]
    scrollbar $w.messages.yscroll -orient vertical \
	-command [list $w.messages.log yview]
    grid $w.messages.log -row 0 -column 0 -sticky news
    grid $w.messages.yscroll -row 0 -column 1 -sticky ns
    grid $w.messages.xscroll -row 1 -column 0 -sticky ew
    grid rowconfigure $w.messages 0 -weight 1
    grid columnconfigure $w.messages 0 -weight 1

    SetProperties $win $w.messages.log

    frame $w.feedback
    grid $w.feedback - -row 5 -column 0 -sticky ew
    label $w.feedback.msg -textvariable State${win}(feedback)
    set state(progress) [canvas $w.feedback.progress \
			     -width 100 -height 25 -relief sunken]
    set state(progressbar) [$w.feedback.progress create rectangle 0 0 1 25 \
				-fill blue -disabledfill white -state disabled]
    grid $w.feedback.progress -row 0 -column 1
    grid $w.feedback.msg -row 0 -column 0 -sticky ew
    grid columnconfigure $w.feedback 0 -weight 1

    grid rowconfigure $win 3 -weight 1
    grid columnconfigure $win 1 -weight 1

    return {}
}

# tkAboutDialog --
#
#	Information about this application
#
# Arguments:
#	None
#
# Results:
#	Displays window

proc tkAboutDialog {} {
    catch {destroy .about}
    toplevel .about
    catch {::tk::unsupported::MacWindowStyle style .about floatProc}
    wm title .about [mc {About tkxmllint}]
    label .about.libxml2logo -image libxml2Logo
    label .about.tcllogo -image tclLogo
    text .about.msg -width 40 -height 10 -font Arial
    .about.msg insert end [mc [format "tkxmllint - A GUI for xmllint

Version %s

Powered by:
\tlibxml2\tv%s
\tTclXML\tv%s
\tTcl/Tk\tv%s

http://tclxml.sourceforge.net/tkxmllint.html
" $::VERSION $::xml::libxml2::libxml2version \
	[package require xml] [info patchlevel]]]

    .about.msg configure -state disabled

    grid .about.libxml2logo -row 0 -column 2 -sticky news
    grid .about.tcllogo -row 1 -column 2 -sticky news
    grid .about.msg -row 0 -column 1 -rowspan 2 -sticky news -padx 20 -pady 20
    grid rowconfigure .about 0 -weight 1
    grid rowconfigure .about 1 -weight 1
    grid columnconfigure .about 1 -weight 1

    return {}
}

# SaveAs --
#
#	Save document into a file
#
# Arguments:
#	win	toplevel
#
# Results:
#	File written

proc SaveAs {win} {
    upvar \#0 State$win state

    if {![info exists state(dom)]} {
	tk_messageBox -parent $win -title [mc {No Document}] \
	    -message [mc {No document to save}] -type ok
	return {}
    }

    set w [expr {$win == "." ? {} : $win}]

    set cwd [pwd]
    if {$state(cwd) != {}} {
	set cwd $state(cwd)
    }

    set fname [tk_getSaveFile -parent $win -title [mc {Save As...}] -initialdir $cwd]

    if {![string length $fname]} {
	return {}
    }

    set state(cwd) [file dirname $fname]

    if {[catch {open $fname w} ch]} {
	tk_messageBox -parent $win -icon error -type ok -message "Unable to open \"[file nativename $fname]\" for writing"
	return {}
    }

    fconfigure $ch -encoding $state(encoding)
    puts $ch [dom::serialize $state(dom) -encoding $state(encoding)]
    close $ch

    return {}
}

# NewWindow --
#
#	Create another toplevel window
#
# Arguments:
#	None
#
# Results:
#	Tk toplevel created and initialised

proc NewWindow {} {
    global counter

    Init [toplevel .top[Incr counter]]

    return {}
}

# Check --
#
#	Parse the given document and display report
#
# Arguments:
#	win	toplevel window
#
# Results:
#	Document read into memory, parsed and report displayed

proc Check win {
    upvar \#0 State$win state

    set w [expr {$win == "." ? {} : $win}]

    set fname [GetFilename $win $w.doc.urlentry url]
    if {![string length $fname]} {
	return
    }

    set dodisplay $state(display)

    Log clear $win
    $w.menu.file entryconfigure [mc {Save As...}] -state disabled

    catch {
	dom::destroy $state(dom)
	unset state(dom)
    }

    set time(start) [clock clicks -milliseconds]

    if {[catch {ReadAndParseXML $win [mc "source"] $fname $state(url) time \
		    -noent $state(noent) \
		-nonet $state(nonet)} doc]} {
	return
    }
    $w.menu.file entryconfigure [mc {Save As...}] -state normal

    switch -- $state(validate) {
	dtd {
	    Feedback $win [mc "Validating document"]
	    if {[catch {$doc dtd validate} msg]} {
		Log addXMLError $win [dom::serialize $doc] $msg
		Feedback $win [mc "Document is not valid"]
		set dodisplay 0
	    } else {
		Log add $win $msg
	    }
	    set time(validate) [clock clicks -milliseconds]
	    Log timing $win "Validation took [expr $time(validate) - $time(last)]ms\n"
	    set time(last) $time(validate)
	}
	wxs {
	    Feedback $win [mc "Schema-validating document"]
	    set schemafname [GetFilename $win $w.validation.doc.urlentry schemaurl]
	    if {[string length $schemafname]} {
		set schematime(start) $time(last)
		if {[catch {ReadAndParseXML $win [mc "schema"] $schemafname ? schematime} schemadoc]} {
		    # continue
		} else {
		    set time(last) $schematime(last)
		    Feedback $win [mc "Preparing schema"]
		    if {[catch {$schemadoc schema compile} msg]} {
			Log add $win $msg
			Feedback $win [mc "Preparing schema failed"]
			set time(schemacompile) [clock clicks -milliseconds]
			set time(last) $time(schemacompile)
			set dodisplay 0
		    } else {
			set time(schemacompile) [clock clicks -milliseconds]
			Log timing $win "Preparing schema took [expr $time(schemacompile) - $time(last)]ms\n"
			set time(last) $time(schemacompile)

			Feedback $win [mc "Schema-validating document"]
			if {[catch {$schemadoc schema validate $doc} msg]} {
			    Log addXMLError $win [dom::serialize $doc] $msg
			    Feedback $win [mc "Document is not schema-valid"]
			    set dodisplay 0
			} else {
			    Log add $win $msg
			    Feedback $win [mc "Document is schema-valid"]
			}
			set time(schemavalidate) [clock clicks -milliseconds]
			Log timing $win "Schema validation took [expr $time(schemavalidate) - $time(last)]ms\n"
			set time(last) $time(schemavalidate)
		    }

		    # TODO: cache the compiled schema
		    dom::destroy $schemadoc
		}
	    }
	rng {
	    Feedback $win [mc "RELAX NG-validating document"]
	    set schemafname [GetFilename $win $w.validation.doc.urlentry schemaurl]
	    if {[string length $schemafname]} {
		set schematime(start) $time(last)
		if {[catch {ReadAndParseXML $win [mc "schema"] $schemafname ? schematime} schemadoc]} {
		    # continue
		} else {
		    set time(last) $schematime(last)
		    Feedback $win [mc "Preparing RELAX NG schema"]
		    if {[catch {$schemadoc relaxng compile} msg]} {
			Log add $win $msg
			Feedback $win [mc "Preparing RELAX NG schema failed"]
			set time(schemacompile) [clock clicks -milliseconds]
			set time(last) $time(schemacompile)
			set dodisplay 0
		    } else {
			set time(schemacompile) [clock clicks -milliseconds]
			Log timing $win "Preparing RELAX NG schema took [expr $time(schemacompile) - $time(last)]ms\n"
			set time(last) $time(schemacompile)

			Feedback $win [mc "RELAX NG-validating document"]
			if {[catch {$schemadoc relaxng validate $doc} msg]} {
			    Log addXMLError $win [dom::serialize $doc] $msg
			    Feedback $win [mc "Document is not RELAX NG-valid"]
			    set dodisplay 0
			} else {
			    Log add $win $msg
			    Feedback $win [mc "Document is RELAX NG-valid"]
			}
			set time(schemavalidate) [clock clicks -milliseconds]
			Log timing $win "RELAX NG validation took [expr $time(schemavalidate) - $time(last)]ms\n"
			set time(last) $time(schemavalidate)
		    }

		    # TODO: cache the compiled schema
		    dom::destroy $schemadoc
		}
	    }
	}
    }

    if {$dodisplay} {
	Log add $win [dom::serialize $doc -encoding $state(encoding)]
	set time(serialize) [clock clicks -milliseconds]
	Log timing $win "Displaying document took [expr $time(serialize) - $time(last)]ms\n"
	set time(last) $time(serialize)
    }

    Feedback $win [mc "Processing completed"]
    after 2000 [list Feedback $win {}]

    # We no longer destroy the document, since the user may wish to save it
    set state(dom) $doc

    Log timing $win "Total time: [expr $time(last) - $time(start)]ms\n"

    Log view $win start

    return {}
}

### Image data - end of script

image create photo libxml2Logo -data {

dkAAADs=
}
image create photo tclLogo -data {
R0lGODlhYQCWAPUAAP//////zP//mf//AP/MzP/Mmf/MAP+Zmf+ZZv+ZAMz/
/8zM/8zMzMyZzMyZmcyZZsyZAMxmZsxmM8xmAMwzM8wzAJnM/5nMzJmZzJmZ
mZlmmZlmZplmM5kzM5kzAGaZzGZmzGZmmWZmZmYzZmYzMzNmzDNmmTMzmTMz
ZgAzmQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH+BSAtZGwtACH5BAEKAAIALAAA
AABhAJYAAAb+QIFwSCwaj8ikcslsOp/Oh1RClVSu2KxWAu16jY9IpGrVms9o
9OPLJqbf8Lic2/7K0ZN0IpG/p9dGCAgPZBSGZ05+WRADBmcTA5EDfYqVcomV
jJNnkpGOlqBvmIqeZwaSBhOUoaxZo3eaq1eQkbKttxVOFIqnn1qnm7jCV7q8
AxBmscPDdEy7frVmkQnLzE5ld43JkdXDEdek1L/BlhKE3VffTdhy5LPalRIF
APQABOhP7HHuFQnHlRHqCbxXLR8vaQMqHRAIYMECeg8KRjmYBZIvOfPoLfiQ
ouMJBwEkNonoRxyWU7bSEKjHsaPLFBn0tXpC8o4sbncWNjTxsqf+hmU0Fa2y
mJPehZ5IT3QYBoWVv5RmAgLAgBQpCaBPWJ2aQ69lVZcollFoGgoenJVUv7o8
Ua1Zk1CQTKZZeFSty6XL3DIJxQjZGwkN7bq8amkCnzOAXil6ehYAT8Fh3xg2
IPeKv1RaEr8FtfXNAwBe7cbxNw3hxQobPnxQDO20mQAMBHckDAeYa9JaRvRc
UtZ1loWP7UYeXVoLLS0odispW1kLgLqCPdwh7VeL2SvJXZrgXZhfls/B1dIm
7r0CvxMvQXCvBAlqBQKxIZ+hYuo6lgmue65e3j0NYBCy4VUBBQ+sBEBIZpzS
XD+2KKeETHFAkgYCAMgWGQUMMASATNH+mGGLBw4mASEc+KmUll0joJBdRyBc
AJFx9r3RQYhIjFhbGgAAKNtXAQCAgBaMLIjGjNoxYeMbQgK241corHTAOO6Z
QWRH+ykRAShQPbDAklV14KR1vqVBwktNXLnMASdy6VIFL95XnphkMmHmMATo
qKZHFNDDjj+VrJhCmdUQEJ6aI0j1zBUDCJnGitsxUZMwAdz5UgcLEfSOJSuq
t9kw8UmawnsAPInFHpag11FWy3R6Jwp5bphFmHDEuakwaapJwmcIzqLoG7Lu
tUwGnqbgJQCP7sqrS6gOo0GwbAJwaAVRpjFlo7PisoFag76Ewmei3jJllb4O
c21VJmQ72Er+w4x5arLCTPnSCaEhxQGx6SLLLi7udoQCCbX25ICluOi2Lmu3
WMWvWk0eWYnAJ5C1DFIdbNCvSxr8uEx2JTjMyqN+fppBvC850E124IbLygHd
+hkWAyV8Nd4w9t4LykoWCzybB45VNVw1MRNciYEMpDhpBxVWhc4VPVc7cz0b
veRBBAp0eXQFHVHrhIChrATdSxU4sGVPI2ShsCJEavoE1kuDHFYDW3e01AEE
xL0MkV6gbclKdoJVAQNtr5Vht/gOLPPdOfd01VRqbQDAnLio6wUuwEHM5sQd
OeDqMDM23AXkRffUwX9qoTt3ChlvfstCVXkAelUn2FPNjCUrbcn+Z6ZyHVDe
L4UQ6ut/Pn7LZx1/Ct5XGtDLsx23AGazvl0XjlQGi3fTOxQY4KJ8T2FFXpXl
Y1ditRMhCAPAuHpnaG4K3Hdj9hPh47Ih2Ht3jtRC+HjxEy4ERAD/SkzS380X
7btF/vYnv5eM4DP160IAW4EyP13lIS4DTAKhsEBWROAAy3tgAe/Cpu4p4gs7
Y4UECKCu2VQAgqnr4P+8EDZhkPAlGvxKBSS4wi60EH/uimFSKlCgCT7hhqeT
AAxPuMEUhCV/PnQCEFsRgQcMEYVgG+HRvPCBlzGwdmGD4qQK4MFKaKYJJbDb
yVaUxSLS52hfZIIJxBgKBNisjEgZATb+uniHNC5BWHkRgd4sAIDadUQ6MyQA
HefQBTwuY1nM42N4UCABuOmpG3phgiG9UT7n4bGRj2xLIdkYCiF6pAIYsGQF
OkACFIDgcnmBAkc4GQquhbJlVTnlFJ+wSuthY0XNw51LQJArkTSBJ6y8A2BI
siIPFE+XHcEAwLDihI7Q6UAO8ErEQPOVBgCOmU1wpjB0kqZpUo4Aj8KmJD81
DADAcjBEmxgKnDXLZpJzm20bQZ76loIN9NKX4xSLJcPikO1dU5xKaEk1tPSu
vUUNewEYpB+eAKAQ4qIAaWoeUjawTHwqgScOxZ80aactQU4tF+7MKP50RALA
nDMFIvinRZP+wLyjRTMFcqSmS0T2UZBm04gfDQEIwiJTmNb0CggIaU1RwBYC
QOen6WhCS0S6jLAV4GtLnJo6lqAjplZjIR0I5jKmqgRYWhUUEArIs34aySMM
hhmfKcB8UInUshrhrMsAgFrPED2kXsGtRYBrOedqBgJYzK54JYJexebRSsgV
DQfgq11vmgIrViAgCj3sGSJQ0ZoyQZpmkIdc/4qFCx4gnFeQbGYBYFcsMMFO
YoSsGeCWjoqK1gxs/akaORiV2AKmDP7Lwmu1AM7S2pSltNWCan9zOQrIZLe/
Uaxs7xjcLAwXC/M4EnKxQMPFMvePk43tQrAxVjYp1zkKDcU4tVn+W30MEwv/
nC4W/FraJYQGDYAhwDVHSIgDsAOT8p1LZduJhLz5Z0RnLMd+k1iEk/p2vaW1
4xD8eOArqBSNSuhJg2eY4AhzbcKlDayEMZdVEpAgqyDW6tE0fGE5gNjDKSJq
sLCnohaP4MUv9rCMPxxiTuI1NMPxwIlLqSI/rvjHXILCSY0I5CIbWXCzPbKS
jwyFJTu5yE1+spQ9FeUpW3lH37vulbf8lSxbGCkluMAFdFkCBjStJxhoGQZ4
kuaeiLlWLbrAkE3w5p6E+QIgK5ITkJmCDyjgAwU0wVROWSsMUGUqrfOxOQf1
gQWEsieCLgGjN9JTOz9hyC7x8yn1E5/VRtvZnA0BwddeMpV4NdrTLxE0BnDn
aVQjJXZJOB+gGRAvDHT6oKSmNQBojRTQsJoegxL0B4bc6lHr5wlqcfVLSgCa
EiigXy4yQYZ8nALHTNrRkF60fhbgbMrBGglqAYGqXgLo58RyS6KuigIUMO4P
XMAECggPvNmtn3VTrs/I5rK+q1Llfft7epf9t8ChAIKCG/zgBi+XwhfOcIUL
3C51iHgRPgACTO9b4hhPAsXPt+SMe1ypIOA4lT9OclVKOlglT3kbKi5yJKv8
5V+g+JBhTvOaGyEIADs=
}

Init .
