tclxml-3.2/examples/tclxslt/common.tcl File Reference

Go to the source code of this file.

Functions/Subroutines
package require http ret	SetProperties (type win, type log)
ret	Browse (type win, type field, type args)
ret	ReadAndParseXML (type win, type label, type fname, type baseuri, optional timearr=time, type args)

---

Function Documentation

ret Browse	(	type	win,
		type	field,
		type	args
	)

$fname

Definition at line 55 of file tclxml-3.2/examples/tclxslt/common.tcl.

                                                {
    upvar \#0 State$win state

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

    array set opts {
    -title {Select Document}
    -type open
    -command {}
    }
    array set opts $args

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

    switch -- $opts(-type) {
    save {
        set fname [tk_getSaveFile -parent $win -title [mc $opts(-title)] -initialdir $cwd]
    }
    open -
    default {
        set fname [tk_getOpenFile -parent $win -title [mc $opts(-title)] -initialdir $cwd]
    }
    }

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

    set state($field) file:///$fname
    set state(cwd) [file dirname $fname]

    if {[string length $fname] && [string length $opts(-command)]} {
    uplevel #0 $opts(-command)
    }

    return {}
}

ret ReadAndParseXML	(	type	win,
		type	label,
		type	fname,
		type	baseuri,
		optional	timearr = time,
		type	args
	)

Definition at line 114 of file tclxml-3.2/examples/tclxslt/common.tcl.

                                                                                                              {
    upvar 1 $timearr time
    upvar \#0 State$win state

    array set opts {
    -noent 0
    -nonet 0
    }
    array set opts $args

    set state(externalentities) 0

    Feedback $win [mc "Opening $label document \"$fname\""]
    if {[string match http://* $fname]} {
    FeedbackProgress $win 0
    set state(start_download) [clock clicks -milliseconds]
    if {[catch {::http::geturl $fname \
            -command [list HTTPComplete $win] \
            -progress [list HTTPProgress $win] \
            -timeout 30000} token]} {
        tk_messageBox -message "unable to retrieve $label document \"$fname\" due to \"$token\"" -parent $win -type ok -icon error
        return -code error {}
    }
    ::http::wait $token
    if {[::http::status $token] != "ok"} {
        return -code error {}
    }
    set xml [::http::data $token]
    ::http::cleanup $token
    set time(read) [clock clicks -milliseconds]
    } else {
    if {[catch {open $fname} ch]} {
        tk_messageBox -message "unable to open $label document \"$fname\" due to \"$ch\"" -parent $win -type ok -icon error
        return -code error {}
    }
    set time(open) [clock clicks -milliseconds]
    Log timing $win "Opening $label document took [expr $time(open) - $time(start)]ms\n"

    Feedback $win [mc "Reading $label document"]
    # Take note of encoding information
    set encoding {}
    gets $ch xmldecl
    set re ^[::sgml::cl $::xml::Wsp]*<\\?xml[::sgml::cl $::xml::Wsp]+(version[::sgml::cl $::xml::Wsp]*=[::sgml::cl $::xml::Wsp]*("|')[::sgml::cl ^"']+\\2)?[::sgml::cl $::xml::Wsp]*(encoding[::sgml::cl $::xml::Wsp]*=[::sgml::cl $::xml::Wsp]*("|')([::sgml::cl ^"']+)\\4)?[::sgml::cl $::xml::Wsp]*(standalone[::sgml::cl $::xml::Wsp]*=[::sgml::cl $::xml::Wsp]*("|')(yes|no)\\7)?[::sgml::cl $::xml::Wsp]*\\?>
    if {[regexp $re $xmldecl discard allversion delimiter allencoding delimiter encoding allstandalone delimiter]} {
        if {[catch {fconfigure $ch -encoding $encoding} msg]} {
        if {[catch {fconfigure $ch -encoding [string tolower $encoding]} msg]} {
            tk_messageBox -message "unable to read $label document \"$fname\" due to \"$msg\"" -parent $win -type ok -icon error
            return -code error {}
        }
        }

package require http ret SetProperties	(	type	win,
		type	log
	)

Definition at line 30 of file tclxml-3.2/examples/tclxslt/common.tcl.

                                         {

    $log tag configure timing -background #bafdff
    $log tag configure error -background #ff9d8d
    $log tag configure errorhighlight -background #cd3030
    $log tag configure related -background #ffe59f
    $log tag configure relatedhighlight -background #e8b417
    $log tag configure message -background #ffe59f
    $log tag configure log -background #b9ffd4

    return {}
}