/usr/share/tcltk/nsf-xotcl2/lib/package.xotcl is in nsf 2.0.0-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 | # -*- Tcl -*-
package provide xotcl::package 2.0
package require XOTcl 2.0
package require xotcl::mixinStrategy
# if pgk_mkIndex is running, there is a conflict with the
# new command package provided here. We can detect when
# pkg_mkIndex is running by checking for the namespace variable
# ::tcl::file.
if {![info exists ::tcl::file]} {
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.
}
}
set package_obj [Object create package]
$package_obj set component .
$package_obj set verbose 0
$package_obj proc unknown args {
#puts stderr "unknown: package $args"
namespace eval :: tcl_package $args
}
$package_obj proc verbose value {
my set verbose $value
}
$package_obj proc present args {
namespace eval :: tcl_package present $args
}
$package_obj 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 create 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 create 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::*
}
}
|