TextSweep

package ifneeded tdom 0.8.3 "load [list [file join $dir libtdom0.8.3.dylib]];         source [list [file join $dir tdom.tcl]]"

#----------------------------------------------------------------------------
#   Copyright (c) 1999 Jochen Loewer (loewerj@hotmail.com)
#----------------------------------------------------------------------------
#
#   $Id: tdom.tcl,v 1.19 2005/01/11 15:57:19 rolf Exp $
#
#
#   The higher level functions of tDOM written in plain Tcl.
#
#
#   The contents of this file are subject to the Mozilla Public License
#   Version 1.1 (the "License"); you may not use this file except in
#   compliance with the License. You may obtain a copy of the License at
#   http://www.mozilla.org/MPL/
#
#   Software distributed under the License is distributed on an "AS IS"
#   basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
#   License for the specific language governing rights and limitations
#   under the License.
#
#   The Original Code is tDOM.
#
#   The Initial Developer of the Original Code is Jochen Loewer
#   Portions created by Jochen Loewer are Copyright (C) 1998, 1999
#   Jochen Loewer. All Rights Reserved.
#
#   Contributor(s):
#       Rolf Ade (rolf@pointsman.de):   'fake' nodelists/live childNodes
#
#   written by Jochen Loewer
#   April, 1999
#
#----------------------------------------------------------------------------

package require tdom 

#----------------------------------------------------------------------------
#   setup namespaces for additional Tcl level methods, etc.
#
#----------------------------------------------------------------------------
namespace eval ::dom {
    namespace eval  domDoc {
    }
    namespace eval  domNode {
    }
    namespace eval  DOMImplementation {
    }
    namespace eval  xpathFunc {
    }
    namespace eval  xpathFuncHelper {
    }
}

namespace eval ::tDOM { 
    variable extRefHandlerDebug 0
    variable useForeignDTD ""

    namespace export xmlOpenFile xmlReadFile extRefHandler baseURL
}

#----------------------------------------------------------------------------
#   hasFeature (DOMImplementation method)
#
#
#   @in  url    the URL, where to get the XML document
#
#   @return     document object
#   @exception  XML parse errors, ...
#
#----------------------------------------------------------------------------
proc ::dom::DOMImplementation::hasFeature { dom feature {version ""} } {

    switch $feature {
        xml -
        XML {
            if {($version == "") || ($version == "1.0")} {
                return 1
            }
        }
    }
    return 0

}

#----------------------------------------------------------------------------
#   load (DOMImplementation method)
#
#       requests a XML document via http using the given URL and
#       builds up a DOM tree in memory returning the document object
#
#
#   @in  url    the URL, where to get the XML document
#
#   @return     document object
#   @exception  XML parse errors, ...
#
#----------------------------------------------------------------------------
proc ::dom::DOMImplementation::load { dom url } {

    error "Sorry, load method not implemented yet!"

}

#----------------------------------------------------------------------------
#   isa (docDoc method, for [incr tcl] compatibility)
#
#
#   @in  className
#
#   @return         1 iff inherits from the given class
#
#----------------------------------------------------------------------------
proc ::dom::domDoc::isa { doc className } {

    if {$className == "domDoc"} {
        return 1
    }
    return 0
}

#----------------------------------------------------------------------------
#   info (domDoc method, for [incr tcl] compatibility)
#
#
#   @in  subcommand
#   @in  args
#
#----------------------------------------------------------------------------
proc ::dom::domDoc::info { doc subcommand args } {

    switch $subcommand {
        class {
            return "domDoc"
        }
        inherit {
            return ""
        }
        heritage {
            return "domDoc {}"
        }
        default {
            error "domDoc::info subcommand $subcommand not yet implemented!"
        }
    }
}

#----------------------------------------------------------------------------
#   importNode (domDoc method)
#
#       Document Object Model (Core) Level 2 method
#
#
#   @in  subcommand
#   @in  args
#
#----------------------------------------------------------------------------
proc ::dom::domDoc::importNode { doc importedNode deep } {

    if {$deep || ($deep == "-deep")} {
        set node [$importedNode cloneNode -deep]
    } else {
        set node [$importedNode cloneNode]
    }
    return $node
}

#----------------------------------------------------------------------------
#   isa (domNode method, for [incr tcl] compatibility)
#
#
#   @in  className
#
#   @return         1 iff inherits from the given class
#
#----------------------------------------------------------------------------
proc ::dom::domNode::isa { doc className } {

    if {$className == "domNode"} {
        return 1
    }
    return 0
}

#----------------------------------------------------------------------------
#   info (domNode method, for [incr tcl] compatibility)
#
#
#   @in  subcommand
#   @in  args
#
#----------------------------------------------------------------------------
proc ::dom::domNode::info { doc subcommand args } {

    switch $subcommand {
        class {
            return "domNode"
        }
        inherit {
            return ""
        }
        heritage {
            return "domNode {}"
        }
        default {
            error "domNode::info subcommand $subcommand not yet implemented!"
        }
    }
}

#----------------------------------------------------------------------------
#   isWithin (domNode method)
#
#       tests, whether a node object is nested below another tag
#
#
#   @in  tagName  the nodeName of an elment node
#
#   @return       1 iff node is nested below a element with nodeName tagName
#                 0 otherwise
#
#----------------------------------------------------------------------------
proc ::dom::domNode::isWithin { node tagName } {

    while {[$node parentNode] != ""} {
        set node [$node parentNode]
        if {[$node nodeName] == $tagName} {
            return 1
        }
    }
    return 0
}

#----------------------------------------------------------------------------
#   tagName (domNode method)
#
#       same a nodeName for element interface
#
#----------------------------------------------------------------------------
proc ::dom::domNode::tagName { node } {

    if {[$node nodeType] == "ELEMENT_NODE"} {
        return [$node nodeName]
    }
    return -code error "NOT_SUPPORTED_ERR not an element!"
}

