From 4a327a6afdf45b23c8606d5f3d5a51b2b7876384 Mon Sep 17 00:00:00 2001 From: welch Date: Thu, 11 Mar 1999 06:16:37 +0000 Subject: Added tcl_platform --- changes | 5 ++++- doc/tclvars.n | 8 +++++++- mac/tclMacInit.c | 19 ++++++++++++++++++- tests/platform.test | 20 ++++++++++++++++++++ unix/tclUnixInit.c | 21 +++++++++++++++++++-- win/tclWinInit.c | 17 ++++++++++++----- 6 files changed, 80 insertions(+), 10 deletions(-) create mode 100644 tests/platform.test diff --git a/changes b/changes index 52ecee9..ee1ca3c 100644 --- a/changes +++ b/changes @@ -1,6 +1,6 @@ Recent user-visible changes to Tcl: -RCS: @(#) $Id: changes,v 1.1.2.18 1999/02/10 23:31:10 stanton Exp $ +RCS: @(#) $Id: changes,v 1.1.2.19 1999/03/11 06:16:37 welch Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. @@ -4117,3 +4117,6 @@ renaming Tcl_EvalObj to Tcl_EvalObjEx, renaming Tcl_Eval2 to Tcl_EvalEx and restoring Tcl_EvalObj and Tcl_GlobalEvalObj interfaces so they match Tcl 8.0. (stanton) *** POTENTIAL INCOMPATIBILITY with previous alpha/beta releases *** + +3/9/99 (new feature) Added tcl_platform(user) to provide a portable +way to get the name of the current user. (welch) diff --git a/doc/tclvars.n b/doc/tclvars.n index 8acf8ea..f8c9381 100644 --- a/doc/tclvars.n +++ b/doc/tclvars.n @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: tclvars.n,v 1.1.2.1 1998/09/24 23:58:37 stanton Exp $ +'\" RCS: @(#) $Id: tclvars.n,v 1.1.2.2 1999/03/11 06:16:46 welch Exp $ '\" .so man.macros .TH tclvars n 8.0 Tcl "Tcl Built-In Commands" @@ -269,6 +269,12 @@ On UNIX machines, this is the value returned by \fBuname -r\fR. \fBplatform\fR Either \fBwindows\fR, \fBmacintosh\fR, or \fBunix\fR. This identifies the general operating environment of the machine. +.TP +\fBuser\fR +Either \fBwindows\fR, \fBmacintosh\fR, or \fBunix\fR. This identifies the +current user based on the login information available on the platform. +This comes from the USER or LOGNAME environment variable on Unix, +and the value from GetUserName on Windows and Macintosh. .RE .TP \fBtcl_precision\fR diff --git a/mac/tclMacInit.c b/mac/tclMacInit.c index 9c34c91..82c68f1 100644 --- a/mac/tclMacInit.c +++ b/mac/tclMacInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacInit.c,v 1.1.2.3 1999/02/10 23:31:22 stanton Exp $ + * RCS: @(#) $Id: tclMacInit.c,v 1.1.2.4 1999/03/11 06:16:47 welch Exp $ */ #include @@ -498,6 +498,7 @@ TclpSetVariables(interp) char versStr[2 * TCL_INTEGER_SPACE]; char *str; Tcl_Obj *pathPtr; + Tcl_DString ds; str = "no library"; pathPtr = TclGetLibraryPath(); @@ -527,6 +528,22 @@ TclpSetVariables(interp) #else Tcl_SetVar2(interp, "tcl_platform", "machine", "68k", TCL_GLOBAL_ONLY); #endif + + /* + * Copy USER or LOGIN environment variable into tcl_platform(user) + * These are set by SystemVariables in tclMacEnv.c + */ + + Tcl_DStringInit(&ds); + str = TclGetEnv("USER", &ds); + if (str == NULL) { + str = TclGetEnv("LOGIN", &ds); + if (str == NULL) { + str = ""; + } + } + Tcl_SetVar2(interp, "tcl_platform", "user", str, TCL_GLOBAL_ONLY); + Tcl_DStringFree(&ds); } /* diff --git a/tests/platform.test b/tests/platform.test new file mode 100644 index 0000000..e3c78ef --- /dev/null +++ b/tests/platform.test @@ -0,0 +1,20 @@ +# The file tests the tcl_platform variable +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1999 by Scriptics Corporation +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) + +if {[info procs test] != "test"} {source defs} + +test platform-1.1 {TclpSetVariables: tcl_platform} { + lsort [array names tcl_platform] +} {byteOrder machine os osVersion platform user} + +return diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 60cea60..502e19f 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixInit.c,v 1.1.2.6 1999/03/10 06:49:28 stanton Exp $ + * RCS: @(#) $Id: tclUnixInit.c,v 1.1.2.7 1999/03/11 06:16:50 welch Exp $ */ #include "tclInt.h" @@ -438,6 +438,8 @@ TclpSetVariables(interp) struct utsname name; #endif int unameOK; + char *user; + Tcl_DString ds; Tcl_SetVar(interp, "tcl_library", defaultLibraryDir, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY); @@ -445,7 +447,6 @@ TclpSetVariables(interp) unameOK = 0; #ifndef NO_UNAME if (uname(&name) >= 0) { - Tcl_DString ds; char *native; unameOK = 1; @@ -483,6 +484,22 @@ TclpSetVariables(interp) Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY); } + + /* + * Copy USER or LOGNAME environment variable into tcl_platform(user) + */ + + Tcl_DStringInit(&ds); + user = TclGetEnv("USER", &ds); + if (user == NULL) { + user = TclGetEnv("LOGNAME", &ds); + if (user == NULL) { + user = ""; + } + } + Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY); + Tcl_DStringFree(&ds); + } /* diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 5d13a8d..d9ea943 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinInit.c,v 1.1.2.6 1999/03/11 01:50:33 stanton Exp $ + * RCS: @(#) $Id: tclWinInit.c,v 1.1.2.7 1999/03/11 06:16:51 welch Exp $ */ #include "tclWinInt.h" @@ -498,6 +498,7 @@ TclpSetVariables(interp) SYSTEM_INFO sysInfo; OemId *oemId; OSVERSIONINFOA osInfo; + Tcl_DString ds; osInfo.dwOSVersionInfoSize = sizeof(osInfo); GetVersionExA(&osInfo); @@ -548,11 +549,9 @@ TclpSetVariables(interp) * environment variables, if necessary. */ + Tcl_DStringInit(&ds); ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY); if (ptr == NULL) { - Tcl_DString ds; - - Tcl_DStringInit(&ds); ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY); if (ptr != NULL) { Tcl_DStringAppend(&ds, ptr, -1); @@ -567,8 +566,16 @@ TclpSetVariables(interp) } else { Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); } - Tcl_DStringFree(&ds); } + + Tcl_DStringSetLength(&ds, 100); + if (GetUserName(Tcl_DStringValue(&ds), &Tcl_DStringLength(&ds)) != 0) { + Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds), + TCL_GLOBAL_ONLY); + } else { + Tcl_SetVar2(interp, "tcl_platform", "user", "", TCL_GLOBAL_ONLY); + } + Tcl_DStringFree(&ds); } /* -- cgit v0.12