/usr/share/tcltk/xotcl1.6.7-lib/make.xotcl is in xotcl 1.6.7-2.
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 | # $Id: make.xotcl,v 1.4 2006/09/27 08:12:40 neumann Exp $
### inEachDir changes now to each directory
### install clears tgarget directory before installing
### Object file added (for better -n processing)
#lappend auto_path ..
package require XOTcl 1
namespace import -force ::xotcl::*
###
Object make
#
# shared lib add files for pkgIndex.tcl
#
make proc mkIndex {name} {
#puts stderr "+++ mkIndex in [pwd]"
set fls {}
foreach f [glob -nocomplain *tcl] {
if {![file isdirectory $f]} {
set F [open $f]; set c [read $F]; close $F
if {[string match "*package provide*" $c]} { lappend fls $f }
}
}
set so [glob -nocomplain *[info sharedlibextension]]
# loading libxotcl into xotclsh crashes on some systems
foreach lib [list libxotcl$::xotcl::version[info sharedlibextension] \
xotcl$::xotcl::version.dll] {
set p [lsearch -exact $so $lib]
if {$p != -1} {
set so [lreplace $so $p $p]
#puts stderr "new so=<$so>"
}
}
#puts stderr "[pwd]: call so=<$so>"
set fls [concat $fls $so]
if {$fls ne ""} {
if {[file exists pkgIndex.tcl]} {
file delete -force pkgIndex.tcl
}
#puts stderr "callinglevel <[self callinglevel]> $fls"
#puts stderr "[pwd]:\n\tcall eval pkg_mkIndex -direct . $fls"
if {[catch {eval pkg_mkIndex -direct . $fls} errs]} {
puts stderr "!!! $errs"
}
#puts stderr "[pwd] done"
}
foreach addFile [glob -nocomplain *.add] {
if {[file exists $addFile]} {
puts stderr "Appending $addFile to pkgIndex.tcl in [pwd]"
set OUT [file open pkgIndex.tcl a]
set IN [file open $addFile]
puts -nonewline $OUT [read $IN]
close $IN; close $OUT
}
}
#puts stderr "+++ mkIndex name=$name, pwd=[pwd] DONE"
}
make proc inEachDir {path cmd} {
#puts stderr "[pwd] inEachDir $path [file isdirectory $path]"
if { [file isdirectory $path]
&& ![string match *CVS $path]
&& ![string match *SCCS $path]
&& ![string match *Attic $path]
&& ![string match *dbm* $path]
} {
set olddir [pwd]
cd $path
eval make $cmd $path
set files [glob -nocomplain *]
cd $olddir
foreach p $files { my inEachDir $path/$p $cmd }
#puts stderr "+++ change back to $olddir"
}
}
make proc in {path cmd} {
if {[file isdirectory $path] && ![string match *CVS $path]} {
set olddir [pwd]
cd $path
eval make $cmd $path
cd $olddir
}
}
### tcl file-command
rename file tcl_file
Object file -requireNamespace
rename open file::open
proc open {f {mode r}} { file open $f $mode }
#file proc open {f {mode r}} { ::open $f $mode }
file array set destructive {
atime 0 attributes 0 copy 1 delete 1 dirname 0
executable 0 exists 0 extension 0 isdirectory 0 isfile 0
join 0 lstat 0 mkdir 1 mtime 0 nativename 0
owned 0 pathtype 0 readable 0 readlink 0 rename 1
rootname 0 size 0 split 0 stat 0 tail 0
type 0 volumes 0 writable 0
}
foreach subcmd [file array names destructive] {
file proc $subcmd args {
#puts stderr " [pwd] call: '::tcl_file [self proc] $args'"
eval ::tcl_file [self proc] $args
}
}
### minus n option
Class make::-n
foreach f [file info commands] {
if {$f eq "unknown" || $f eq "next" || $f eq "self"} continue
if {![file exists destructive($f)] || [file set destructive($f)]} {
#puts stderr destruct=$f
make::-n instproc $f args {
puts "--- [pwd]:\t[self proc] $args"
}
} else {
#puts stderr nondestruct=$f
make::-n instproc $f args {
set r [next]
#puts "??? [self proc] $args -> {$r}"
return $r
}
}
}
### command line parameters
if {![info exists argv] || $argv eq ""} {set argv -all}
if {$argv eq "-n"} {set argv "-n -all"}
Class Script
Script proc create args {
eval lappend args $::argv
eval next $args
}
Script instproc unknown args {
puts stderr "$::argv0: Unknown option ´-$args´ provided"
}
Script instproc n {} {file mixin make::-n}
Script instproc all {} {
make inEachDir . mkIndex
}
Script instproc dir {dirName} {
cd $dirName
}
Script instproc target {path} {
make set target $path
}
Script create main
#puts stderr "+++ make.xotcl finished."
#if {[set ::tcl_platform(platform)] eq "windows"} {
# exit
#}
|