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