URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [fs.tcl] - Blame information for rev 1774

Go to most recent revision | Details | Compare with Previous | View Log


# tixAssert --
#
#       Debugging routine. Evaluates the test script in the context of the
#       caller. The test script is responsible for generating the error.
#       
proc tixAssert {script} {
    uplevel $script
}
 
proc tixAssertNorm {path} {
    if ![tixFSIsNorm $path] {
        error "\"$path\" is not a normalized path"
    }
}
 
proc tixAssertVPath {vpath} {
    if ![tixFSIsVPath $vpath] {
        error "\"$vpath\" is not a VPATH"
    }
}
 
# tixFSAbsPath --
#
#       Converts $path into an normalized absolute path
#
proc tixFSAbsPath {path} {
    return [lindex [tixFSNorm [tixFSVPWD] $path] 0]
}
 
# tixFSVPWD --
#
#       Returns the VPATH of the current directory.
#
proc tixFSVPWD {} {
    return [tixFSVPath [tixFSPWD]]
}
 
if {![info exists tcl_platform] || $tcl_platform(platform) == "unix"} {
 
# tixFSPWD --
#
#       Return the current directory
#
proc tixFSPWD {} {
    return [pwd]
}
 
# tixFSDisplayName --
#
#       Returns the name of a normalized path which is usually displayed by
#       the OS
#
proc tixFSDisplayName {normpath} {
    tixAssert {
        tixAssertNorm $normpath
    }
    return $normpath
}
 
proc tixFSIsAbsPath {path} {
    return [tixStrEq [string index $path 0] /]
}
 
# tixFSIsNorm_os --
#
#       Returns true iff this pathname is normalized, in the OS native name
#       format
#
proc tixFSIsNorm_os {path} {
    return [tixFSIsNorm $path]
}
 
proc tixFSIsNorm {path} {
    if [tixStrEq $path /] {
        return 1
    }
 
    # relative path
    #
    if ![regexp {^/} $path] {
        return 0
    }
 
    if [regexp {/[.]$} $path] {
        return 0
    }
    if [regexp {/[.][.]$} $path] {
        return 0
    }
    if [regexp {/[.]/} $path] {
        return 0
    }
    if [regexp {/[.][.]/} $path] {
        return 0
    }
    if [tixStrEq $path .] {
        return 0
    }
    if [tixStrEq $path ..] {
        return 0
    }
 
    # Tilde
    #
    if [regexp {^~} $path] {
        return 0
    }
 
    # Double slashes
    #
    if [regexp {//} $path] {
        return 0
    }
 
    # Trailing slashes
    #
    if [regexp {/$} $path] {
        return 0
    }
 
    return 1
}
 
# tixFSIsValid --
#
#       Checks whether a native pathname contains invalid characters.
#
proc tixFSIsValid {path} {
    return 1
}
 
proc tixFSIsVPath {vpath} {
    return [tixFSIsNorm $vpath]
}
 
# tixFSVPath --
#
#       Converts a native pathname to its VPATH
#
proc tixFSVPath {path} {
    tixAssert {
        tixAssertNorm $path
    }
    return $path
}
 
# tixFSPath --
#
#       Converts a vpath to a native pathname
proc tixFSPath {vpath} {
    tixAssert {
        tixAssertVPath $vpath
    }
    return $vpath
}
 
# tixFSTildeSubst -- [Unix only]
#
#       Substitutes any leading tilde characters if possible. No error is
#       generated if the user doesn't exist.
#
proc tixFSTildeSubst {text} {
    if [tixStrEq [string index $text 0] ~] {
        # The following will report if the user doesn't exist
        if [catch {
            file isdir $text
        }] {
            return ./$text
        }
        return [tixFile tilde $text]
    } else {
        return $text
    }
}
 
# tixFSNorm --
#
#       Interprets the user's input and return file information about this
#       input.
#
# Arguments:
#       See documentation (docs/Files.txt)
#
proc tixFSNorm {context text {defFile ""} {flagsVar ""} {errorMsgVar ""}} {
    tixAssert {
        tixAssertVPath $context
    }
 
    if ![tixStrEq $errorMsgVar ""] {
        upvar $errorMsgVar errorMsg
    }
    if ![tixStrEq $flagsVar ""] {
        upvar $flagsVar flags
    }
 
    set hasDirSuffix [regexp {/$} $text]
    set text [tixFSTildeSubst $text]
    set text [_tixJoin $context $text]
 
    if {$hasDirSuffix || [file isdir $text]} {
        set dir $text
        set tail $defFile
    } else {
        set dir [file dirname $text]
        set tail [file tail $text]
    }
 
    set norm $dir/$tail
    regsub -all /+ $norm / norm
    if ![tixStrEq $norm /] {
        regsub {/$} $norm "" norm
    }
 
    if ![info exists flag(noPattern)] {
        set isPat 0
        foreach char [split $tail ""] {
            if {$char == "*" || $char == "?"} {
                set isPat 1
                break
            }
        }
        if {$isPat} {
            return [list $norm $dir "" $tail]
        }
    }
 
    return [list $norm $dir $tail ""]
}
 
# _tixJoin -- [Internal]
# 
#       Joins two native pathnames.
#
proc _tixJoin {p1 p2} {
    if [tixStrEq [string index $p2 0] /] {
        return [_tixNormalize $p2]
    } else {
        return [_tixNormalize $p1/$p2]
    }
}
 
# tixFSNormDir --
#
#       Normalizes an absolute path.
#
proc tixFSNormDir {dir} {
    set dir [tixFile tilde $dir]
    if ![tixStrEq [string index $dir 0] /] {
        error "\"$dir\" must be an absolute pathname"
    }
    if ![file isdir $dir] {
        error "\"$dir\" is not a directory"
    }
    return [_tixNormalize $dir]
}
 
# _tixNormalize --
#
#       Normalizes an absolute pathname.
#
#       $dir must be an absolute pathname
#
proc _tixNormalize {path} {
    tixAssert {
        if ![tixStrEq [string index $path 0] /] {
            error "\"$path\" must be an absolute pathname"
        }
    }
 
    # Don't be fooled: $path doesn't need to be a directory. The following
    # code just makes it easy to get rid of trailing . and ..
    #
    set path $path/
    regsub -all /+ $path / path
    while 1 {
        if ![regsub {/\./} $path "/" path] break
    }
    while 1 {
        if ![regsub {/\.$} $path "" path] break
    }
 
    while 1 {
        if ![regsub {/[^/]+/\.\./} $path "/" path] break
        while 1 {
            if ![regsub {^/\.\./} $path "/" path] break
        }
    }
    while 1 {
        if ![regsub {^/\.\./} $path "/" path] break
    }
 
    regsub {/$} $path "" path
    if [tixStrEq $path ""] {
        return /
    } else {
        return $path
    }
}
 
# tixFSCreateDirs
#
#
# 
proc tixFSCreateDirs {path} {
    tixAssert {
        error "Procedure tixFSCreateDirs not implemented on all platforms"
    }
    if [tixStrEq $path /] {
        return 1
    }
    if [file exists $path] {
        return 1
    }
    if ![tixFSCreateDirs [file dirname $path]] {
        return 0
    }
    if [catch {exec mkdir $path}] {
        return 0
    }
    return 1
}
 
} else {
 
#-Win--------------------------------------------------------------------
 
# (Win) tixFSPWD --
#
#       Return the current directory
#
proc tixFSPWD {} {
    set p [pwd]
    regsub -all / $p \\ p
    return $p
}
# Win
#
proc tixFSIsNorm {path} {
 
    # Drive root directory
    # CYGNUS LOCAL: drive can be immediately followed by directory separator.
    #
    if [regexp {^[A-z]:\\?$} $path] {
        return 1
    }
 
    # If it is not a drive root directory, it must
    # have a leading [drive letter:]\\[non empty string]
    # CYGNUS LOCAL: A UNC path (\\host\dir) is also OK.
    if ![regexp {^[A-z]:\\.} $path] {
        if ![regexp {^\\\\.*\\.} $path] {
            return 0
        }
    }
 
    # relative path
    #
    if [regexp {\\[.]$} $path] {
        return 0
    }
    if [regexp {\\[.][.]$} $path] {
        return 0
    }
    if [regexp {\\[.]\\} $path] {
        return 0
    }
    if [regexp {\\[.][.]\\} $path] {
        return 0
    }
    if [tixStrEq $path .] {
        return 0
    }
    if [tixStrEq $path ..] {
        return 0
    }
 
    # Double slashes
    # CYGNUS LOCAL: Double slashes at the front are OK.
    #
    if [regexp {.\\\\} $path] {
        return 0
    }
 
    # Trailing slashes
    #
    if [regexp {[\\]$} $path] {
        return 0
    }
 
    return 1
}
 
# (Win) tixFSNorm --
#
#       Interprets the user's input and return file information about this
#       input.
#
# Arguments:
#       See documentation (docs/Files.txt)
#
proc tixFSNorm {context text {defFile ""} {flagsVar ""} {errorMsgVar ""}} {
    tixAssert {
        tixAssertVPath $context
    }
 
    if ![tixStrEq $errorMsgVar ""] {
        upvar $errorMsgVar errorMsg
    }
    if ![tixStrEq $flagsVar ""] {
        upvar $flagsVar flags
    }
 
    set isDir [regexp {[\\]$} $text]
    set text [_tixJoin $context $text]
    set path [tixFSPath $text]
 
    if {$isDir || [file isdir $path]} {
        set vpath $text
        set tail $defFile
    } else {
        set list [split $text \\]
        set tail [lindex $list end]
        set len [string length $tail]
        set vpath [string range $text 0 [expr [string len $text]-$len-1]]
        regsub {[\\]$} $vpath "" vpath
    }
 
    set path [tixFSPath $vpath]
 
    if ![info exists flag(noPattern)] {
        set isPat 0
        foreach char [split $tail ""] {
            if {$char == "*" || $char == "?"} {
                set isPat 1
                break
            }
        }
        if {$isPat} {
            return [list $path $vpath "" $tail]
        }
    }
 
    return [list $path $vpath $tail ""]
}
 
# Win
#
# _tixJoin -- [internal]
#
#       Joins a pathname to a VPATH
#
proc _tixJoin {vp1 p2} {
    if [tixFSIsAbsPath $p2] {
        return [tixFSVPath [_tixNormalize $p2]]
    } else {
        return [tixFSVPath [_tixNormalize [tixFSPath $vp1]\\$p2]]
    }
}
 
# (Win) tixFSIsAbsPath
#
#       The Tcl "file pathtype" is buggy. E.g. C:\.\..\. is absolute, but
#       "file pathtype" thinks that it isn't
#
 
proc tixFSIsAbsPath {path} {
    # CYGNUS LOCAL: Handle a UNC path (\\host\dir)
    if [regexp {^\\\\.*\\.} $path] {
        return 1
    }
    return [regexp {^[A-z]:\\} $path]
}
 
# (Win) tixFSIsNorm_os
#
#       Returns true iff this pathname is normalized, in the OS native name
#       format
#
proc tixFSIsNorm_os {path} {
    if [regexp {^[A-z]:[\\]$} $path] {
        return 1
    }
    if [regexp {^[A-z]:$} $path] {
        return 0
    }
 
    return [tixFSIsNorm $path]
 
}
 
# Win
#
# _tixNormalize --
#
#       Normalizes an absolute pathname.
#
#       $dir must be an absolute native pathname
#
proc _tixNormalize {abpath} {
    tixAssert {
        if ![tixFSIsAbsPath $abpath] {
            error "\"$abpath\" must be an absolute pathname"
        }
    }
 
    # CYGNUS LOCAL: Handle UNC paths (\\host\dir)
    if [regexp {^\\\\.*\\.} $abpath] {
        set drive "\\"
        regsub {^\\} $abpath "" path
    } else {
        if ![regexp {^[A-z]:} $abpath drive] {
            tixPanic "\"$abpath\" does not contain a drive letter"
        }
        set drive [string toupper $drive]
 
        regsub {^[A-z]:} $abpath "" path
    }
 
    # Don't be fooled: $path doesn't need to be a directory. The following
    # code "set path $path\\" just makes it easy to get rid of trailing
    # . and ..
    #
    set path $path\\
    regsub -all {[\\]+} $path \\ path
    while 1 {
        if ![regsub {\\[.]\\} $path "\\" path] break
    }
    while 1 {
        if ![regsub {\\[.]$} $path "" path] break
    }
 
    while 1 {
        if ![regsub {\\[^\\]+\\[.][.]\\} $path "\\" path] break
        while 1 {
            if ![regsub {^\\[.][.]\\} $path "\\" path] break
        }
    }
    while 1 {
        if ![regsub {^\\[.][.]\\} $path "\\" path] break
    }
 
    regsub {[\\]+$} $path "" path
    return $drive$path
}
 
# Win
#
# tixFSNormDir --
#
#       Normalizes a directory
#
proc tixFSNormDir {dir} {
    if ![tixFSIsAbsPath $dir] {
        error "\"$dir\" must be an absolute pathname"
    }
    if ![file isdir $dir] {
        error "\"$dir\" is not a directory"
    }
    return [_tixNormalize $dir]
}
 
 
proc tixPanic {message} {
    error $message
}
 
# tixFSIsValid --
#
#       Checks whether a native pathname contains invalid characters.
#
proc tixFSIsValid {path} {
    return 1
}
 
# Win
#
#
proc tixFSIsVPath {vpath} {
    global tixPriv
    if $tixPriv(isWin95) {
        # CYGNUS LOCAL: Accept UNC path (\\host\dir)
        if [string match {xx\\xx\\\\\\*\\*} $vpath] {
            return 1
        }
        return [string match {xx\\xx\\[A-z]:*} $vpath]
    } else {
        return [string match {xx\\[A-z]:*} $vpath]
    }
}
 
# Win
#
# tixFSVPath --
#
#       Converts a normalized native pathname to its VPATH
#
proc tixFSVPath {path} {
    global tixPriv
 
    tixAssert {
        tixAssertNorm $path
    }
    return $tixPriv(WinPrefix)\\$path
}
 
# tixFSPath --
#
#       Converts a vpath to a native pathname
proc tixFSPath {vpath} {
    global tixPriv
    tixAssert {
        tixAssertVPath $vpath
    }
    if $tixPriv(isWin95) {
        set path [string range $vpath 6 end]
    } else {
        set path [string range $vpath 3 end]
    }
    regsub {:$} $path :\\ path
 
    return $path
}
 
# tixFSDisplayName --
#
#       Returns the name of a normalized path which is usually displayed by
#       the OS
#
proc tixFSDisplayName {normpath} {
    tixAssert {
        tixAssertNorm $normpath
    }
 
    if [regexp {^[A-z]:$} $normpath] {
        return $normpath\\
    } else {
        return $normpath
    }
}
 
 
tixInitFileCmpt:Win
 
}

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [fs.tcl] - Blame information for rev 1774

Line No.	Rev	Author	Line
1	578	markom	`# tixAssert --`
2			`#`
3			`# Debugging routine. Evaluates the test script in the context of the`
4			`# caller. The test script is responsible for generating the error.`
5			`#`
6			`proc tixAssert {script} {`
7			`uplevel $script`
8			`}`
9
10			`proc tixAssertNorm {path} {`
11			`if ![tixFSIsNorm $path] {`
12			`error "\"$path\" is not a normalized path"`
13			`}`
14			`}`
15
16			`proc tixAssertVPath {vpath} {`
17			`if ![tixFSIsVPath $vpath] {`
18			`error "\"$vpath\" is not a VPATH"`
19			`}`
20			`}`
21
22			`# tixFSAbsPath --`
23			`#`
24			`# Converts $path into an normalized absolute path`
25			`#`
26			`proc tixFSAbsPath {path} {`
27			`return [lindex [tixFSNorm [tixFSVPWD] $path] 0]`
28			`}`
29
30			`# tixFSVPWD --`
31			`#`
32			`# Returns the VPATH of the current directory.`
33			`#`
34			`proc tixFSVPWD {} {`
35			`return [tixFSVPath [tixFSPWD]]`
36			`}`
37
38			`if {![info exists tcl_platform] \|\| $tcl_platform(platform) == "unix"} {`
39
40			`# tixFSPWD --`
41			`#`
42			`# Return the current directory`
43			`#`
44			`proc tixFSPWD {} {`
45			`return [pwd]`
46			`}`
47
48			`# tixFSDisplayName --`
49			`#`
50			`# Returns the name of a normalized path which is usually displayed by`
51			`# the OS`
52			`#`
53			`proc tixFSDisplayName {normpath} {`
54			`tixAssert {`
55			`tixAssertNorm $normpath`
56			`}`
57			`return $normpath`
58			`}`
59
60			`proc tixFSIsAbsPath {path} {`
61			`return [tixStrEq [string index $path 0] /]`
62			`}`
63
64			`# tixFSIsNorm_os --`
65			`#`
66			`# Returns true iff this pathname is normalized, in the OS native name`
67			`# format`
68			`#`
69			`proc tixFSIsNorm_os {path} {`
70			`return [tixFSIsNorm $path]`
71			`}`
72
73			`proc tixFSIsNorm {path} {`
74			`if [tixStrEq $path /] {`
75			`return 1`
76			`}`
77
78			`# relative path`
79			`#`
80			`if ![regexp {^/} $path] {`
81			`return 0`
82			`}`
83
84			`if [regexp {/[.]$} $path] {`
85			`return 0`
86			`}`
87			`if [regexp {/[.][.]$} $path] {`
88			`return 0`
89			`}`
90			`if [regexp {/[.]/} $path] {`
91			`return 0`
92			`}`
93			`if [regexp {/[.][.]/} $path] {`
94			`return 0`
95			`}`
96			`if [tixStrEq $path .] {`
97			`return 0`
98			`}`
99			`if [tixStrEq $path ..] {`
100			`return 0`
101			`}`
102
103			`# Tilde`
104			`#`
105			`if [regexp {^~} $path] {`
106			`return 0`
107			`}`
108
109			`# Double slashes`
110			`#`
111			`if [regexp {//} $path] {`
112			`return 0`
113			`}`
114
115			`# Trailing slashes`
116			`#`
117			`if [regexp {/$} $path] {`
118			`return 0`
119			`}`
120
121			`return 1`
122			`}`
123
124			`# tixFSIsValid --`
125			`#`
126			`# Checks whether a native pathname contains invalid characters.`
127			`#`
128			`proc tixFSIsValid {path} {`
129			`return 1`
130			`}`
131
132			`proc tixFSIsVPath {vpath} {`
133			`return [tixFSIsNorm $vpath]`
134			`}`
135
136			`# tixFSVPath --`
137			`#`
138			`# Converts a native pathname to its VPATH`
139			`#`
140			`proc tixFSVPath {path} {`
141			`tixAssert {`
142			`tixAssertNorm $path`
143			`}`
144			`return $path`
145			`}`
146
147			`# tixFSPath --`
148			`#`
149			`# Converts a vpath to a native pathname`
150			`proc tixFSPath {vpath} {`
151			`tixAssert {`
152			`tixAssertVPath $vpath`
153			`}`
154			`return $vpath`
155			`}`
156
157			`# tixFSTildeSubst -- [Unix only]`
158			`#`
159			`# Substitutes any leading tilde characters if possible. No error is`
160			`# generated if the user doesn't exist.`
161			`#`
162			`proc tixFSTildeSubst {text} {`
163			`if [tixStrEq [string index $text 0] ~] {`
164			`# The following will report if the user doesn't exist`
165			`if [catch {`
166			`file isdir $text`
167			`}] {`
168			`return ./$text`
169			`}`
170			`return [tixFile tilde $text]`
171			`} else {`
172			`return $text`
173			`}`
174			`}`
175
176			`# tixFSNorm --`
177			`#`
178			`# Interprets the user's input and return file information about this`
179			`# input.`
180			`#`
181			`# Arguments:`
182			`# See documentation (docs/Files.txt)`
183			`#`
184			`proc tixFSNorm {context text {defFile ""} {flagsVar ""} {errorMsgVar ""}} {`
185			`tixAssert {`
186			`tixAssertVPath $context`
187			`}`
188
189			`if ![tixStrEq $errorMsgVar ""] {`
190			`upvar $errorMsgVar errorMsg`
191			`}`
192			`if ![tixStrEq $flagsVar ""] {`
193			`upvar $flagsVar flags`
194			`}`
195
196			`set hasDirSuffix [regexp {/$} $text]`
197			`set text [tixFSTildeSubst $text]`
198			`set text [_tixJoin $context $text]`
199
200			`if {$hasDirSuffix \|\| [file isdir $text]} {`
201			`set dir $text`
202			`set tail $defFile`
203			`} else {`
204			`set dir [file dirname $text]`
205			`set tail [file tail $text]`
206			`}`
207
208			`set norm $dir/$tail`
209			`regsub -all /+ $norm / norm`
210			`if ![tixStrEq $norm /] {`
211			`regsub {/$} $norm "" norm`
212			`}`
213
214			`if ![info exists flag(noPattern)] {`
215			`set isPat 0`
216			`foreach char [split $tail ""] {`
217			`if {$char == "*" \|\| $char == "?"} {`
218			`set isPat 1`
219			`break`
220			`}`
221			`}`
222			`if {$isPat} {`
223			`return [list $norm $dir "" $tail]`
224			`}`
225			`}`
226
227			`return [list $norm $dir $tail ""]`
228			`}`
229
230			`# _tixJoin -- [Internal]`
231			`#`
232			`# Joins two native pathnames.`
233			`#`
234			`proc _tixJoin {p1 p2} {`
235			`if [tixStrEq [string index $p2 0] /] {`
236			`return [_tixNormalize $p2]`
237			`} else {`
238			`return [_tixNormalize $p1/$p2]`
239			`}`
240			`}`
241
242			`# tixFSNormDir --`
243			`#`
244			`# Normalizes an absolute path.`
245			`#`
246			`proc tixFSNormDir {dir} {`
247			`set dir [tixFile tilde $dir]`
248			`if ![tixStrEq [string index $dir 0] /] {`
249			`error "\"$dir\" must be an absolute pathname"`
250			`}`
251			`if ![file isdir $dir] {`
252			`error "\"$dir\" is not a directory"`
253			`}`
254			`return [_tixNormalize $dir]`
255			`}`
256
257			`# _tixNormalize --`
258			`#`
259			`# Normalizes an absolute pathname.`
260			`#`
261			`# $dir must be an absolute pathname`
262			`#`
263			`proc _tixNormalize {path} {`
264			`tixAssert {`
265			`if ![tixStrEq [string index $path 0] /] {`
266			`error "\"$path\" must be an absolute pathname"`
267			`}`
268			`}`
269
270			`# Don't be fooled: $path doesn't need to be a directory. The following`
271			`# code just makes it easy to get rid of trailing . and ..`
272			`#`
273			`set path $path/`
274			`regsub -all /+ $path / path`
275			`while 1 {`
276			`if ![regsub {/\./} $path "/" path] break`
277			`}`
278			`while 1 {`
279			`if ![regsub {/\.$} $path "" path] break`
280			`}`
281
282			`while 1 {`
283			`if ![regsub {/[^/]+/\.\./} $path "/" path] break`
284			`while 1 {`
285			`if ![regsub {^/\.\./} $path "/" path] break`
286			`}`
287			`}`
288			`while 1 {`
289			`if ![regsub {^/\.\./} $path "/" path] break`
290			`}`
291
292			`regsub {/$} $path "" path`
293			`if [tixStrEq $path ""] {`
294			`return /`
295			`} else {`
296			`return $path`
297			`}`
298			`}`
299
300			`# tixFSCreateDirs`
301			`#`
302			`#`
303			`#`
304			`proc tixFSCreateDirs {path} {`
305			`tixAssert {`
306			`error "Procedure tixFSCreateDirs not implemented on all platforms"`
307			`}`
308			`if [tixStrEq $path /] {`
309			`return 1`
310			`}`
311			`if [file exists $path] {`
312			`return 1`
313			`}`
314			`if ![tixFSCreateDirs [file dirname $path]] {`
315			`return 0`
316			`}`
317			`if [catch {exec mkdir $path}] {`
318			`return 0`
319			`}`
320			`return 1`
321			`}`
322
323			`} else {`
324
325			`#-Win--------------------------------------------------------------------`
326
327			`# (Win) tixFSPWD --`
328			`#`
329			`# Return the current directory`
330			`#`
331			`proc tixFSPWD {} {`
332			`set p [pwd]`
333			`regsub -all / $p \\ p`
334			`return $p`
335			`}`
336			`# Win`
337			`#`
338			`proc tixFSIsNorm {path} {`
339
340			`# Drive root directory`
341			`# CYGNUS LOCAL: drive can be immediately followed by directory separator.`
342			`#`
343			`if [regexp {^[A-z]:\\?$} $path] {`
344			`return 1`
345			`}`
346
347			`# If it is not a drive root directory, it must`
348			`# have a leading [drive letter:]\\[non empty string]`
349			`# CYGNUS LOCAL: A UNC path (\\host\dir) is also OK.`
350			`if ![regexp {^[A-z]:\\.} $path] {`
351			`if ![regexp {^\\\\.*\\.} $path] {`
352			`return 0`
353			`}`
354			`}`
355
356			`# relative path`
357			`#`
358			`if [regexp {\\[.]$} $path] {`
359			`return 0`
360			`}`
361			`if [regexp {\\[.][.]$} $path] {`
362			`return 0`
363			`}`
364			`if [regexp {\\[.]\\} $path] {`
365			`return 0`
366			`}`
367			`if [regexp {\\[.][.]\\} $path] {`
368			`return 0`
369			`}`
370			`if [tixStrEq $path .] {`
371			`return 0`
372			`}`
373			`if [tixStrEq $path ..] {`
374			`return 0`
375			`}`
376
377			`# Double slashes`
378			`# CYGNUS LOCAL: Double slashes at the front are OK.`
379			`#`
380			`if [regexp {.\\\\} $path] {`
381			`return 0`
382			`}`
383
384			`# Trailing slashes`
385			`#`
386			`if [regexp {[\\]$} $path] {`
387			`return 0`
388			`}`
389
390			`return 1`
391			`}`
392
393			`# (Win) tixFSNorm --`
394			`#`
395			`# Interprets the user's input and return file information about this`
396			`# input.`
397			`#`
398			`# Arguments:`
399			`# See documentation (docs/Files.txt)`
400			`#`
401			`proc tixFSNorm {context text {defFile ""} {flagsVar ""} {errorMsgVar ""}} {`
402			`tixAssert {`
403			`tixAssertVPath $context`
404			`}`
405
406			`if ![tixStrEq $errorMsgVar ""] {`
407			`upvar $errorMsgVar errorMsg`
408			`}`
409			`if ![tixStrEq $flagsVar ""] {`
410			`upvar $flagsVar flags`
411			`}`
412
413			`set isDir [regexp {[\\]$} $text]`
414			`set text [_tixJoin $context $text]`
415			`set path [tixFSPath $text]`
416
417			`if {$isDir \|\| [file isdir $path]} {`
418			`set vpath $text`
419			`set tail $defFile`
420			`} else {`
421			`set list [split $text \\]`
422			`set tail [lindex $list end]`
423			`set len [string length $tail]`
424			`set vpath [string range $text 0 [expr [string len $text]-$len-1]]`
425			`regsub {[\\]$} $vpath "" vpath`
426			`}`
427
428			`set path [tixFSPath $vpath]`
429
430			`if ![info exists flag(noPattern)] {`
431			`set isPat 0`
432			`foreach char [split $tail ""] {`
433			`if {$char == "*" \|\| $char == "?"} {`
434			`set isPat 1`
435			`break`
436			`}`
437			`}`
438			`if {$isPat} {`
439			`return [list $path $vpath "" $tail]`
440			`}`
441			`}`
442
443			`return [list $path $vpath $tail ""]`
444			`}`
445
446			`# Win`
447			`#`
448			`# _tixJoin -- [internal]`
449			`#`
450			`# Joins a pathname to a VPATH`
451			`#`
452			`proc _tixJoin {vp1 p2} {`
453			`if [tixFSIsAbsPath $p2] {`
454			`return [tixFSVPath [_tixNormalize $p2]]`
455			`} else {`
456			`return [tixFSVPath [_tixNormalize [tixFSPath $vp1]\\$p2]]`
457			`}`
458			`}`
459
460			`# (Win) tixFSIsAbsPath`
461			`#`
462			`# The Tcl "file pathtype" is buggy. E.g. C:\.\..\. is absolute, but`
463			`# "file pathtype" thinks that it isn't`
464			`#`
465
466			`proc tixFSIsAbsPath {path} {`
467			`# CYGNUS LOCAL: Handle a UNC path (\\host\dir)`
468			`if [regexp {^\\\\.*\\.} $path] {`
469			`return 1`
470			`}`
471			`return [regexp {^[A-z]:\\} $path]`
472			`}`
473
474			`# (Win) tixFSIsNorm_os`
475			`#`
476			`# Returns true iff this pathname is normalized, in the OS native name`
477			`# format`
478			`#`
479			`proc tixFSIsNorm_os {path} {`
480			`if [regexp {^[A-z]:[\\]$} $path] {`
481			`return 1`
482			`}`
483			`if [regexp {^[A-z]:$} $path] {`
484			`return 0`
485			`}`
486
487			`return [tixFSIsNorm $path]`
488
489			`}`
490
491			`# Win`
492			`#`
493			`# _tixNormalize --`
494			`#`
495			`# Normalizes an absolute pathname.`
496			`#`
497			`# $dir must be an absolute native pathname`
498			`#`
499			`proc _tixNormalize {abpath} {`
500			`tixAssert {`
501			`if ![tixFSIsAbsPath $abpath] {`
502			`error "\"$abpath\" must be an absolute pathname"`
503			`}`
504			`}`
505
506			`# CYGNUS LOCAL: Handle UNC paths (\\host\dir)`
507			`if [regexp {^\\\\.*\\.} $abpath] {`
508			`set drive "\\"`
509			`regsub {^\\} $abpath "" path`
510			`} else {`
511			`if ![regexp {^[A-z]:} $abpath drive] {`
512			`tixPanic "\"$abpath\" does not contain a drive letter"`
513			`}`
514			`set drive [string toupper $drive]`
515
516			`regsub {^[A-z]:} $abpath "" path`
517			`}`
518
519			`# Don't be fooled: $path doesn't need to be a directory. The following`
520			`# code "set path $path\\" just makes it easy to get rid of trailing`
521			`# . and ..`
522			`#`
523			`set path $path\\`
524			`regsub -all {[\\]+} $path \\ path`
525			`while 1 {`
526			`if ![regsub {\\[.]\\} $path "\\" path] break`
527			`}`
528			`while 1 {`
529			`if ![regsub {\\[.]$} $path "" path] break`
530			`}`
531
532			`while 1 {`
533			`if ![regsub {\\[^\\]+\\[.][.]\\} $path "\\" path] break`
534			`while 1 {`
535			`if ![regsub {^\\[.][.]\\} $path "\\" path] break`
536			`}`
537			`}`
538			`while 1 {`
539			`if ![regsub {^\\[.][.]\\} $path "\\" path] break`
540			`}`
541
542			`regsub {[\\]+$} $path "" path`
543			`return $drive$path`
544			`}`
545
546			`# Win`
547			`#`
548			`# tixFSNormDir --`
549			`#`
550			`# Normalizes a directory`
551			`#`
552			`proc tixFSNormDir {dir} {`
553			`if ![tixFSIsAbsPath $dir] {`
554			`error "\"$dir\" must be an absolute pathname"`
555			`}`
556			`if ![file isdir $dir] {`
557			`error "\"$dir\" is not a directory"`
558			`}`
559			`return [_tixNormalize $dir]`
560			`}`
561
562
563			`proc tixPanic {message} {`
564			`error $message`
565			`}`
566
567			`# tixFSIsValid --`
568			`#`
569			`# Checks whether a native pathname contains invalid characters.`
570			`#`
571			`proc tixFSIsValid {path} {`
572			`return 1`
573			`}`
574
575			`# Win`
576			`#`
577			`#`
578			`proc tixFSIsVPath {vpath} {`
579			`global tixPriv`
580			`if $tixPriv(isWin95) {`
581			`# CYGNUS LOCAL: Accept UNC path (\\host\dir)`
582			`if [string match {xx\\xx\\\\\\\\} $vpath] {`
583			`return 1`
584			`}`
585			`return [string match {xx\\xx\\[A-z]:*} $vpath]`
586			`} else {`
587			`return [string match {xx\\[A-z]:*} $vpath]`
588			`}`
589			`}`
590
591			`# Win`
592			`#`
593			`# tixFSVPath --`
594			`#`
595			`# Converts a normalized native pathname to its VPATH`
596			`#`
597			`proc tixFSVPath {path} {`
598			`global tixPriv`
599
600			`tixAssert {`
601			`tixAssertNorm $path`
602			`}`
603			`return $tixPriv(WinPrefix)\\$path`
604			`}`
605
606			`# tixFSPath --`
607			`#`
608			`# Converts a vpath to a native pathname`
609			`proc tixFSPath {vpath} {`
610			`global tixPriv`
611			`tixAssert {`
612			`tixAssertVPath $vpath`
613			`}`
614			`if $tixPriv(isWin95) {`
615			`set path [string range $vpath 6 end]`
616			`} else {`
617			`set path [string range $vpath 3 end]`
618			`}`
619			`regsub {:$} $path :\\ path`
620
621			`return $path`
622			`}`
623
624			`# tixFSDisplayName --`
625			`#`
626			`# Returns the name of a normalized path which is usually displayed by`
627			`# the OS`
628			`#`
629			`proc tixFSDisplayName {normpath} {`
630			`tixAssert {`
631			`tixAssertNorm $normpath`
632			`}`
633
634			`if [regexp {^[A-z]:$} $normpath] {`
635			`return $normpath\\`
636			`} else {`
637			`return $normpath`
638			`}`
639			`}`
640
641
642			`tixInitFileCmpt:Win`
643
644			`}`