/usr/share/tcltk/xotcl1.6.7-lib/package.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: package.xotcl,v 1.7 2006/09/27 08:12:40 neumann Exp $
package provide xotcl::package 0.91
package require xotcl::mixinStrategy
package require XOTcl
rename package tcl_package
namespace eval ::xotcl::package {
namespace import ::xotcl::*
@ @File {description {
Represent Tcl package loading command by an XOTcl
object. Enables tracking, tracing, and verbose output
of package loading
}
}
@ Object package {
description {
Supports all Tcl package options plus present and verbose.
}
}
@ package proc present {args "packageName or -exact packageName"} {
description {
Check whether a package is present or not. Similar to Tcl's
package present, but works with Tcl < 8.3
}
}
@ package proc verbose {v "1 or 0"} {
description {
Toggle verbose output on/off. If on, package prints the locations
from where packages are loaded to the screen. Default is off.
}
}
Object package
package set component .
package set verbose 0
package proc unknown args {
#puts stderr "unknown: package $args"
namespace eval :: tcl_package $args
}
package proc verbose value {
my set verbose $value
}
package proc present args {
if {$::tcl_version<8.3} {
my instvar loaded
switch -exact -- [lindex $args 0] {
-exact {set pkg [lindex $args 1]}
default {set pkg [lindex $args 0]}
}
if {[info exists loaded($pkg)]} {
return $loaded($pkg)
} else {
error "not found"
}
} else {
namespace eval :: tcl_package present $args
}
}
package proc require args {
my instvar component verbose uses loaded
set prevComponent $component
if {[catch {set v [eval package present $args]} msg]} {
#puts stderr "we have to load $msg"
switch -exact -- [lindex $args 0] {
-exact {set pkg [lindex $args 1]}
default {set pkg [lindex $args 0]}
}
set component $pkg
lappend uses($prevComponent) $component
set v [namespace eval :: tcl_package require $args]
if {$v ne "" && $verbose} {
set path [lindex [tcl_package ifneeded $pkg $v] 1]
puts "... $pkg $v loaded from '$path'"
set loaded($pkg) $v ;# loaded stuff needed for Tcl 8.0
}
}
set component $prevComponent
return $v
}
Object package::tracker
package::tracker set verbose 0
package::tracker proc storeEntry {table index} {
my instvar verbose $table
set ${table}($index) "[package set component] [info script]"
if {$verbose} {
puts "... $table $index loaded from [info script]"
}
}
package::tracker proc dump {} {
my instvar class object instproc proc
if {[info exist class]} { parray class }
if {[info exist object]} { parray object }
if {[info exist instproc]} { parray instproc }
if {[info exist proc]} { parray proc }
}
package::tracker proc start {} {
::Class add mixin [self]::M
::Object add mixin [self]::M
}
Class package::tracker::M
package::tracker::M instproc create {cls args} {
set table [string tolower [string trimleft [self] :]]
package::tracker storeEntry $table [lindex $args 0]
next
$cls add mixin [self class]
}
package::tracker::M instproc instproc args {
package::tracker storeEntry instproc [self]->[lindex $args 0]
next
}
package::tracker::M instproc proc args {
package::tracker storeEntry proc [self]->[lindex $args 0]
next
}
#package::tracker set verbose 1
#package::tracker start
#
#Class A
#A instproc p args {
# puts A
#}
#A proc pp args {
# a call
#}
#Object o
#o proc ppp args {
# another call
#}
#puts stderr ====================================================
#package::tracker dump
#puts stderr AUTO_PATH=$auto_path.
namespace export package
namespace eval package {
namespace export tracker
namespace eval tracker {
namespace export M
}
}
}
namespace import ::xotcl::package::*
namespace eval package {
namespace import ::xotcl::package::package::*
namespace eval tracker {
namespace import ::xotcl::package::package::tracker::*
}
}
|