#----------------------------------------------------------------------------
#   simpleTranslate (domNode method)
#
#       applies simple translation rules similar to Cost's simple
#       translations to a node
#
#
#   @in  output_var
#   @in  trans_specs
#
#----------------------------------------------------------------------------
proc ::dom::domNode::simpleTranslate { node output_var trans_specs } {

    upvar $output_var output

    if {[$node nodeType] == "TEXT_NODE"} {
        append output [cgiQuote [$node nodeValue]]
        return
    }
    set found 0

    foreach {match action} $trans_specs {

        if {[catch {
            if {!$found && ([$node selectNode self::$match] != "") } {
              set found 1
            }
        } err]} {
            if {![string match "NodeSet expected for parent axis!" $err]} {
                error $err
            }
        }
        if {$found && ($action != "-")} {
            set stop 0
            foreach {type value} $action {
                switch $type {
                    prefix { append output [subst $value] }
                    tag    { append output <$value>       }
                    start  { append output [eval $value]  }
                    stop   { set stop 1                   }
                }
            }
            if {!$stop} {
                foreach child [$node childNodes] {
                    simpleTranslate  $child output $trans_specs
                }
            }
            foreach {type value} $action {
                switch $type {
                    suffix { append output [subst $value] }
                    end    { append output [eval $value]  }
                    tag    { append output </$value>      }
                }
            }
            return
        }
    }
    foreach child [$node childNodes] {
        simpleTranslate $child output $trans_specs
    }
}

#----------------------------------------------------------------------------
#   a DOM conformant 'live' childNodes
#
#   @return   a 'nodelist' object (it is just the normal node)
#
#----------------------------------------------------------------------------
proc ::dom::domNode::childNodesLive { node } {

    return $node
}

#----------------------------------------------------------------------------
#   item method on a 'nodelist' object
#
#   @return   a 'nodelist' object (it is just a normal
#
#----------------------------------------------------------------------------
proc ::dom::domNode::item { nodeListNode index } {

    return [lindex [$nodeListNode childNodes] $index]
}

#----------------------------------------------------------------------------
#   length method on a 'nodelist' object
#
#   @return   a 'nodelist' object (it is just a normal
#
#----------------------------------------------------------------------------
proc ::dom::domNode::length { nodeListNode } {

    return [llength [$nodeListNode childNodes]]
}

#----------------------------------------------------------------------------
#   appendData on a 'CharacterData' object
#
#----------------------------------------------------------------------------
proc ::dom::domNode::appendData { node  arg } {

    set type [$node nodeType]
    if {($type != "TEXT_NODE") && ($type != "CDATA_SECTION_NODE") &&
        ($type != "COMMENT_NODE")
    } {
        return -code error "NOT_SUPPORTED_ERR: node is not a cdata node"
    }
    set oldValue [$node nodeValue]
    $node nodeValue [append oldValue $arg]
}

#----------------------------------------------------------------------------
#   deleteData on a 'CharacterData' object
#
#----------------------------------------------------------------------------
proc ::dom::domNode::deleteData { node offset count } {

    set type [$node nodeType]
    if {($type != "TEXT_NODE") && ($type != "CDATA_SECTION_NODE") &&
        ($type != "COMMENT_NODE")
    } {
        return -code error "NOT_SUPPORTED_ERR: node is not a cdata node"
    }
    incr offset -1
    set before [string range [$node nodeValue] 0 $offset]
    incr offset
    incr offset $count
    set after  [string range [$node nodeValue] $offset end]
    $node nodeValue [append before $after]
}

#----------------------------------------------------------------------------
#   insertData on a 'CharacterData' object
#
#----------------------------------------------------------------------------
proc ::dom::domNode::insertData { node  offset arg } {

    set type [$node nodeType]
    if {($type != "TEXT_NODE") && ($type != "CDATA_SECTION_NODE") &&
        ($type != "COMMENT_NODE")
    } {
        return -code error "NOT_SUPPORTED_ERR: node is not a cdata node"
    }
    incr offset -1
    set before [string range [$node nodeValue] 0 $offset]
    incr offset
    set after  [string range [$node nodeValue] $offset end]
    $node nodeValue [append before $arg $after]
}

#----------------------------------------------------------------------------
#   replaceData on a 'CharacterData' object
#
#----------------------------------------------------------------------------
proc ::dom::domNode::replaceData { node offset count arg } {

    set type [$node nodeType]
    if {($type != "TEXT_NODE") && ($type != "CDATA_SECTION_NODE") &&
        ($type != "COMMENT_NODE")
    } {
        return -code error "NOT_SUPPORTED_ERR: node is not a cdata node"
    }
    incr offset -1
    set before [string range [$node nodeValue] 0 $offset]
    incr offset
    incr offset $count
    set after  [string range [$node nodeValue] $offset end]
    $node nodeValue [append before $arg $after]
}

#----------------------------------------------------------------------------
#   substringData on a 'CharacterData' object
#
#   @return   part of the node value (text)
#
#----------------------------------------------------------------------------
proc ::dom::domNode::substringData { node offset count } {

    set type [$node nodeType]
    if {($type != "TEXT_NODE") && ($type != "CDATA_SECTION_NODE") &&
        ($type != "COMMENT_NODE")
    } {
        return -code error "NOT_SUPPORTED_ERR: node is not a cdata node"
    }
    set endOffset [expr $offset + $count - 1]
    return [string range [$node nodeValue] $offset $endOffset]
}

#----------------------------------------------------------------------------
#   coerce2number
#
#----------------------------------------------------------------------------
proc ::dom::xpathFuncHelper::coerce2number { type value } {
    switch $type {
        empty      { return 0 }
        number -
        string     { return $value }
        attrvalues { return [lindex $value 0] }
        nodes      { return [[lindex $value 0] selectNodes number()] }
        attrnodes  { return [lindex $value 1] }
    }
}

#----------------------------------------------------------------------------
#   coerce2string
#
#----------------------------------------------------------------------------
proc ::dom::xpathFuncHelper::coerce2string { type value } {
    switch $type {
        empty      { return "" }
        number -
        string     { return $value }
        attrvalues { return [lindex $value 0] }
        nodes      { return [[lindex $value 0] selectNodes string()] }
        attrnodes  { return [lindex $value 1] }
    }
}

