source: trunk/base/src/macports1.0/macports_fastload.tcl.in @ 65055

Last change on this file since 65055 was 65055, checked in by jmr@…, 11 years ago

install macports1.0 next to the other Tcl packages and just put a link in the Tcl package dir if possible (#12943)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 3.4 KB
Line 
1# macports_fastload.tcl.in
2# $Id: macports_fastload.tcl.in 65055 2010-03-20 14:28:09Z jmr@macports.org $
3#
4# Copyright (c) 2004 Paul Guyot, The MacPorts Project.
5# All rights reserved.
6#
7# Redistribution and use in source and binary forms, with or without
8# modification, are permitted provided that the following conditions
9# are met:
10# 1. Redistributions of source code must retain the above copyright
11#    notice, this list of conditions and the following disclaimer.
12# 2. Redistributions in binary form must reproduce the above copyright
13#    notice, this list of conditions and the following disclaimer in the
14#    documentation and/or other materials provided with the distribution.
15# 3. Neither the name of Apple Computer, Inc. nor the names of its contributors
16#    may be used to endorse or promote products derived from this software
17#    without specific prior written permission.
18#
19# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
20# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
21# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
22# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
23# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
24# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
25# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
26# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
27# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
28# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
29# POSSIBILITY OF SUCH DAMAGE.
30#
31
32# This script is here to fast load all the MacPorts related packages.
33# This avoids the very expensive globbing of Tcl' package mechanism.
34# Please note that this is not required and base/ should work even if some
35# packages are moved as long as their new location is in Tcl's package paths.
36# However, this file also defines a workaround to avoid conflicts between a /
37# installation of MacPorts and a user installation of MacPorts (on the same box).
38# (this workaround isn't required on 10.4.2).
39#
40# The package command that's replaced in this code works somewhat differently
41# than the original version. In particular, users with multiple copies of a
42# package such as portuninstall (due to obsolete files being left from previous
43# installations) may experience problems due to different package loading
44# behavior.
45#
46if { [regexp {\d+\.\d+\.\d+} [info patchlevel]] &&
47        ([package vcompare [info patchlevel] 8.4.7] < 0) } {
48        global allpackages
49        if {![info exists allpackages]} {
50                # Only patch once.
51                array set allpackages {}
52                rename package package_native
53                proc package {args} {
54                                global allpackages
55                                if {([lindex $args 0] == "ifneeded") && ([llength $args] == 4)} {
56                                                set package_name [lindex $args 1]
57                                                set package_version [lindex $args 2]
58                                                set package_key ${package_name}::${package_version}
59                                                if {![info exists allpackages($package_key)]} {
60                                                                set allpackages($package_key) 1
61                                                                set result [eval package_native $args]
62                                                } else {
63                                                                set result ""
64                                                }
65                                } else {
66                                                set result [eval package_native $args]
67                                }
68                                return $result
69                }
70        }
71}
72
73set sharetcldir "@macports_tcl_dir@"
74if {[file exists $sharetcldir]} {
75        foreach dir [glob -directory $sharetcldir *] {
76                catch {source [file join $dir pkgIndex.tcl]}
77        }
78}
79
80if { "@SQLITE3_TCL_DIR@" != "" } {
81        set dir "@SQLITE3_TCL_DIR@"
82        catch {source [file join $dir pkgIndex.tcl]}
83}
Note: See TracBrowser for help on using the repository browser.