1#!/bin/sh
2# \
3exec wish "$0" "$@"
4
5# tkxmllint --
6#
7#	Simple GUI for xmllint-style processing of XML documents
8#
9# Copyright (c) 2003 Zveno
10# http://www.zveno.com/
11#
12# Insert std disclaimer here
13#
14# $Id: tkxmllint.tcl,v 1.1 2003/03/09 11:12:49 balls Exp $
15
16# Global initialisation
17
18package require dom
19package require dom::libxml2
20
21package require msgcat
22namespace import ::msgcat::mc
23
24package require uri
25
26# Init --
27#
28#	Create the GUI
29#
30# Arguments:
31#	win	toplevel window
32#
33# Results:
34#	Tk widgets created
35
36proc Init win {
37    upvar \#0 State$win state
38
39    set w [expr {$win == "." ? {} : $win}]
40
41    set state(url) {}
42
43    wm title $win "Tk XML Lint"
44
45    menu $w.menu -tearoff 0
46    $win configure -menu $w.menu
47    $w.menu add cascade -label [mc File] -menu $w.menu.file
48    menu $w.menu.file -tearoff 1
49    $w.menu.file add command -label [mc {New Window}] -command NewWindow
50    $w.menu.file add separator
51    $w.menu.file add command -label [mc Quit] -command {destroy .}
52    # TODO: Help menu
53
54    frame $w.controls
55    grid $w.controls -row 0 -column 0 -sticky ew
56    button $w.controls.check -text [mc Check] -command [list Check $win]
57    # TODO: add a nice icon
58    grid $w.controls.check -row 0 -column 0 -sticky w
59    grid columnconfigure $w.controls 0 -weight 1
60
61    labelframe $w.doc -text [mc Document]
62    grid $w.doc -row 1 -column 0 -sticky ew
63    label $w.doc.url -text [mc URL:]
64    entry $w.doc.urlentry -width 60 -textvariable State${win}(url)
65    button $w.doc.browse -text [mc Browse] -command [list Browse $win]
66    grid $w.doc.url -row 0 -column 0 -sticky w
67    grid $w.doc.urlentry -row 0 -column 1 -sticky ew
68    grid $w.doc.browse -row 0 -column 2 -sticky e
69    grid columnconfigure $w.doc 1 -weight 1
70
71    labelframe $w.options -text [mc Options]
72    grid $w.options -row 2 -column 0 -sticky ew
73    checkbutton $w.options.noout -text [mc {Display document}] -variable State${win}(display)
74    label $w.options.validate -text [mc Validate]
75    radiobutton $w.options.novalidate -text [mc no] -variable State${win}(validate) -value no
76    radiobutton $w.options.validatedoc -text [mc yes] -variable State${win}(validate) -value yes
77    set state(validate) no
78    checkbutton $w.options.timing -text [mc {Display timing}] -variable State${win}(timing)
79    checkbutton $w.options.xinclude -text [mc XInclude] -variable State${win}(xinclude)
80    grid $w.options.validate -row 0 -column 0 -sticky w
81    grid $w.options.novalidate -row 0 -column 1 -sticky w
82    grid $w.options.validatedoc -row 1 -column 1 -sticky w
83    grid $w.options.noout -row 0 -column 2 -sticky w
84    grid $w.options.timing -row 1 -column 2 -sticky w
85    grid $w.options.xinclude -row 2 -column 2 -sticky w
86    grid columnconfigure $w.options 2 -weight 1
87
88    labelframe $w.messages -text [mc Messages]
89    grid $w.messages -row 3 -column 0 -sticky news
90    text $w.messages.log -wrap none \
91	-state disabled \
92	-xscrollcommand [list $w.messages.xscroll set] \
93	-yscrollcommand [list $w.messages.yscroll set]
94    scrollbar $w.messages.xscroll -orient horizontal \
95	-command [list $w.messages.log xview]
96    scrollbar $w.messages.yscroll -orient vertical \
97	-command [list $w.messages.log yview]
98    grid $w.messages.log -row 0 -column 0 -sticky news
99    grid $w.messages.yscroll -row 0 -column 1 -sticky ns
100    grid $w.messages.xscroll -row 1 -column 0 -sticky ew
101    grid rowconfigure $w.messages 0 -weight 1
102    grid columnconfigure $w.messages 0 -weight 1
103
104    frame $w.feedback
105    grid $w.feedback -row 4 -column 0 -sticky ew
106    label $w.feedback.msg -textvariable State${win}(feedback)
107    canvas $w.feedback.progress -width 100 -height 25
108    grid $w.feedback.progress -row 0 -column 0
109    grid $w.feedback.msg -row 0 -column 1 -sticky ew
110
111    grid rowconfigure $win 3 -weight 1
112    grid columnconfigure $win 0 -weight 1
113
114    return {}
115}
116
117# NewWindow --
118#
119#	Create another toplevel window
120#
121# Arguments:
122#	None
123#
124# Results:
125#	Tk toplevel created and initialised
126
127proc NewWindow {} {
128    global counter
129
130    Init [toplevel .top[Incr counter]]
131
132    return {}
133}
134
135# Browse --
136#
137#	Choose a file
138#
139# Arguments:
140#	win	toplevel window
141#
142# Results:
143#	Current file is set
144
145proc Browse win {
146    upvar \#0 State$win state
147
148    set w [expr {$win == "." ? {} : $win}]
149
150    set fname [tk_getOpenFile -parent $win -title "Select XML Document"]
151    if {![string length $fname]} {
152	return {}
153    }
154
155    set state(url) file://$fname
156
157    return {}
158}
159
160# Check --
161#
162#	Parse the given document and display report
163#
164# Arguments:
165#	win	toplevel window
166#
167# Results:
168#	Document read into memory, parsed and report displayed
169
170proc Check win {
171    upvar \#0 State$win state
172
173    set w [expr {$win == "." ? {} : $win}]
174
175    set state(url) [$w.doc.urlentry get]
176
177    if {[catch {uri::split $state(url)} spliturl]} {
178	# Try the URL as a pathname
179	set fname $state(url)
180	set state(url) file://$state(url)
181    } else {
182	array set urlarray $spliturl
183	switch -- $urlarray(scheme) {
184	    http {
185		tk_messageBox -message "http URLs are not supported yet" -parent $win -type ok -icon warning
186		return {}
187	    }
188	    file {
189		set fname $urlarray(path)
190	    }
191	    default {
192		tk_messageBox -message "\"$urlarray(scheme)\" type URLs are not supported" -parent $win -type ok -icon warning
193		return {}
194	    }
195	}
196    }
197
198    Log clear $win
199    set time(start) [clock clicks -milliseconds]
200
201    Feedback $win [mc "Opening $fname"]
202    if {[catch {open $fname} ch]} {
203	tk_messageBox -message "unable to open document \"$fname\" due to \"$ch\"" -parent $win -type ok -icon error
204	return {}
205    }
206    set time(open) [clock clicks -milliseconds]
207    Log timing $win "Opening document took [expr $time(open) - $time(start)]ms\n"
208
209    Feedback $win [mc "Reading document"]
210    set xml [read $ch]
211    close $ch
212    set time(read) [clock clicks -milliseconds]
213    Log timing $win "Reading document took [expr $time(read) - $time(open)]ms\n"
214
215    Feedback $win [mc "Parsing XML"]
216    if {[catch {dom::parse $xml -baseuri $state(url)} doc]} {
217	Log add $win $doc
218    }
219    set time(parse) [clock clicks -milliseconds]
220    Log timing $win "Parsing document took [expr $time(parse) - $time(read)]ms\n"
221    set time(last) $time(parse)
222
223    if {$state(xinclude)} {
224	Feedback $win [mc "XInclude processing"]
225	if {[catch {dom::xinclude $doc} msg]} {
226	    Log add $win $msg
227	    Feedback $win [mc "XInclude processing failed"]
228	    after 2000 [list Feedback $win {}]
229	}
230	set time(xinclude) [clock clicks -milliseconds]
231	Log timing $win "XInclude took [expr $time(xinclude) - $time(last)]ms\n"
232	set time(last) $time(xinclude)
233    }
234
235    if {$state(validate)} {
236	Feedback $win [mc "Validating document"]
237	if {[catch {dom::validate $doc} msg]} {
238	    Feedback $win [mc "Document is not valid"]
239	}
240	Log add $win $msg
241	set time(validate) [clock clicks -milliseconds]
242	Log timing $win "Validation took [expr $time(validate) - $time(last)]ms\n"
243	set time(last) $time(validate)
244    }
245
246    if {$state(display)} {
247	Log add $win [dom::serialize $doc]
248	set time(serialize) [clock clicks -milliseconds]
249	Log timing $win "Displaying document took [expr $time(serialize) - $time(last)]ms\n"
250	set time(last) $time(serialize)
251    }
252
253    Feedback $win [mc "Processing completed"]
254    after 2000 [list Feedback $win {}]
255
256    dom::destroy $doc
257    set time(destroy) [clock clicks -milliseconds]
258    Log timing $win "Freeing took [expr $time(destroy) - $time(last)]ms\n"
259
260    Log timing $win "Total time: [expr $time(destroy) - $time(start)]ms\n"
261
262    return {}
263}
264
265# Log -- Manage the log window
266
267proc Log {method win args} {
268    upvar \#0 State$win state
269
270    set w [expr {$win == "." ? {} : $win}]
271
272    switch -- $method {
273	clear {
274	    $w.messages.log configure -state normal
275	    $w.messages.log delete 1.0 end
276	    $w.messages.log configure -state disabled
277	}
278	add {
279	    $w.messages.log configure -state normal
280	    $w.messages.log insert end [lindex $args 0]
281	    $w.messages.log configure -state disabled
282	}
283	timing {
284	    if {$state(timing)} {
285		$w.messages.log configure -state normal
286		$w.messages.log insert end [lindex $args 0]
287		$w.messages.log configure -state disabled
288	    }
289	}
290	default {
291	    return -code error "unknown method \"$method\""
292	}
293    }
294
295    return {}
296}
297
298# Feedback -- Manage the feedback widget
299
300proc Feedback {win msg} {
301    upvar \#0 State$win state
302
303    set state(feedback) $msg
304    update
305
306    return {}
307}
308
309# Incr -- utility to increment a variable, handling non-existance
310
311proc Incr var {
312    upvar $var v
313    if {[info exists v]} {
314	incr v
315    } else {
316	set v 1
317    }
318
319    return $v
320}
321
322Init .
323