#----------------------------------------------------------------------------
#   function-available
#
#----------------------------------------------------------------------------
proc ::dom::xpathFunc::function-available { ctxNode pos
                                            nodeListType nodeList args} {

    if {[llength $args] != 2} {
        error "function-available(): wrong # of args!"
    }
    foreach { arg1Typ arg1Value } $args break
    set str [::dom::xpathFuncHelper::coerce2string $arg1Typ $arg1Value ]
    switch $str {
        boolean -
        ceiling -
        concat -
        contains -
        count -
        current -
        document -
        element-available -
        false -
        floor -
        format-number -
        generate-id -
        id -
        key -
        last -
        lang -
        local-name -
        name -
        namespace-uri -
        normalize-space -
        not -
        number -
        position -
        round -
        starts-with -
        string -
        string-length -
        substring -
        substring-after -
        substring-before -
        sum -
        translate -
        true -
        unparsed-entity-uri {
            return [list bool true]
        }
        default {
            set TclXpathFuncs [info procs ::dom::xpathFunc::*]
            if {[lsearch -exact $TclXpathFuncs $str] != -1} {
                return [list bool true]
            } else {
                return [list bool false]
            }
        }
    }
}

#----------------------------------------------------------------------------
#   element-available
#
#   This is not strictly correct. The XSLT namespace may be bound
#   to another prefix (and the prefix 'xsl' may be bound to another
#   namespace). Since the expression context isn't available at the
#   moment at tcl coded XPath functions, this couldn't be done better
#   than this "works in the 'normal' cases" version.
#----------------------------------------------------------------------------
proc ::dom::xpathFunc::element-available { ctxNode pos
                                            nodeListType nodeList args} {

    if {[llength $args] != 2} {
        error "element-available(): wrong # of args!"
    }
    foreach { arg1Typ arg1Value } $args break
    set str [::dom::xpathFuncHelper::coerce2string $arg1Typ $arg1Value ]
    switch $str {
        xsl:stylesheet -
        xsl:transform -
        xsl:include -
        xsl:import -
        xsl:strip-space -
        xsl:preserve-space -
        xsl:template -
        xsl:apply-templates -
        xsl:apply-imports -
        xsl:call-template -
        xsl:element -
        xsl:attribute -
        xsl:attribute-set -
        xsl:text -
        xsl:processing-instruction -
        xsl:comment -
        xsl:copy -
        xsl:value-of -
        xsl:number -
        xsl:for-each -
        xsl:if -
        xsl:choose -
        xsl:when -
        xsl:otherwise -
        xsl:sort -
        xsl:variable -
        xsl:param -
        xsl:copy-of -
        xsl:with-param -
        xsl:key -
        xsl:message -
        xsl:decimal-format -
        xsl:namespace-alias -
        xsl:output -
        xsl:fallback {
            return [list bool true]
        }
        default {
            return [list bool false]
        }
    }
}

#----------------------------------------------------------------------------
#   system-property
#
#   This is not strictly correct. The XSLT namespace may be bound
#   to another prefix (and the prefix 'xsl' may be bound to another
#   namespace). Since the expression context isn't available at the
#   moment at tcl coded XPath functions, this couldn't be done better
#   than this "works in the 'normal' cases" version.
#----------------------------------------------------------------------------
proc ::dom::xpathFunc::system-property { ctxNode pos
                                         nodeListType nodeList args } {

    if {[llength $args] != 2} {
        error "system-property(): wrong # of args!"
    }
    foreach { arg1Typ arg1Value } $args break
    set str [::dom::xpathFuncHelper::coerce2string $arg1Typ $arg1Value ]
    switch $str {
        xsl:version {
            return [list number 1.0]
        }
        xsl:vendor {
            return [list string "Jochen Loewer (loewerj@hotmail.com), Rolf Ade (rolf@pointsman.de) et. al."]
        }
        xsl:vendor-url {
            return [list string "http://www.tdom.org"]
        }
        default {
            return [list string ""]
        }
    }
}

#----------------------------------------------------------------------------
#   IANAEncoding2TclEncoding
#
#----------------------------------------------------------------------------

# As of version 8.3.4 tcl supports 
# cp860 cp861 cp862 cp863 tis-620 cp864 cp865 cp866 gb12345 cp949
# cp950 cp869 dingbats ksc5601 macCentEuro cp874 macUkraine jis0201
# gb2312 euc-cn euc-jp iso8859-10 macThai jis0208 iso2022-jp
# macIceland iso2022 iso8859-13 iso8859-14 jis0212 iso8859-15 cp737
# iso8859-16 big5 euc-kr macRomania macTurkish gb1988 iso2022-kr
# macGreek ascii cp437 macRoman iso8859-1 iso8859-2 iso8859-3 ebcdic
# macCroatian koi8-r iso8859-4 iso8859-5 cp1250 macCyrillic iso8859-6
# cp1251 koi8-u macDingbats iso8859-7 cp1252 iso8859-8 cp1253
# iso8859-9 cp1254 cp1255 cp850 cp1256 cp932 identity cp1257 cp852
# macJapan cp1258 shiftjis utf-8 cp855 cp936 symbol cp775 unicode
# cp857
# 
# Just add more mappings (and mail them to the tDOM mailing list, please).

