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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [WinFile.tcl] - Blame information for rev 1778

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


# WinFile.tcl --
#
#       MS Window file access portibility routines.
#
# Copyright (c) 1996, Expert Interface Technologies
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
 
proc tixInitFileCmpt:Win {} {
    global tixPriv tcl_platform
 
    if {$tcl_platform(osVersion) >= 4.0} {
        set tixPriv(isWin95) 1
    } else {
        set tixPriv(isWin95) 0
    }
    if $tixPriv(isWin95) {
        set tixPriv(WinPrefix) xx\\xx
    } else {
        set tixPriv(WinPrefix) xx
    }
 
#----------------------------------------------------------------------
#
#               MS Windows
#
#----------------------------------------------------------------------
 
# splits a Windows directory into its hierarchical components
#
proc tixFSSplit {vpath} {
    global tixPriv
 
    set path ""
    if $tixPriv(isWin95) {
        if ![string compare $vpath xx] {
            lappend path [list xx     "Desktop"     "C:\\Windows\\Desktop" ]
            return $path
        }
        if ![string compare $vpath xx\\xx] {
            lappend path [list xx     "Desktop"     "C:\\Windows\\Desktop" ]
            lappend path [list xx\\xx "My Computer" "C:\\"]
            return $path
        }
 
        set prefix "xx\\xx"
        if ![regsub {^xx\\xx\\} $vpath "" dir] {
            if [regsub {^xx\\} $vpath "" dir] {
                lappend path [list xx     "Desktop"     "C:\\Windows\\Desktop" ]
                set v "xx"
                set p "C:\\Windows\\Desktop"
                foreach d [split $dir \\] {
                    append v \\$d
                    append p \\$d
                    lappend path [list $v $d $p]
                }
                return $path
            }
        }
        regsub {:$} $dir :/ dir
        lappend path [list xx     "Desktop"     "C:\\Windows\\Desktop" ]
        lappend path [list xx\\xx "My Computer" "C:\\"]
    } else {
        if ![string compare $vpath xx] {
            lappend path [list xx     "My Computer" "C:\\"]
            return $path
        }
        lappend path [list xx     "My Computer" "C:\\"]
 
        set prefix xx
        regsub {^xx\\} $vpath "" dir
        regsub {:$} $dir :/ dir
    }
 
    if ![string compare $dir ""] {
        return $path
    }
    if [string compare [file pathtype $dir] "absolute"] {
        error "$dir must be an absolute path"
    }
 
    set dirs [file split $dir]
    set p ""
    foreach d $dirs {
        set p [file join $p $d]
        regsub -all / $p \\ p
        set vpath $prefix\\$p
        regsub {[\\]$} $vpath "" vpath
        regsub {:/$} $d ":" d
        lappend path [list $vpath $d $p]
    }
 
    return $path
}
 
# returns true if $dir is an valid path (not equal to "")
#
proc tixFSValid {dir} {
    return [expr ![string compare $dir ""]]
}
 
# tixFSIntName
#
#       Returns the "virtual path" of a filename
#
proc tixFSIntName {dir} {
    global tixPriv
 
    if ![string compare $dir ""] {
        if $tixPriv(isWin95) {
            return "xx\\xx"
        } else {
            return xx
        }
    }
 
    if [string compare [file pathtype $dir] "absolute"] {
        error "$dir must be an absolute path"
    }
 
    if $tixPriv(isWin95) {
        set vpath "xx\\xx\\$dir"
    } else {
        set vpath "xx\\$dir"
    }
    regsub {:/$} $vpath ":" vpath
    regsub {[\\]$} $vpath "" vpath
    return $vpath
}
 
proc tixFSIntJoin {dir sub} {
    set vpath $dir\\$sub
    regsub -all {\\\\} $vpath \\ vpath
    regsub {:/$} $vpath : vpath
    regsub {[\\]$} $vpath "" vpath
    return $vpath
}
 
proc tixFSJoin {dir sub} {
    set p [file join $dir $sub]
    regsub -all / $p \\ p
    return $p
}
 
proc tixFSResolveName {p} {
    regsub -all / $p \\ p
    if [regexp {:([^\\]|$)} $p] {
        regsub : $p :\\ p
    }
    return $p
}
 
# dir:          Make a listing of this directory
# showSubDir:   Want to list the subdirectories?
# showFile:     Want to list the non-directory files in this directory?
# showPrevDir:  Want to list ".." as well?
# showHidden:   Want to list the hidden files? (%% is ignored)
#
# return value: a list of files and/or subdirectories
#
proc tixFSListDir {vpath showSubDir showFile showPrevDir showHidden {pattern ""}} {
    global tixPriv
    set appPWD [pwd]
    set list ""
 
    if $tixPriv(isWin95) {
        if ![string compare $vpath xx] {
            set dir C:\\Windows\\Desktop
            if {$showSubDir} {
                lappend list xx:
            }
        } elseif ![string compare $vpath xx\\xx] {
            if {$showSubDir} {
                return [tixFSGetDrives]
            } else {
                return ""
            }
        } else {
            if ![regsub {^xx\\xx\\} $vpath "" dir] {
                regsub {^xx\\} $vpath C:\\Windows\\Desktop\\ dir
            }
            regsub {:$} $dir :\\ dir
        }
    } else {
        if ![string compare $vpath xx] {
            if {$showSubDir} {
                return [tixFSGetDrives]
            } else {
                return ""
            }
        }
 
        regsub {^xx\\} $vpath "" dir
        regsub {:$} $dir :\\ dir
    }
 
    if [catch {cd $dir} err] {
        # The user has entered an invalid directory
        # %% todo: prompt error, go back to last succeed directory
        cd $appPWD
        return ""
    }
 
    if {$pattern == ""} {
        set pattern "*"
    }
 
    if [catch {set names [lsort [eval glob -nocomplain $pattern]]} err] {
        # Cannot read directory
        # %% todo: show directory permission denied
        cd $appPWD
        return ""
    }
 
    catch {
        # We are catch'ing, just in case the "file" command returns unexpected
        # errors
        #
        foreach fname $names {
            if {![string compare . $fname]} {
                continue
            }
            if {![string compare ".." $fname]} {
                continue
            }
            if [file isdirectory $fname] {
                if $showSubDir {
                    lappend list [file tail $fname]
                }
            } else {
                if $showFile {
                    lappend list [file tail $fname]
                }
            }
        }
    }
    cd $appPWD
 
    if {$showSubDir && $showPrevDir && $dir != "/"} {
        return [tixFSMakeList $vpath $dir [lsort [concat .. $list]]]
    } else {
        return [tixFSMakeList $vpath $dir $list]
    }
}
 
proc tixFSMakeList {vpath dir list} {
    global tixPriv
 
    if $tixPriv(isWin95) {
        set prefix xx\\xx
    } else {
        set prefix xx
    }
    set l ""
    foreach file $list {
        if ![string compare $file xx:] {
             lappend l [list xx\\xx "My Computer" "C:\\"]
        } else {
            set path [tixFSJoin $dir $file]
            lappend l [list $vpath\\$file $file $path]
        }
    }
 
    return $l
}
 
proc tixFSSep {} {
    return "\\"
}
 
proc tixFSGetDrives {} {
    global tixPriv
 
    if [info exists tixPriv(drives)] {
        return $tixPriv(drives)
    } else {
        set drives [list A: B:]
        foreach d {c d e f g h i j k l m n o p q r s t u v w x y z} {
            if [file exists $d:\\] {
                lappend drives [string toupper $d:]
            }
        }
 
        set tixPriv(drives) ""
        foreach d $drives {
             lappend tixPriv(drives) [list $tixPriv(WinPrefix)\\$d $d $d\\]
        }
    }
    return $tixPriv(drives)
}
 
#----------------------------------------------------------------------
#
#               OBSOLETE
#
#----------------------------------------------------------------------
 
 
 
# Directory separator
#
proc tixDirSep {} {
    return "\\"
}
 
# returns the "root directory" of this operating system
#
# out:  intName
proc tixRootDir {} {
    return "/"
}
 
# is an absoulte path only if it starts with a baclskash
# or starts with "<drive letter>:"
#
# in: nativeName
#
proc tixIsAbsPath {nativeName} {
    set c [string index $nativeName 0]
    if {$c == "\\"} {
        return 1
    }
 
    if {[string compare [string toupper $c] A] < 0} {
        return 0
    }
    if {[string compare [string toupper $c] Z] > 0} {
        return 0
    }
    if {[string index $nativeName 1] != ":"} {
        return 0
    }
    return 1
}
 
# returns <drive>:
#
proc tixWinGetFileDrive {nativeName} {
    set c [string index $nativeName 0]
    if {$c == "\\"} {
        return [string toupper [string range [pwd] 0 1]]
    }
 
    if {[string compare [string toupper $c] A] < 0} {
        return [string toupper [string range [pwd] 0 1]]
    }
    if {[string compare [string toupper $c] Z] > 0} {
        return [string toupper [string range [pwd] 0 1]]
    }
    if {[string index $nativeName 1] != ":"} {
        return [string toupper [string range [pwd] 0 1]]
    }
    return [string toupper [string range $nativeName 0 1]]
}
 
# returns the absolute pathname of the file 
# (not including the drive letter or the first backslash)
#
# [tixWinGetFileDrive]\\[tixWinGetFilePath] gives the complete
# drive and pathname
#
proc tixWinGetFilePath {nativeName} {
    set c [string index $nativeName 0]
    if {$c == "\\"} {
        return ""
    }
 
    if {[string compare [string toupper $c] A] < 0} {
        return [tixWinGetPathFromDrive $nativeName]
    }
    if {[string compare [string toupper $c] Z] > 0} {
        return [tixWinGetPathFromDrive $nativeName]
    }
    if {[string index $nativeName 1] != ":"} {
        return [tixWinGetPathFromDrive $nativeName]
    }
    if {[string index $nativeName 2] != "\\"} {
        regexp {[A-z]:} $nativeName drive
        regsub {[A-z]:} $nativeName "" path
        return [tixWinGetPathFromDrive $path $drive]
    }
 
    regsub {[A-z]:[\\]} $nativeName "" path
    return $path
}
 
proc tixWinCurrentDrive {} {
    return [string range [pwd] 0 1]
}
 
proc tixWinGetPathFromDrive {path {drive ""}} {
    if {$drive == ""} {
        set drive [tixWinCurrentDrive]
    }
 
    #
    # %% currently TCL (7.5b3) does not tell what the current path
    #    on a particular drive is
 
    return $path
}
 
#
#
# nativeName:   native filename used in this OS, comes from the user or
#               application programmer
# defParent:    (intName) if the filename is not an absolute path,
#               treat it as a subfolder of $defParent
#               (must be an intName, must be absolute)
proc tixFileIntName {nativeName {defParent ""}} {
    if {![tixIsAbsPath $nativeName]} {
        if {$defParent != ""} {
            if {[string index $defParent 0] != "/"} {
                error "Tix toolkit error: \"$defParent\" is not an absolute internal file name"
            }
            set path [tixSubFolder $defParent $nativeName]
        } else {
            set path $nativeName
        }
    } else {
        set path /[tixWinGetFileDrive $nativeName]\\[tixWinGetFilePath $nativeName]
    }
 
    set intName ""
    foreach name [tixFileSplit $path] {
        set intName [tixSubFolder $intName $name]
    }
 
    return $intName
}
 
# in:   internal name
# out:  native name
proc tixNativeName {intName {mustBeAbs 1}} {
    if {[string index $intName 0] != "/"} {
        if {$mustBeAbs} {
            error "Tix internal error: \"$intName\" is not an intName"
        } else {
            return $intName
        }
    }
    if {$intName == "/"} {
        return C:\\
    }
    regsub {/[\\]} $intName "" nativeName
    if {[string length $nativeName] == 2} {
        return $nativeName\\
    } else {
        return $nativeName
    }
}
 
# how a filename should be displayed
# 
# e.g. /\C: becomes C:\\
#      /\   becomes "My Computer"
#      /\C:\\Windows is Windows
proc tixFileDisplayName {intName} {
    if {[string index $intName 0] != "/"} {
        error "Tix internal error: \"$intName\" is not an intName"
    }
 
    if {$intName == "/"} {
        return "My Computer"
    }
 
    regsub {/[\\]} $intName "" nativeName
 
    if {[string length $nativeName] == 2} {
        return [string toupper $nativeName\\]
    } else {
        return [file tail $nativeName]
    }
}
 
# in:   internal name
# out:  a list of paths
proc tixFileSplit {intName} {
 
    set l ""
    foreach n [split $intName /\\] {
        if {$n == ""} {
            continue
        }
        if {$n == "."} {
            continue
        }
 
        lappend l $n
    }
 
 
    while 1 {
        set idx [lsearch $l ".."]
        if {$idx == -1} {
            break;
        }
        set l [lreplace $l [expr $idx -1] $idx]
    }
 
 
    if {[string index $intName 0] == "/"} {
        return [concat "/" $l]
    } else {
        return $l
    }
}
 
# parent, sub:  intName
#
proc tixSubFolder {parent sub} {
    if {$parent == ""} {
        return $sub
    }
    return $parent\\$sub
}
 
proc tixWinGetDrives {} {
    global tixPriv
 
    if [info exists tixPriv(drives)] {
        return $tixPriv(drives)
    } else {
        set tixPriv(drives) {A: B:}
        foreach d {c e d f g h i j k l m n o p q r s t u v w x y z} {
            if [file exists $d:] {
                lappend tixPriv(drives) [string toupper $d:]
            }
        }
    }
    return $tixPriv(drives)
}
 
# dir:          Make a listing of this directory
# showSubDir:   Want to list the subdirectories?
# showFile:     Want to list the non-directory files in this directory?
# showPrevDir:  Want to list ".." as well?
# showHidden:   Want to list the hidden files? (%% is ignored)
#
# return value: a list of files and/or subdirectories
#
proc tixListDir {dir showSubDir showFile showPrevDir showHidden {pattern ""}} {
    set appPWD [pwd]
 
    if {$dir == "/"} {
        if {$showSubDir} {
            return [tixWinGetDrives]
        } else {
            return ""
        }
    }
 
    if [catch {cd [tixNativeName $dir]} err] {
        # The user has entered an invalid directory
        # %% todo: prompt error, go back to last succeed directory
        cd $appPWD
        return ""
    }
 
    if {$pattern == ""} {
        set pattern "*"
    }
 
    if [catch {set names [lsort [eval glob -nocomplain $pattern]]} err] {
        # Cannot read directory
        # %% todo: show directory permission denied
        cd $appPWD
        return ""
    }
 
    set list ""
    catch {
        # We are catch'ing, just in case the "file" command returns unexpected
        # errors
        #
        foreach fname $names {
            if {![string compare . $fname]} {
                continue
            }
            if {![string compare ".." $fname]} {
                continue
            }
            if [file isdirectory $fname] {
                if $showSubDir {
                    lappend list [file tail $fname]
                }
            } else {
                if $showFile {
                    lappend list [file tail $fname]
                }
            }
        }
    }
    cd $appPWD
 
    if {$showSubDir && $showPrevDir && $dir != "/"} {
        return [lsort [concat .. $list]]
    } else {
        return $list
    }
}
 
proc tixVerifyFile {file} {
    return [tixFileIntName $file]
}
 
proc tixFilePattern {args} {
    if {[lsearch $args allFiles] != -1} {
        return *
    }
    return *
}
 
}
 
