From: Jean-Claude Wippler <jcw@equi4.com>
Date: Sun, 28 Sep 2003 10:40:32 +0000 (+0000)
Subject: added some procs to starkit pkg
X-Git-Tag: vfs-1-3~5
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=c0f2ec0be8fd6c0b14b0160f960b7261562573bd;p=tclvfs

added some procs to starkit pkg
---

diff --git a/ChangeLog b/ChangeLog
index 5164da7..a844472 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2003-09-28  Jean-Claude Wippler  <jcw@equi4.com>
+
+	* starkit.tcl: added "package" and "pload" procs, to simplify
+	loading compiled extensions from a platform-specific subdir.
+	The naming conventions and code were adopted from Critcl.
+
 2003-09-26  Jean-Claude Wippler  <jcw@equi4.com>
 
 	* starkit.tcl: add file normalize around info nameofexe, fixes
diff --git a/library/starkit.tcl b/library/starkit.tcl
index 4c43728..1f9fa34 100644
--- a/library/starkit.tcl
+++ b/library/starkit.tcl
@@ -106,4 +106,39 @@ namespace eval starkit {
 	}
 	exit
     }
+
+    # the following proc was copied from the critcl package:
+
+    # return a platform designator, including both OS and machine
+    #
+    # only use first element of $tcl_platform(os) - we don't care
+    # whether we are on "Windows NT" or "Windows XP" or whatever
+    #
+    # transforms $tcl_platform(machine) for some special cases
+    #  - on SunOS, matches for sun4* are transformed to sparc
+    #  - on all OS's matches for intel and i*86* are transformed to x86
+    #  - on MacOS X "Power Macintosh" is transformed to ppc
+    #
+    proc platform {} {
+        global tcl_platform
+        set plat [lindex $tcl_platform(os) 0]
+        set mach $tcl_platform(machine)
+        switch -glob -- $mach {
+            sun4* { set mach sparc }
+            intel -
+            i*86* { set mach x86 }
+            "Power Macintosh" { set mach ppc }
+        }
+	switch -- $plat {
+	  AIX   { set mach ppc }
+	  HP-UX { set mach hppa }
+	}
+        return "$plat-$mach"
+    }
+
+    # load extension from a platform-specific subdirectory
+    proc pload {dir name args} {
+      set f [file join $dir [platform] $name[info sharedlibext]]
+      uplevel 1 [linsert $args 0 load $f]
+    }
 }