proc tDOM::IANAEncoding2TclEncoding {IANAName} {
    
    # First the most widespread encodings with there
    # preferred MIME name, to speed lookup in this
    # usual cases. Later the official names and the
    # aliases.
    #
    # For "official names for character sets that may be
    # used in the Internet" see 
    # http://www.iana.org/assignments/character-sets
    # (that's the source for the encoding names below)
    # 
    # Matching is case-insensitive

    switch [string tolower $IANAName] {
        "us-ascii"    {return ascii}
        "utf-8"       {return utf-8}
        "utf-16"      {return unicode; # not sure about this}
        "iso-8859-1"  {return iso8859-1}
        "iso-8859-2"  {return iso8859-2}
        "iso-8859-3"  {return iso8859-3}
        "iso-8859-4"  {return iso8859-4}
        "iso-8859-5"  {return iso8859-5}
        "iso-8859-6"  {return iso8859-6}
        "iso-8859-7"  {return iso8859-7}
        "iso-8859-8"  {return iso8859-8}
        "iso-8859-9"  {return iso8859-9}
        "iso-8859-10" {return iso8859-10}
        "iso-8859-13" {return iso8859-13}
        "iso-8859-14" {return iso8859-14}
        "iso-8859-15" {return iso8859-15}
        "iso-8859-16" {return iso8859-16}
        "iso-2022-kr" {return iso2022-kr}
        "euc-kr"      {return euc-kr}
        "iso-2022-jp" {return iso2022-jp}
        "koi8-r"      {return koi8-r}
        "shift_jis"   {return shiftjis}
        "euc-jp"      {return euc-jp}
        "gb2312"      {return gb2312}
        "big5"        {return big5}
        "cp866"       {return cp866}
        "cp1250"      {return cp1250}
        "cp1253"      {return cp1253}
        "cp1254"      {return cp1254}
        "cp1255"      {return cp1255}
        "cp1256"      {return cp1256}
        "cp1257"      {return cp1257}

        "windows-1251" -
        "cp1251"      {return cp1251}

        "windows-1252" -
        "cp1252"      {return cp1252}    

        "iso_8859-1:1987" -
        "iso-ir-100" -
        "iso_8859-1" -
        "latin1" -
        "l1" -
        "ibm819" -
        "cp819" -
        "csisolatin1" {return iso8859-1}
        
        "iso_8859-2:1987" -
        "iso-ir-101" -
        "iso_8859-2" -
        "iso-8859-2" -
        "latin2" -
        "l2" -
        "csisolatin2" {return iso8859-2}

        "iso_8859-5:1988" -
        "iso-ir-144" -
        "iso_8859-5" -
        "iso-8859-5" -
        "cyrillic" -
        "csisolatincyrillic" {return iso8859-5}

        "ms_kanji" -
        "csshiftjis"  {return shiftjis}
        
        "csiso2022kr" {return iso2022-kr}

        "ibm866" -
        "csibm866"    {return cp866}
        
        default {
            # There are much more encoding names out there
            # It's only laziness, that let me stop here.
            error "Unrecognized encoding name '$IANAName'"
        }
    }
}

#----------------------------------------------------------------------------
#   xmlOpenFile
#
#----------------------------------------------------------------------------
proc tDOM::xmlOpenFile {filename {encodingString {}}} {

    set fd [open $filename]

    if {$encodingString != {}} {
        upvar $encodingString encString
    }

    # The autodetection of the encoding follows
    # XML Recomendation, Appendix F

    fconfigure $fd -encoding binary
    if {![binary scan [read $fd 4] "H8" firstBytes]} {
        # very short (< 4 Bytes) file
        seek $fd 0 start
        set encString UTF-8
        return $fd
    }
    
    # First check for BOM
    switch [string range $firstBytes 0 3] {
        "feff" -
        "fffe" {
            # feff: UTF-16, big-endian BOM
            # ffef: UTF-16, little-endian BOM
            seek $fd 0 start
            set encString UTF-16            
            fconfigure $fd -encoding identity
            return $fd
        }
    }

    # If the entity has a XML Declaration, the first four characters
    # must be "<?xm".
    switch $firstBytes {
        "3c3f786d" {
            # UTF-8, ISO 646, ASCII, some part of ISO 8859, Shift-JIS,
            # EUC, or any other 7-bit, 8-bit, or mixed-width encoding which 
            # ensures that the characters of ASCII have their normal positions,
            # width and values; the actual encoding declaration must be read to
            # detect which of these applies, but since all of these encodings
            # use the same bit patterns for the ASCII characters, the encoding
            # declaration itself be read reliably.

            # First 300 bytes should be enough for a XML Declaration
            # This is of course not 100 percent bullet-proof.
            set head [read $fd 296]

            # Try to find the end of the XML Declaration
            set closeIndex [string first ">" $head]
            if {$closeIndex == -1} {
                error "Weird XML data or not XML data at all"
            }

            seek $fd 0 start
            set xmlDeclaration [read $fd [expr {$closeIndex + 5}]]
            # extract the encoding information
            set pattern {^[^>]+encoding=[\x20\x9\xd\xa]*["']([^ "']+)['"]}
            # emacs: "
            if {![regexp $pattern $head - encStr]} {
                # Probably something like <?xml version="1.0"?>. 
                # Without encoding declaration this must be UTF-8
                set encoding utf-8
                set encString UTF-8
            } else {
                set encoding [IANAEncoding2TclEncoding $encStr]
                set encString $encStr
            }
        }
        "0000003c" -
        "0000003c" -
        "3c000000" -
        "00003c00" {
            # UCS-4
            error "UCS-4 not supported"
        }
        "003c003f" -
        "3c003f00" {
            # UTF-16, big-endian, no BOM
            # UTF-16, little-endian, no BOM
            seek $fd 0 start
            set encoding identity
            set encString UTF-16
        }
        "4c6fa794" {
            # EBCDIC in some flavor
            error "EBCDIC not supported"
        }
        default {
            # UTF-8 without an encoding declaration
            seek $fd 0 start
            set encoding identity
            set encString "UTF-8"
        }
    }
    fconfigure $fd -encoding $encoding
    return $fd
}

#----------------------------------------------------------------------------
#   xmlReadFile
#
#----------------------------------------------------------------------------
proc tDOM::xmlReadFile {filename {encodingString {}}} {

    if {$encodingString != {}} {
        upvar $encodingString encString
    }
    
    set fd [xmlOpenFile $filename encString]
    set data [read $fd [file size $filename]]
    close $fd 
    return $data
}

#----------------------------------------------------------------------------
#   extRefHandler
#   
#   A very simple external entity resolver, included for convenience.
#   Depends on the tcllib package uri and resolves only file URLs. 
#
#----------------------------------------------------------------------------

if {![catch {package require uri}]} {
    proc tDOM::extRefHandler {base systemId publicId} {
        variable extRefHandlerDebug
        variable useForeignDTD

        if {$extRefHandlerDebug} {
            puts stderr "tDOM::extRefHandler called with:"
            puts stderr "\tbase:     '$base'"
            puts stderr "\tsystemId: '$systemId'"
            puts stderr "\tpublicId: '$publicId'"
        }
        if {$systemId == ""} {
            if {$useForeignDTD != ""} {
                set systemId $useForeignDTD
            } else {
                error "::tDOM::useForeignDTD does\
                        not point to the foreign DTD"
            }
        }
        set absolutURI [uri::resolve $base $systemId]
        array set uriData [uri::split $absolutURI]
        switch $uriData(scheme) {
            file {
                return [list string $absolutURI [xmlReadFile $uriData(path)]]
            }
            default {
                error "can only handle file URI's"
            }
        }
    }
}

#----------------------------------------------------------------------------
#   baseURL
#   
#   A simple convenience proc which returns an absolute URL for a given
#   filename.
#
#----------------------------------------------------------------------------

proc tDOM::baseURL {path} {
    switch [file pathtype $path] {
        "relative" {
            return "file://[pwd]/$path"
        }
        default {
            return "file://$path"
        }
    }
}

# EOF

if { $::tcl_platform(os) ne "Darwin" } {
     return;
   }

package ifneeded tls 1.6.1     "[list source [file join $dir tls.tcl]] ;      [list tls::initlib $dir libtls1.6.1.dylib]"

#
# Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com> 
#
# $Header: /cvsroot/tls/tls/tls.tcl,v 1.12 2010/07/27 17:15:47 hobbs2 Exp $
#
namespace eval tls {
    variable logcmd tclLog
    variable debug 0
 
    # Default flags passed to tls::import
    variable defaults {}

    # Maps UID to Server Socket
    variable srvmap
    variable srvuid 0

    # Over-ride this if you are using a different socket command
    variable socketCmd
    if {![info exists socketCmd]} {
        set socketCmd [info command ::socket]
    }
}

proc tls::initlib {dir dll} {
    # Package index cd's into the package directory for loading.
    # Irrelevant to unixoids, but for Windows this enables the OS to find
    # the dependent DLL's in the CWD, where they may be.
    set cwd [pwd]
    catch {cd $dir}
    if {[string equal $::tcl_platform(platform) "windows"] &&
	![string equal [lindex [file system $dir] 0] "native"]} {
	# If it is a wrapped executable running on windows, the openssl
	# dlls must be copied out of the virtual filesystem to the disk
	# where Windows will find them when resolving the dependency in
	# the tls dll. We choose to make them siblings of the executable.
	package require starkit
	set dst [file nativename [file dirname $starkit::topdir]]
	foreach sdll [glob -nocomplain -directory $dir -tails *eay32.dll] {
	    catch {file delete -force            $dst/$sdll}
	    catch {file copy   -force $dir/$sdll $dst/$sdll}
	}
    }
    set res [catch {uplevel #0 [list load [file join [pwd] $dll]]} err]
    catch {cd $cwd}
    if {$res} {
	namespace eval [namespace parent] {namespace delete tls}
	return -code $res $err
    }
    rename tls::initlib {}
}

#
# Backwards compatibility, also used to set the default
# context options
#
proc tls::init {args} {
    variable defaults

    set defaults $args
}
#
# Helper function - behaves exactly as the native socket command.
#
proc tls::socket {args} {
    variable socketCmd
    variable defaults
    set idx [lsearch $args -server]
    if {$idx != -1} {
	set server 1
	set callback [lindex $args [expr {$idx+1}]]
	set args [lreplace $args $idx [expr {$idx+1}]]

	set usage "wrong # args: should be \"tls::socket -server command ?options? port\""
	set options "-cadir, -cafile, -certfile, -cipher, -command, -keyfile, -myaddr, -password, -request, -require, -ssl2, -ssl3, or -tls1"
    } else {
	set server 0

	set usage "wrong # args: should be \"tls::socket ?options? host port\""
	set options "-async, -cadir, -cafile, -certfile, -cipher, -command, -keyfile, -myaddr, -myport, -password, -request, -require, -ssl2, -ssl3, or -tls1"
    }
    set argc [llength $args]
    set sopts {}
    set iopts [concat [list -server $server] $defaults]	;# Import options

    for {set idx 0} {$idx < $argc} {incr idx} {
	set arg [lindex $args $idx]
	switch -glob -- $server,$arg {
	    0,-async	{lappend sopts $arg}
	    0,-myport	-
	    *,-type	-
	    *,-myaddr	{lappend sopts $arg [lindex $args [incr idx]]}
	    *,-cadir	-
	    *,-cafile	-
	    *,-certfile	-
	    *,-cipher	-
	    *,-command	-
	    *,-keyfile	-
	    *,-password	-
	    *,-request	-
	    *,-require	-
	    *,-ssl2	-
	    *,-ssl3	-
	    *,-tls1	{lappend iopts $arg [lindex $args [incr idx]]}
	    -*		{return -code error "bad option \"$arg\": must be one of $options"}
	    default	{break}
	}
    }
    if {$server} {
	if {($idx + 1) != $argc} {
	    return -code error $usage
	}
	set uid [incr ::tls::srvuid]

	set port [lindex $args [expr {$argc-1}]]
	lappend sopts $port
	#set sopts [linsert $sopts 0 -server $callback]
	set sopts [linsert $sopts 0 -server [list tls::_accept $iopts $callback]]
	#set sopts [linsert $sopts 0 -server [list tls::_accept $uid $callback]]
    } else {
	if {($idx + 2) != $argc} {
	    return -code error $usage
	}
	set host [lindex $args [expr {$argc-2}]]
	set port [lindex $args [expr {$argc-1}]]
	lappend sopts $host $port
    }
    #
    # Create TCP/IP socket
    #
    set chan [eval $socketCmd $sopts]
    if {!$server && [catch {
	#
	# Push SSL layer onto socket
	#
	eval [list tls::import] $chan $iopts
    } err]} {
	set info ${::errorInfo}
	catch {close $chan}
	return -code error -errorinfo $info $err
    }
    return $chan
}

# tls::_accept --
#
#   This is the actual accept that TLS sockets use, which then calls
#   the callback registered by tls::socket.
#
# Arguments:
#   iopts	tls::import opts
#   callback	server callback to invoke
#   chan	socket channel to accept/deny
#   ipaddr	calling IP address
#   port	calling port
#
# Results:
#   Returns an error if the callback throws one.
#
proc tls::_accept { iopts callback chan ipaddr port } {
    log 2 [list tls::_accept $iopts $callback $chan $ipaddr $port]

    set chan [eval [list tls::import $chan] $iopts]

    lappend callback $chan $ipaddr $port
    if {[catch {
	uplevel #0 $callback
    } err]} {
	log 1 "tls::_accept error: ${::errorInfo}"
	close $chan
	error $err $::errorInfo $::errorCode
    } else {
	log 2 "tls::_accept - called \"$callback\" succeeded"
    }
}
#
# Sample callback for hooking: -
#
# error
# verify
# info
#
proc tls::callback {option args} {
    variable debug

    #log 2 [concat $option $args]

    switch -- $option {
	"error"	{
	    foreach {chan msg} $args break

	    log 0 "TLS/$chan: error: $msg"
	}
	"verify"	{
	    # poor man's lassign
	    foreach {chan depth cert rc err} $args break

	    array set c $cert

	    if {$rc != "1"} {
		log 1 "TLS/$chan: verify/$depth: Bad Cert: $err (rc = $rc)"
	    } else {
		log 2 "TLS/$chan: verify/$depth: $c(subject)"
	    }
	    if {$debug > 0} {
		return 1;	# FORCE OK
	    } else {
		return $rc
	    }
	}
	"info"	{
	    # poor man's lassign
	    foreach {chan major minor state msg} $args break

	    if {$msg != ""} {
		append state ": $msg"
	    }
	    # For tracing
	    upvar #0 tls::$chan cb
	    set cb($major) $minor

	    log 2 "TLS/$chan: $major/$minor: $state"
	}
	default	{
	    return -code error "bad option \"$option\":\
		    must be one of error, info, or verify"
	}
    }
}

proc tls::xhandshake {chan} {
    upvar #0 tls::$chan cb

    if {[info exists cb(handshake)] && \
	$cb(handshake) == "done"} {
	return 1
    }
    while {1} {
	vwait tls::${chan}(handshake)
	if {![info exists cb(handshake)]} {
	    return 0
	}
	if {$cb(handshake) == "done"} {
	    return 1
	}
    }
}

proc tls::password {} {
    log 0 "TLS/Password: did you forget to set your passwd!"
    # Return the worlds best kept secret password.
    return "secret"
}

proc tls::log {level msg} {
    variable debug
    variable logcmd

    if {$level > $debug || $logcmd == ""} {
	return
    }
    set cmd $logcmd
    lappend cmd $msg
    uplevel #0 $cmd
}

 * TkImg for image formats. Website and license: [http://sourceforge.net/projects/tkimg/].
 * Help viewer by Keith Vetter: [http://wiki.tcl.tk/19649].
 * TkDND for drag and drop. Website and license: [http://sourceforge.net/projects/tkdnd/].

-------------------
title: TextSweep Version History
alias: History





'''3.0 (September 1, 2016):'''
 * Initial Windows release.
 * UI refinements.

'''2.1 (June 15, 2014):'''
 * Fix major bug that caused app to hang when selecting file.
................................................................................
title: License
alias: License
 
'''The MIT License (MIT)'''

TextSweep source code: [http://fossil.codebykevin.com/fossil.cgi/textsweep/]

Copyright (c) 2016 WordTech Communications LLC

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

 * TkImg for image formats. Website and license: [http://sourceforge.net/projects/tkimg/].
 * Help viewer by Keith Vetter: [http://wiki.tcl.tk/19649].
 * TkDND for drag and drop. Website and license: [http://sourceforge.net/projects/tkdnd/].

-------------------
title: TextSweep Version History
alias: History

'''3.1 (Arpil 1, 2017):'''
 * Improved security on software updates.
 * Minor UI enhancements.

'''3.0 (September 1, 2016):'''
 * Initial Windows release.
 * UI refinements.

'''2.1 (June 15, 2014):'''
 * Fix major bug that caused app to hang when selecting file.
................................................................................
title: License
alias: License
 
'''The MIT License (MIT)'''

TextSweep source code: [http://fossil.codebykevin.com/fossil.cgi/textsweep/]

Copyright (c) 2017 WordTech Communications LLC

Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded softwareupdate 1.4 [list source [file join $dir softwareupdate.tcl]]

# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded softwareupdate 1.5 [list source [file join $dir softwareupdate.tcl]]

#softwareupdate.tcl  routines to manage spoftware updates

#  Copyright (C) 2014  WordTech Communications LLC

#MIT license

package provide softwareupdate 1.4
package require http
package require tdom



namespace eval softwareupdate {

    if {![info exists library]} {
	variable library [file dirname [info script]]
    }

................................................................................
    variable tmpdir
    variable currentinstall
    variable versionnumber
    
    switch [tk windowingsystem] {
	"aqua" {
	    set tmpdir $::env(TMPDIR)

	}
	
	"win32" {
	    set tmpdir $::env(TMP)
	}
	
	"x11" {
................................................................................

    #check version of installed software
    proc checkVersion {app version} {
	variable appversion
	variable appname
	variable currentversion
	variable versionnumber
	variable appcast
	variable sparkledata
	variable changedata


	set appname $app


	softwareupdate::checkingForUpdates

	set appcast http://www.codebykevin.com/[string tolower $appname].xml
	http::config -useragent "$appname Update Check"

	set xml [http::data [http::geturl $appcast]]

	if [catch {http::geturl $appcast} msg] {
	    puts "error: $msg"
	    tk_messageBox -icon info -title "" -message "Update Error!" -detail "An error occurred in retrieving update information.\nPlease try again later."


	    return
	} 

	dom parse $xml sparkledata
	set versionnumber [string trim [$sparkledata selectNodes -namespaces [list x "http://www.andymatuschak.org/xml-namespaces/sparkle"] {string(//enclosure/@x:version)}] .0]

	set changedata [$sparkledata selectNodes {string(//description/text())}]

	set minOS [$sparkledata selectNodes -namespaces [list x "http://www.andymatuschak.org/xml-namespaces/sparkle"] {string(//x:minimumSystemVersion)}]


	if {[tk windowingsystem] eq "aqua"} {
	    set hostOS [exec sw_vers -productVersion]

	    if {![package vsatisfies $hostOS $minOS]} {
		tk_messageBox -icon warning -message "Error!" -detail "$appname is not supported on Mac OS X $hostOS. The minimum supported OS version is $minOS." 
		return
	    }
	}
	

	if {[expr $currentversion < $versionnumber]} {
	    switch [tk windowingsystem] {
		"aqua" {
		    softwareupdate::updatePitch

		}
		
		"win32" {
		    softwareupdate::winPitch $appname $currentversion $versionnumber
		}
		
		"x11" {
		    
		}
	    }
	    
	} else {
	    softwareupdate::upToDate
	}
    }

    #define the current version of the software
    proc setVersion {app number} {
................................................................................
	    }
	}
	
	return $currentinstall

    }

    #prompt user to update: for Perl, which chokes on XML parsing from Tcl
    proc updatePitchPerl {apptitle appnumber currentapp changelog} {
	variable appname
	variable icon
	variable changedata
	variable currentversion
	variable versionnumber
	variable changelist

	catch {destroy .updateprogress}

	catch {destroy .update}


	toplevel .update
	wm title .update "Software Update"

	wm withdraw .update

	frame .update.f -bg gray95
	pack .update.f -fill both -expand yes

	frame .update.f.top -bg gray95
	pack .update.f.top -fill both -expand yes

	label .update.f.top.i -image $icon -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.i -side left -fill both -expand yes

	frame .update.f.top.r -bg gray95
	pack .update.f.top.r -side right -fill both -expand yes

	label .update.f.top.r.title -text "A new version of $apptitle is available!" -font {-weight bold} -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.r.title -fill both -expand yes -side top

	label .update.f.top.r.msg -text "$apptitle $appnumber is available--you have $currentapp. Would you like to download it now?" -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.r.msg -fill both -expand yes -side top

	label .update.f.top.r.release -text "Release Notes:" -font {-weight bold} -relief flat -highlightthickness 0 -bg gray95 
	pack .update.f.top.r.release -side top -fill both -expand yes

	text .update.f.top.r.text -font TkDefaultFont
	pack .update.f.top.r.text -side top -fill both -expand yes

	ttk::frame .update.f.top.r.bottom -padding 5
	pack .update.f.top.r.bottom -side bottom -fill both -expand yes

	ttk::button .update.f.top.r.bottom.skip -text "Skip This Version" -command {destroy .update}

	ttk::button .update.f.top.r.bottom.install -text "Install Update" -default active -command softwareupdate::installUpdate
	
	pack .update.f.top.r.bottom.install .update.f.top.r.bottom.skip  -side right  -fill both -expand yes

	set changetext [split $changelog *]

	set changetext [lrange $changetext 1 end]

	foreach item $changetext {
	    
	    .update.f.top.r.text insert end "* $item\n"

	}

	.update.f.top.r.text configure -state disabled

	wm resizable .update 0 0
	wm deiconify .update
	raise .update
	wm transient .update .

    }


    #prompt user to update
    proc updatePitch {} {
	variable appname
	variable icon
	variable changedata
................................................................................
	variable currentversion
	variable versionnumber

	catch {destroy .updateprogress}

	catch {destroy .update}
	


	toplevel .update
	wm title .update "Software Update"

	wm withdraw .update


	frame .update.f -bg gray95
	pack .update.f -fill both -expand yes

	frame .update.f.top -bg gray95
	pack .update.f.top -fill both -expand yes

	label .update.f.top.i -image $icon -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.i -side left -fill both -expand yes

	frame .update.f.top.r -bg gray95
	pack .update.f.top.r -side right -fill both -expand yes

	label .update.f.top.r.title -text "A new version of $appname is available!" -font {-weight bold} -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.r.title -fill both -expand yes -side top

	label .update.f.top.r.msg -text "$appname $versionnumber is available--you have $currentversion. Would you like to download it now?" -font {-size 10} -bg gray95 -relief flat -highlightthickness 0
	pack .update.f.top.r.msg -fill both -expand yes -side top

	label .update.f.top.r.release -text "Release Notes:" -font {-size 10 -weight bold} -relief flat -highlightthickness 0 -bg gray95 
	pack .update.f.top.r.release -side top -fill both -expand yes

	text .update.f.top.r.text -font TkDefaultFont
	pack .update.f.top.r.text -side top -fill both -expand yes

	ttk::frame .update.f.top.r.bottom -padding 5
	pack .update.f.top.r.bottom -side bottom -fill both -expand yes

	ttk::button .update.f.top.r.bottom.skip -text "Skip This Version" -command {destroy .update}

	ttk::button .update.f.top.r.bottom.install -text "Install Update" -default active -command softwareupdate::installUpdate
	
	pack .update.f.top.r.bottom.install .update.f.top.r.bottom.skip  -side right  -fill both -expand yes

	.update.f.top.r.text insert end $changedata

	.update.f.top.r.text configure -state disabled

	wm resizable .update 0 0
	wm deiconify .update
	raise .update
	wm transient .update .


    }

    proc winPitch {name newversion oldversion} {
	set answer [tk_messageBox  -icon info -title "New Version Available" -message "New Version Available" -detail "$name $newversion is available--you have $oldversion. Would you like to download it now?" -type yesno

		   ]


	switch -- $answer {
	    yes {


		xplat::launch http://www.codebykevin.com/$name.html
		destroy .updateprogress
	    }
	    no {
		destroy .updateprogress
		return
	    }
	}
    }



    #"busy" dialog
    proc checkingForUpdates {} {

	variable appname
	variable icon

	catch {destroy .updateprogress}
................................................................................

	softwareupdate::progressDialog
	set status "Downloading update for $appname"
	
	switch [tk windowingsystem] {

	    "aqua" {
		http::geturl http://www.codebykevin.com/updates/[list $appname].tgz -channel [open $tmpdir/[list $appname].tgz w] 
		update
		after 1000
		cd $tmpdir
		set status "Unpacking update for $appname"
		update
		after 1000
		catch {exec tar xvfz [list $appname].tgz}
	    }
	    
	    "win32" {
	


	    }
	    
	    "x11" {
		

	    }
	}
	
	
	set status "Ready to install"
	.downloadprogress.frame.bar configure -mode determinate
	.downloadprogress.frame.bar configure -value 100
................................................................................
	variable currentinstall
	variable appname
	variable tmpdir
	
	switch [tk windowingsystem] {

	    "aqua" {
		if {[catch {exec codesign -v $tmpdir/$appname.app} msg]} {
		    bgerror $msg
		    tk_messageBox -icon warning -message "Error!" -detail "An error occurred in the installation of $appname. Please try again later."
		    return
		} else {

		    file rename -force $currentinstall [file join /Users [exec whoami] .Trash [file tail $currentinstall]]

		    file rename -force $tmpdir/$appname.app $currentinstall


		    exec $currentinstall/Contents/MacOS/$appname &

		    exit

		}

	    }
	    
	    "win32" {
		


	    }
	    




	}

	catch {destroy .downloadprogress}

	

    }


    namespace export *

}

#softwareupdate.tcl  routines to manage spoftware updates

#  Copyright (C) 2014  WordTech Communications LLC

#MIT license

package provide softwareupdate 1.5
package require http
package require tls

http::register https 443 [list ::tls::socket -tls1 1]   ;# "-tls1 1" is required since [POODLE]

namespace eval softwareupdate {

    if {![info exists library]} {
	variable library [file dirname [info script]]
    }

................................................................................
    variable tmpdir
    variable currentinstall
    variable versionnumber
    
    switch [tk windowingsystem] {
	"aqua" {
	    set tmpdir $::env(TMPDIR)

	}
	
	"win32" {
	    set tmpdir $::env(TMP)
	}
	
	"x11" {
................................................................................

    #check version of installed software
    proc checkVersion {app version} {
	variable appversion
	variable appname
	variable currentversion
	variable versionnumber





	set appname $app


	softwareupdate::checkingForUpdates

	set versionurl https://www.codebykevin.com/$appname-version.tcl
	http::config -useragent "$appname Update Check"



	if [catch {http::geturl $versionurl} msg] {
	    puts "error: $msg"

	    tk_messageBox -icon warning -title "Unable to Connect to Server" -message "Unable to Connect to Server" -detail "Unable to connect to www.codebykevin.com to check for updates. Please make sure you are connected to the Internet." -parent .
	catch {destroy .updateprogress}
	    return
	} 


















	set versionnumber [string trim [http::data [http::geturl $versionurl]]]
	if [expr $currentversion < $versionnumber] {


	    softwareupdate::updatePitch












	} else {
	    softwareupdate::upToDate
	}
    }

    #define the current version of the software
    proc setVersion {app number} {
................................................................................
	    }
	}
	
	return $currentinstall

    }









































































    #prompt user to update
    proc updatePitch {} {
	variable appname
	variable icon
	variable changedata
................................................................................
	variable currentversion
	variable versionnumber

	catch {destroy .updateprogress}

	catch {destroy .update}
	
	variable appname


	set changeurl https://www.codebykevin.com/$appname-changes.tcl

        if [catch {http::geturl $changeurl} msg] {

	    puts "error: $msg"
	    tk_messageBox -icon warning -title "Unable to Connect to Server" -message "Unable to Connect to Server" -detail "Unable to connect to www.codebykevin.com to check for updates. Please make sure you are connected to the Internet." -parent .






































	    catch {destroy .updateprogress}

	    return
	} 




	set changelist [http::data [http::geturl $changeurl]]


	set updateanswer [tk_messageBox -title "Update" -icon info -message "Update Available" -detail "A new version ($softwareupdate::versionnumber) of $appname is available.\n\nThis new version features the following updates and changes:\n\n$changelist\n\nWould you like to install it? " -type yesno -parent .]
	switch -- $updateanswer {
	    yes {
		softwareupdate::installUpdate
	    }



	    no {
		destroy $updateanswer
		return
	    }
	    
	}

    }

    #"busy" dialog
    proc checkingForUpdates {} {

	variable appname
	variable icon

	catch {destroy .updateprogress}
................................................................................

	softwareupdate::progressDialog
	set status "Downloading update for $appname"
	
	switch [tk windowingsystem] {

	    "aqua" {
		http::geturl https://www.codebykevin.com/updates/[list $appname].dmg -channel [open $tmpdir/[list $appname].dmg w] 
		update
		after 1000
		cd $tmpdir
		set status "Attaching [list $appname].dmg"
		update

		exec hdiutil attach [list $appname].dmg
	    }
	    
	    "win32" {
		
		http::geturl https://www.codebykevin.com/updates/[list $appname]_Setup.exe -channel [open $tmpdir/[list $appname]_Setup.exe w]

	    }
	    
	    "x11" {
		tk_messageBox -icon info -parent . -message "Please ask the maintainer of $appname on your platform to prepare a release of the latest version."
		return
	    }
	}
	
	
	set status "Ready to install"
	.downloadprogress.frame.bar configure -mode determinate
	.downloadprogress.frame.bar configure -value 100
................................................................................
	variable currentinstall
	variable appname
	variable tmpdir
	
	switch [tk windowingsystem] {

	    "aqua" {






		file rename -force $currentinstall [file join /Users [exec whoami] .Trash [file tail $currentinstall]]


		file copy -force /Volumes/[list $appname]/[list $appname].app $currentinstall

		exec $currentinstall/Contents/MacOS/$appname &


		exec hdiutil detach /Volumes/[list $appname]

		exit
	    }
	    
	    "win32" {
		
		eval exec [auto_execok start] [file normalize $tmpdir/[list $appname]_Setup.exe] &
		exit
	    }
	    
	    "x11" {
		tk_messageBox -icon info -parent . -message "Please ask the maintainer of $appname on your platform to prepare a release of the latest version."
		return
	    }
	}

	catch {destroy .downloadprogress}

    }




    namespace export *

}

  package ifneeded textsweep 3.0 [list source [file join $dir textsweep.tcl]]

  package ifneeded textsweep 3.1 [list source [file join $dir textsweep.tcl]]

package provide textsweep 3.0

source [file join [file dirname [info script]] textsweep-main.tcl]

package provide textsweep 3.1

source [file join [file dirname [info script]] textsweep-main.tcl]

* Improved security on software updates.
* Minor UI enhancements.

3.1