# tixWinFileEmu --
#
#       Emulates a MS Windows file system environemnt inside Unix
#
proc tixWinFileEmu {} {
    cd /mnt/c
    rename pwd __pwd
    rename cd  __cd
    proc EmuConvert {path} {
        if [regsub ^/mnt/c/ $path c:/ path] {
            return $path
        }
        if [regsub ^/mnt/d/ $path d:/ path] {
            return $path
        }
        if [regsub ^/mnt/c\$ $path c:/ path] {
            return $path
        }
        if [regsub ^/mnt/d\$ $path d:/ path] {
            return $path
        }
        return c:/windows
    }
 
    proc pwd {} {
        return [EmuConvert [__pwd]]
    }
    proc glob {args} {
 
    }
}

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [WinFile.tcl] - Blame information for rev 1778

Line No.	Rev	Author	Line
1	578	markom	`# WinFile.tcl --`
2			`#`
3			`# MS Window file access portibility routines.`
4			`#`
5			`# Copyright (c) 1996, Expert Interface Technologies`
6			`#`
7			`# See the file "license.terms" for information on usage and redistribution`
8			`# of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
9			`#`
10
11			`proc tixInitFileCmpt:Win {} {`
12			`global tixPriv tcl_platform`
13
14			`if {$tcl_platform(osVersion) >= 4.0} {`
15			`set tixPriv(isWin95) 1`
16			`} else {`
17			`set tixPriv(isWin95) 0`
18			`}`
19			`if $tixPriv(isWin95) {`
20			`set tixPriv(WinPrefix) xx\\xx`
21			`} else {`
22			`set tixPriv(WinPrefix) xx`
23			`}`
24
25			`#----------------------------------------------------------------------`
26			`#`
27			`# MS Windows`
28			`#`
29			`#----------------------------------------------------------------------`
30
31			`# splits a Windows directory into its hierarchical components`
32			`#`
33			`proc tixFSSplit {vpath} {`
34			`global tixPriv`
35
36			`set path ""`
37			`if $tixPriv(isWin95) {`
38			`if ![string compare $vpath xx] {`
39			`lappend path [list xx "Desktop" "C:\\Windows\\Desktop" ]`
40			`return $path`
41			`}`
42			`if ![string compare $vpath xx\\xx] {`
43			`lappend path [list xx "Desktop" "C:\\Windows\\Desktop" ]`
44			`lappend path [list xx\\xx "My Computer" "C:\\"]`
45			`return $path`
46			`}`
47
48			`set prefix "xx\\xx"`
49			`if ![regsub {^xx\\xx\\} $vpath "" dir] {`
50			`if [regsub {^xx\\} $vpath "" dir] {`
51			`lappend path [list xx "Desktop" "C:\\Windows\\Desktop" ]`
52			`set v "xx"`
53			`set p "C:\\Windows\\Desktop"`
54			`foreach d [split $dir \\] {`
55			`append v \\$d`
56			`append p \\$d`
57			`lappend path [list $v $d $p]`
58			`}`
59			`return $path`
60			`}`
61			`}`
62			`regsub {:$} $dir :/ dir`
63			`lappend path [list xx "Desktop" "C:\\Windows\\Desktop" ]`
64			`lappend path [list xx\\xx "My Computer" "C:\\"]`
65			`} else {`
66			`if ![string compare $vpath xx] {`
67			`lappend path [list xx "My Computer" "C:\\"]`
68			`return $path`
69			`}`
70			`lappend path [list xx "My Computer" "C:\\"]`
71
72			`set prefix xx`
73			`regsub {^xx\\} $vpath "" dir`
74			`regsub {:$} $dir :/ dir`
75			`}`
76
77			`if ![string compare $dir ""] {`
78			`return $path`
79			`}`
80			`if [string compare [file pathtype $dir] "absolute"] {`
81			`error "$dir must be an absolute path"`
82			`}`
83
84			`set dirs [file split $dir]`
85			`set p ""`
86			`foreach d $dirs {`
87			`set p [file join $p $d]`
88			`regsub -all / $p \\ p`
89			`set vpath $prefix\\$p`
90			`regsub {[\\]$} $vpath "" vpath`
91			`regsub {:/$} $d ":" d`
92			`lappend path [list $vpath $d $p]`
93			`}`
94
95			`return $path`
96			`}`
97
98			`# returns true if $dir is an valid path (not equal to "")`
99			`#`
100			`proc tixFSValid {dir} {`
101			`return [expr ![string compare $dir ""]]`
102			`}`
103
104			`# tixFSIntName`
105			`#`
106			`# Returns the "virtual path" of a filename`
107			`#`
108			`proc tixFSIntName {dir} {`
109			`global tixPriv`
110
111			`if ![string compare $dir ""] {`
112			`if $tixPriv(isWin95) {`
113			`return "xx\\xx"`
114			`} else {`
115			`return xx`
116			`}`
117			`}`
118
119			`if [string compare [file pathtype $dir] "absolute"] {`
120			`error "$dir must be an absolute path"`
121			`}`
122
123			`if $tixPriv(isWin95) {`
124			`set vpath "xx\\xx\\$dir"`
125			`} else {`
126			`set vpath "xx\\$dir"`
127			`}`
128			`regsub {:/$} $vpath ":" vpath`
129			`regsub {[\\]$} $vpath "" vpath`
130			`return $vpath`
131			`}`
132
133			`proc tixFSIntJoin {dir sub} {`
134			`set vpath $dir\\$sub`
135			`regsub -all {\\\\} $vpath \\ vpath`
136			`regsub {:/$} $vpath : vpath`
137			`regsub {[\\]$} $vpath "" vpath`
138			`return $vpath`
139			`}`
140
141			`proc tixFSJoin {dir sub} {`
142			`set p [file join $dir $sub]`
143			`regsub -all / $p \\ p`
144			`return $p`
145			`}`
146
147			`proc tixFSResolveName {p} {`
148			`regsub -all / $p \\ p`
149			`if [regexp {:([^\\]\|$)} $p] {`
150			`regsub : $p :\\ p`
151			`}`
152			`return $p`
153			`}`
154
155			`# dir: Make a listing of this directory`
156			`# showSubDir: Want to list the subdirectories?`
157			`# showFile: Want to list the non-directory files in this directory?`
158			`# showPrevDir: Want to list ".." as well?`
159			`# showHidden: Want to list the hidden files? (%% is ignored)`
160			`#`
161			`# return value: a list of files and/or subdirectories`
162			`#`
163			`proc tixFSListDir {vpath showSubDir showFile showPrevDir showHidden {pattern ""}} {`
164			`global tixPriv`
165			`set appPWD [pwd]`
166			`set list ""`
167
168			`if $tixPriv(isWin95) {`
169			`if ![string compare $vpath xx] {`
170			`set dir C:\\Windows\\Desktop`
171			`if {$showSubDir} {`
172			`lappend list xx:`
173			`}`
174			`} elseif ![string compare $vpath xx\\xx] {`
175			`if {$showSubDir} {`
176			`return [tixFSGetDrives]`
177			`} else {`
178			`return ""`
179			`}`
180			`} else {`
181			`if ![regsub {^xx\\xx\\} $vpath "" dir] {`
182			`regsub {^xx\\} $vpath C:\\Windows\\Desktop\\ dir`
183			`}`
184			`regsub {:$} $dir :\\ dir`
185			`}`
186			`} else {`
187			`if ![string compare $vpath xx] {`
188			`if {$showSubDir} {`
189			`return [tixFSGetDrives]`
190			`} else {`
191			`return ""`
192			`}`
193			`}`
194
195			`regsub {^xx\\} $vpath "" dir`
196			`regsub {:$} $dir :\\ dir`
197			`}`
198
199			`if [catch {cd $dir} err] {`
200			`# The user has entered an invalid directory`
201			`# %% todo: prompt error, go back to last succeed directory`
202			`cd $appPWD`
203			`return ""`
204			`}`
205
206			`if {$pattern == ""} {`
207			`set pattern "*"`
208			`}`
209
210			`if [catch {set names [lsort [eval glob -nocomplain $pattern]]} err] {`
211			`# Cannot read directory`
212			`# %% todo: show directory permission denied`
213			`cd $appPWD`
214			`return ""`
215			`}`
216
217			`catch {`
218			`# We are catch'ing, just in case the "file" command returns unexpected`
219			`# errors`
220			`#`
221			`foreach fname $names {`
222			`if {![string compare . $fname]} {`
223			`continue`
224			`}`
225			`if {![string compare ".." $fname]} {`
226			`continue`
227			`}`
228			`if [file isdirectory $fname] {`
229			`if $showSubDir {`
230			`lappend list [file tail $fname]`
231			`}`
232			`} else {`
233			`if $showFile {`
234			`lappend list [file tail $fname]`
235			`}`
236			`}`
237			`}`
238			`}`
239			`cd $appPWD`
240
241			`if {$showSubDir && $showPrevDir && $dir != "/"} {`
242			`return [tixFSMakeList $vpath $dir [lsort [concat .. $list]]]`
243			`} else {`
244			`return [tixFSMakeList $vpath $dir $list]`
245			`}`
246			`}`
247
248			`proc tixFSMakeList {vpath dir list} {`
249			`global tixPriv`
250
251			`if $tixPriv(isWin95) {`
252			`set prefix xx\\xx`
253			`} else {`
254			`set prefix xx`
255			`}`
256			`set l ""`
257			`foreach file $list {`
258			`if ![string compare $file xx:] {`
259			`lappend l [list xx\\xx "My Computer" "C:\\"]`
260			`} else {`
261			`set path [tixFSJoin $dir $file]`
262			`lappend l [list $vpath\\$file $file $path]`
263			`}`
264			`}`
265
266			`return $l`
267			`}`
268
269			`proc tixFSSep {} {`
270			`return "\\"`
271			`}`
272
273			`proc tixFSGetDrives {} {`
274			`global tixPriv`
275
276			`if [info exists tixPriv(drives)] {`
277			`return $tixPriv(drives)`
278			`} else {`
279			`set drives [list A: B:]`
280			`foreach d {c d e f g h i j k l m n o p q r s t u v w x y z} {`
281			`if [file exists $d:\\] {`
282			`lappend drives [string toupper $d:]`
283			`}`
284			`}`
285
286			`set tixPriv(drives) ""`
287			`foreach d $drives {`
288			`lappend tixPriv(drives) [list $tixPriv(WinPrefix)\\$d $d $d\\]`
289			`}`
290			`}`
291			`return $tixPriv(drives)`
292			`}`
293
294			`#----------------------------------------------------------------------`
295			`#`
296			`# OBSOLETE`
297			`#`
298			`#----------------------------------------------------------------------`
299
300
301
302			`# Directory separator`
303			`#`
304			`proc tixDirSep {} {`
305			`return "\\"`
306			`}`
307
308			`# returns the "root directory" of this operating system`
309			`#`
310			`# out: intName`
311			`proc tixRootDir {} {`
312			`return "/"`
313			`}`
314
315			`# is an absoulte path only if it starts with a baclskash`
316			`# or starts with "<drive letter>:"`
317			`#`
318			`# in: nativeName`
319			`#`
320			`proc tixIsAbsPath {nativeName} {`
321			`set c [string index $nativeName 0]`
322			`if {$c == "\\"} {`
323			`return 1`
324			`}`
325
326			`if {[string compare [string toupper $c] A] < 0} {`
327			`return 0`
328			`}`
329			`if {[string compare [string toupper $c] Z] > 0} {`
330			`return 0`
331			`}`
332			`if {[string index $nativeName 1] != ":"} {`
333			`return 0`
334			`}`
335			`return 1`
336			`}`
337
338			`# returns <drive>:`
339			`#`
340			`proc tixWinGetFileDrive {nativeName} {`
341			`set c [string index $nativeName 0]`
342			`if {$c == "\\"} {`
343			`return [string toupper [string range [pwd] 0 1]]`
344			`}`
345
346			`if {[string compare [string toupper $c] A] < 0} {`
347			`return [string toupper [string range [pwd] 0 1]]`
348			`}`
349			`if {[string compare [string toupper $c] Z] > 0} {`
350			`return [string toupper [string range [pwd] 0 1]]`
351			`}`
352			`if {[string index $nativeName 1] != ":"} {`
353			`return [string toupper [string range [pwd] 0 1]]`
354			`}`
355			`return [string toupper [string range $nativeName 0 1]]`
356			`}`
357
358			`# returns the absolute pathname of the file`
359			`# (not including the drive letter or the first backslash)`
360			`#`
361			`# [tixWinGetFileDrive]\\[tixWinGetFilePath] gives the complete`
362			`# drive and pathname`
363			`#`
364			`proc tixWinGetFilePath {nativeName} {`
365			`set c [string index $nativeName 0]`
366			`if {$c == "\\"} {`
367			`return ""`
368			`}`
369
370			`if {[string compare [string toupper $c] A] < 0} {`
371			`return [tixWinGetPathFromDrive $nativeName]`
372			`}`
373			`if {[string compare [string toupper $c] Z] > 0} {`
374			`return [tixWinGetPathFromDrive $nativeName]`
375			`}`
376			`if {[string index $nativeName 1] != ":"} {`
377			`return [tixWinGetPathFromDrive $nativeName]`
378			`}`
379			`if {[string index $nativeName 2] != "\\"} {`
380			`regexp {[A-z]:} $nativeName drive`
381			`regsub {[A-z]:} $nativeName "" path`
382			`return [tixWinGetPathFromDrive $path $drive]`
383			`}`
384
385			`regsub {[A-z]:[\\]} $nativeName "" path`
386			`return $path`
387			`}`
388
389			`proc tixWinCurrentDrive {} {`
390			`return [string range [pwd] 0 1]`
391			`}`
392
393			`proc tixWinGetPathFromDrive {path {drive ""}} {`
394			`if {$drive == ""} {`
395			`set drive [tixWinCurrentDrive]`
396			`}`
397
398			`#`
399			`# %% currently TCL (7.5b3) does not tell what the current path`
400			`# on a particular drive is`
401
402			`return $path`
403			`}`
404
405			`#`
406			`#`
407			`# nativeName: native filename used in this OS, comes from the user or`
408			`# application programmer`
409			`# defParent: (intName) if the filename is not an absolute path,`
410			`# treat it as a subfolder of $defParent`
411			`# (must be an intName, must be absolute)`
412			`proc tixFileIntName {nativeName {defParent ""}} {`
413			`if {![tixIsAbsPath $nativeName]} {`
414			`if {$defParent != ""} {`
415			`if {[string index $defParent 0] != "/"} {`
416			`error "Tix toolkit error: \"$defParent\" is not an absolute internal file name"`
417			`}`
418			`set path [tixSubFolder $defParent $nativeName]`
419			`} else {`
420			`set path $nativeName`
421			`}`
422			`} else {`
423			`set path /[tixWinGetFileDrive $nativeName]\\[tixWinGetFilePath $nativeName]`
424			`}`
425
426			`set intName ""`
427			`foreach name [tixFileSplit $path] {`
428			`set intName [tixSubFolder $intName $name]`
429			`}`
430
431			`return $intName`
432			`}`
433
434			`# in: internal name`
435			`# out: native name`
436			`proc tixNativeName {intName {mustBeAbs 1}} {`
437			`if {[string index $intName 0] != "/"} {`
438			`if {$mustBeAbs} {`
439			`error "Tix internal error: \"$intName\" is not an intName"`
440			`} else {`
441			`return $intName`
442			`}`
443			`}`
444			`if {$intName == "/"} {`
445			`return C:\\`
446			`}`
447			`regsub {/[\\]} $intName "" nativeName`
448			`if {[string length $nativeName] == 2} {`
449			`return $nativeName\\`
450			`} else {`
451			`return $nativeName`
452			`}`
453			`}`
454
455			`# how a filename should be displayed`
456			`#`
457			`# e.g. /\C: becomes C:\\`
458			`# /\ becomes "My Computer"`
459			`# /\C:\\Windows is Windows`
460			`proc tixFileDisplayName {intName} {`
461			`if {[string index $intName 0] != "/"} {`
462			`error "Tix internal error: \"$intName\" is not an intName"`
463			`}`
464
465			`if {$intName == "/"} {`
466			`return "My Computer"`
467			`}`
468
469			`regsub {/[\\]} $intName "" nativeName`
470
471			`if {[string length $nativeName] == 2} {`
472			`return [string toupper $nativeName\\]`
473			`} else {`
474			`return [file tail $nativeName]`
475			`}`
476			`}`
477
478			`# in: internal name`
479			`# out: a list of paths`
480			`proc tixFileSplit {intName} {`
481
482			`set l ""`
483			`foreach n [split $intName /\\] {`
484			`if {$n == ""} {`
485			`continue`
486			`}`
487			`if {$n == "."} {`
488			`continue`
489			`}`
490
491			`lappend l $n`
492			`}`
493
494
495			`while 1 {`
496			`set idx [lsearch $l ".."]`
497			`if {$idx == -1} {`
498			`break;`
499			`}`
500			`set l [lreplace $l [expr $idx -1] $idx]`
501			`}`
502
503
504			`if {[string index $intName 0] == "/"} {`
505			`return [concat "/" $l]`
506			`} else {`
507			`return $l`
508			`}`
509			`}`
510
511			`# parent, sub: intName`
512			`#`
513			`proc tixSubFolder {parent sub} {`
514			`if {$parent == ""} {`
515			`return $sub`
516			`}`
517			`return $parent\\$sub`
518			`}`
519
520			`proc tixWinGetDrives {} {`
521			`global tixPriv`
522
523			`if [info exists tixPriv(drives)] {`
524			`return $tixPriv(drives)`
525			`} else {`
526			`set tixPriv(drives) {A: B:}`
527			`foreach d {c e d f g h i j k l m n o p q r s t u v w x y z} {`
528			`if [file exists $d:] {`
529			`lappend tixPriv(drives) [string toupper $d:]`
530			`}`
531			`}`
532			`}`
533			`return $tixPriv(drives)`
534			`}`
535
536			`# dir: Make a listing of this directory`
537			`# showSubDir: Want to list the subdirectories?`
538			`# showFile: Want to list the non-directory files in this directory?`
539			`# showPrevDir: Want to list ".." as well?`
540			`# showHidden: Want to list the hidden files? (%% is ignored)`
541			`#`
542			`# return value: a list of files and/or subdirectories`
543			`#`
544			`proc tixListDir {dir showSubDir showFile showPrevDir showHidden {pattern ""}} {`
545			`set appPWD [pwd]`
546
547			`if {$dir == "/"} {`
548			`if {$showSubDir} {`
549			`return [tixWinGetDrives]`
550			`} else {`
551			`return ""`
552			`}`
553			`}`
554
555			`if [catch {cd [tixNativeName $dir]} err] {`
556			`# The user has entered an invalid directory`
557			`# %% todo: prompt error, go back to last succeed directory`
558			`cd $appPWD`
559			`return ""`
560			`}`
561
562			`if {$pattern == ""} {`
563			`set pattern "*"`
564			`}`
565
566			`if [catch {set names [lsort [eval glob -nocomplain $pattern]]} err] {`
567			`# Cannot read directory`
568			`# %% todo: show directory permission denied`
569			`cd $appPWD`
570			`return ""`
571			`}`
572
573			`set list ""`
574			`catch {`
575			`# We are catch'ing, just in case the "file" command returns unexpected`
576			`# errors`
577			`#`
578			`foreach fname $names {`
579			`if {![string compare . $fname]} {`
580			`continue`
581			`}`
582			`if {![string compare ".." $fname]} {`
583			`continue`
584			`}`
585			`if [file isdirectory $fname] {`
586			`if $showSubDir {`
587			`lappend list [file tail $fname]`
588			`}`
589			`} else {`
590			`if $showFile {`
591			`lappend list [file tail $fname]`
592			`}`
593			`}`
594			`}`
595			`}`
596			`cd $appPWD`
597
598			`if {$showSubDir && $showPrevDir && $dir != "/"} {`
599			`return [lsort [concat .. $list]]`
600			`} else {`
601			`return $list`
602			`}`
603			`}`
604
605			`proc tixVerifyFile {file} {`
606			`return [tixFileIntName $file]`
607			`}`
608
609			`proc tixFilePattern {args} {`
610			`if {[lsearch $args allFiles] != -1} {`
611			`return *`
612			`}`
613			`return *`
614			`}`
615
616			`}`
617
618			`# tixWinFileEmu --`
619			`#`
620			`# Emulates a MS Windows file system environemnt inside Unix`
621			`#`
622			`proc tixWinFileEmu {} {`
623			`cd /mnt/c`
624			`rename pwd __pwd`
625			`rename cd __cd`
626			`proc EmuConvert {path} {`
627			`if [regsub ^/mnt/c/ $path c:/ path] {`
628			`return $path`
629			`}`
630			`if [regsub ^/mnt/d/ $path d:/ path] {`
631			`return $path`
632			`}`
633			`if [regsub ^/mnt/c\$ $path c:/ path] {`
634			`return $path`
635			`}`
636			`if [regsub ^/mnt/d\$ $path d:/ path] {`
637			`return $path`
638			`}`
639			`return c:/windows`
640			`}`
641
642			`proc pwd {} {`
643			`return [EmuConvert [__pwd]]`
644			`}`
645			`proc glob {args} {`
646
647			`}`
648			`}`