/usr/share/tcltk/tcl8.5/Tix8.4.3/fs.tcl is in tix 8.4.3-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 | # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
#
# $Id: fs.tcl,v 1.6 2004/03/28 02:44:57 hobbs Exp $
#
# File system routines to handle some file system variations
# and how that interoperates with the Tix widgets (mainly HList).
#
# Copyright (c) 2004 ActiveState
##
## Cross-platform
##
proc tixFSSep {} { return "/" }
proc tixFSNormalize {path} {
# possibly use tixFSTilde ?
return [file normalize $path]
}
proc tixFSVolumes {} {
return [file volumes]
}
proc tixFSAncestors {path} {
return [file split [file normalize $path]]
}
# how a filename should be displayed
proc tixFSDisplayFileName {path} {
if {$path eq [file dirname $path]} {
return $path
} else {
return [file tail $path]
}
}
# 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?
#
# return value: a list of files and/or subdirectories
#
proc tixFSListDir {dir showSubDir showFile showPrevDir \
showHidden {pattern ""}} {
if {$pattern eq ""} { set pattern [list "*"] }
if {$::tcl_platform(platform) eq "unix"
&& $showHidden && $pattern eq "*"} { lappend pattern ".*" }
if {[catch {eval [list glob -nocomplain -directory $dir] \
$pattern} files]} {
# The user has entered an invalid or unreadable directory
# %% todo: prompt error, go back to last succeed directory
return ""
}
set list ""
foreach f [lsort -dictionary $files] {
set tail [file tail $f]
# file tail handles this automatically
#if {[string match ~* $tail]} { set tail ./$tail }
if {[file isdirectory $f]} {
if {$tail eq "."} { continue }
if {$showSubDir} {
if {$tail eq ".." && !$showPrevDir} { continue }
lappend list $tail
}
} else {
if {$showFile} { lappend list $tail }
}
}
return $list
}
# in: internal name
# out: native name
proc tixFSNativeNorm {path} {
return [tixFSNative [tixFSNormalize $path]]
}
# tixFSDisplayName --
#
# Returns the name of a normalized path which is usually displayed by
# the OS
#
proc tixFSDisplayName {path} {
return [tixFSNative $path]
}
proc tixFSTilde {path} {
# verify that paths with leading ~ are files or real users
if {[string match ~* $path]} {
# The following will report if the user doesn't exist
if {![file isdirectory $path]} {
set path ./$path
} else {
set path [file normalize $path]
}
}
return $path
}
proc tixFSJoin {dir sub} {
return [tixFSNative [file join $dir [tixFSTilde $sub]]]
}
proc tixFSNative {path} {
return $path
}
if {$::tcl_platform(platform) eq "windows"} {
##
## WINDOWS
##
# is an absoulte path only if it starts with a baclskash
# or starts with "<drive letter>:"
#
# in: nativeName
#
proc tixFSIsAbsPath {nativeName} {
set ptype [file pathtype $nativename]
return [expr {$ptype eq "absolute" || $ptype eq "volumerelative"}]
}
# tixFSIsValid --
#
# Checks whether a native pathname contains invalid characters.
#
proc tixFSIsValid {path} {
#if {$::tcl_platform(platform) eq "windows"} {set bad "\\/:*?\"<>|\0"}
return 1
}
proc tixFSExternal {path} {
# Avoid normalization on root adding unwanted volumerelative pwd
if {[string match -nocase {[A-Z]:} $path]} {
return $path/
}
return [file normalize $path]
}
proc tixFSInternal {path} {
# Only need to watch for ^[A-Z]:/$, but this does the trick
return [string trimright [file normalize $path] /]
}
} else {
##
## UNIX
##
proc tixFSIsAbsPath {path} {
return [string match {[~/]*} $path]
}
# tixFSIsValid --
#
# Checks whether a native pathname contains invalid characters.
#
proc tixFSIsValid {path} { return 1 }
proc tixFSExternal {path} { return $path }
proc tixFSInternal {path} { return $path }
}
|