initial checkin of environment

diff --git a/basis/environment/authors.txt b/basis/environment/authors.txt
new file mode 100644 (file)
index 0000000..b4bd0e7
--- /dev/null
+++ b/basis/environment/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file

diff --git a/basis/environment/environment-docs.factor b/basis/environment/environment-docs.factor
new file mode 100644 (file)
index 0000000..e539b44
--- /dev/null
+++ b/basis/environment/environment-docs.factor
@@ -0,0 +1,68 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs help.markup help.syntax io.streams.string sequences strings ;
+IN: environment
+
+HELP: (os-envs)
+{ $values
+    
+     { "seq" sequence } }
+{ $description "" } ;
+
+HELP: (set-os-envs)
+{ $values
+     { "seq" sequence } }
+{ $description "" } ;
+
+
+HELP: os-env ( key -- value )
+{ $values { "key" string } { "value" string } }
+{ $description "Looks up the value of a shell environment variable." }
+{ $examples
+    "This is an operating system-specific feature. On Unix, you can do:"
+    { $unchecked-example "\"USER\" os-env print" "jane" }
+} ;
+
+HELP: os-envs
+{ $values { "assoc" "an association mapping strings to strings" } }
+{ $description "Outputs the current set of environment variables." }
+{ $notes
+    "Names and values of environment variables are operating system-specific."
+} ;
+
+HELP: set-os-envs
+{ $values { "assoc" "an association mapping strings to strings" } }
+{ $description "Replaces the current set of environment variables." }
+{ $notes
+    "Names and values of environment variables are operating system-specific. Windows NT allows values up to 32766 characters in length."
+} ;
+
+HELP: set-os-env ( value key -- )
+{ $values { "value" string } { "key" string } }
+{ $description "Set an environment variable." }
+{ $notes
+    "Names and values of environment variables are operating system-specific."
+} ;
+
+HELP: unset-os-env ( key -- )
+{ $values { "key" string } }
+{ $description "Unset an environment variable." }
+{ $notes
+    "Names and values of environment variables are operating system-specific."
+} ;
+
+{ os-env os-envs set-os-env unset-os-env set-os-envs } related-words
+
+
+ARTICLE: "environment" "Environment variables"
+"The " { $vocab-link "environment" } " vocabulary interfaces to the platform-dependent mechanism for setting environment variables." $nl
+"Windows CE has no concept of environment variables, so these words are undefined on that platform." $nl
+"Reading environment variables:"
+{ $subsection os-env }
+{ $subsection os-envs }
+"Writing environment variables:"
+{ $subsection set-os-env }
+{ $subsection unset-os-env }
+{ $subsection set-os-envs } ;
+
+ABOUT: "environment"

diff --git a/basis/environment/environment-tests.factor b/basis/environment/environment-tests.factor
new file mode 100644 (file)
index 0000000..3717303
--- /dev/null
+++ b/basis/environment/environment-tests.factor
@@ -0,0 +1,29 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces prettyprint system tools.test
+environment strings sequences ;
+IN: environment.tests
+
+os wince? [
+    [ ] [ os-envs . ] unit-test
+
+    os unix? [
+        [ ] [ os-envs "envs" set ] unit-test
+        [ ] [ { { "A" "B" } } set-os-envs ] unit-test
+        [ "B" ] [ "A" os-env ] unit-test
+        [ ] [ "envs" get set-os-envs ] unit-test
+        [ t ] [ os-envs "envs" get = ] unit-test
+    ] when
+
+    [ ] [ "factor-test-key-1" unset-os-env ] unit-test
+    [ ] [ "ps3" "factor-test-key-1" set-os-env ] unit-test
+    [ "ps3" ] [ "factor-test-key-1" os-env ] unit-test
+    [ ] [ "factor-test-key-1" unset-os-env ] unit-test
+    [ f ] [ "factor-test-key-1" os-env ] unit-test
+
+    [ ] [
+        32766 CHAR: a <string> "factor-test-key-long" set-os-env
+    ] unit-test
+    [ 32766 ] [ "factor-test-key-long" os-env length ] unit-test
+    [ ] [ "factor-test-key-long" unset-os-env ] unit-test
+] unless

diff --git a/basis/environment/environment.factor b/basis/environment/environment.factor
new file mode 100644 (file)
index 0000000..492925c
--- /dev/null
+++ b/basis/environment/environment.factor
@@ -0,0 +1,27 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs combinators kernel sequences splitting system
+vocabs.loader ;
+IN: environment
+
+HOOK: os-env os ( key -- value )
+
+HOOK: set-os-env os ( value key -- )
+
+HOOK: unset-os-env os ( key -- )
+
+HOOK: (os-envs) os ( -- seq )
+
+HOOK: (set-os-envs) os ( seq -- )
+
+: os-envs ( -- assoc )
+    (os-envs) [ "=" split1 ] H{ } map>assoc ;
+
+: set-os-envs ( assoc -- )
+    [ "=" swap 3append ] { } assoc>map (set-os-envs) ;
+
+{
+    { [ os unix? ] [ "environment.unix" require ] }
+    { [ os winnt? ] [ "environment.winnt" require ] }
+    { [ os wince? ] [ ] }
+} cond

diff --git a/basis/environment/summary.txt b/basis/environment/summary.txt
new file mode 100644 (file)
index 0000000..24d14cb
--- /dev/null
+++ b/basis/environment/summary.txt
@@ -0,0 +1 @@
+Environment variables

diff --git a/basis/environment/unix/authors.txt b/basis/environment/unix/authors.txt
new file mode 100644 (file)
index 0000000..b4bd0e7
--- /dev/null
+++ b/basis/environment/unix/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file

diff --git a/basis/environment/unix/macosx/authors.txt b/basis/environment/unix/macosx/authors.txt
new file mode 100644 (file)
index 0000000..b4bd0e7
--- /dev/null
+++ b/basis/environment/unix/macosx/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file

diff --git a/basis/environment/unix/macosx/macosx-tests.factor b/basis/environment/unix/macosx/macosx-tests.factor
new file mode 100644 (file)
index 0000000..56a69fc
--- /dev/null
+++ b/basis/environment/unix/macosx/macosx-tests.factor
@@ -0,0 +1,4 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test environment.unix.macosx ;
+IN: environment.unix.macosx.tests

diff --git a/basis/environment/unix/macosx/macosx.factor b/basis/environment/unix/macosx/macosx.factor
new file mode 100644 (file)
index 0000000..51cee7b
--- /dev/null
+++ b/basis/environment/unix/macosx/macosx.factor
@@ -0,0 +1,8 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax system environment.unix ;
+IN: environment.unix.macosx
+
+FUNCTION: void* _NSGetEnviron ( ) ;
+
+M: macosx environ _NSGetEnviron ;

diff --git a/basis/environment/unix/macosx/tags.txt b/basis/environment/unix/macosx/tags.txt
new file mode 100644 (file)
index 0000000..6bf6830
--- /dev/null
+++ b/basis/environment/unix/macosx/tags.txt
@@ -0,0 +1 @@
+unportable

diff --git a/basis/environment/unix/tags.txt b/basis/environment/unix/tags.txt
new file mode 100644 (file)
index 0000000..6bf6830
--- /dev/null
+++ b/basis/environment/unix/tags.txt
@@ -0,0 +1 @@
+unportable

diff --git a/basis/environment/unix/unix.factor b/basis/environment/unix/unix.factor
new file mode 100644 (file)
index 0000000..c2dddc2
--- /dev/null
+++ b/basis/environment/unix/unix.factor
@@ -0,0 +1,29 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types alien.strings alien.syntax kernel
+layouts sequences system unix environment io.encodings.utf8
+unix.utilities vocabs.loader combinators alien.accessors ;
+IN: environment.unix
+
+HOOK: environ os ( -- void* )
+
+M: unix environ ( -- void* ) "environ" f dlsym ;
+
+M: unix os-env ( key -- value ) getenv ;
+
+M: unix set-os-env ( value key -- ) swap 1 setenv io-error ;
+
+M: unix unset-os-env ( key -- ) unsetenv io-error ;
+
+M: unix (os-envs) ( -- seq )
+    environ *void* utf8 alien>strings ;
+
+: set-void* ( value alien -- ) 0 set-alien-cell ;
+
+M: unix (set-os-envs) ( seq -- )
+    utf8 strings>alien malloc-byte-array environ set-void* ;
+
+os {
+    { macosx [ "environment.unix.macosx" require ] }
+    [ drop ]
+} case

diff --git a/basis/environment/winnt/authors.txt b/basis/environment/winnt/authors.txt
new file mode 100644 (file)
index 0000000..b4bd0e7
--- /dev/null
+++ b/basis/environment/winnt/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file

diff --git a/basis/environment/winnt/tags.txt b/basis/environment/winnt/tags.txt
new file mode 100644 (file)
index 0000000..6bf6830
--- /dev/null
+++ b/basis/environment/winnt/tags.txt
@@ -0,0 +1 @@
+unportable

diff --git a/basis/environment/winnt/winnt.factor b/basis/environment/winnt/winnt.factor
new file mode 100644 (file)
index 0000000..e73db5c
--- /dev/null
+++ b/basis/environment/winnt/winnt.factor
@@ -0,0 +1,25 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.strings fry io.encodings.utf16 kernel
+splitting windows windows.kernel32 ;
+IN: environment.winnt
+
+M: winnt os-env ( key -- value )
+    MAX_UNICODE_PATH "TCHAR" <c-array>
+    [ GetEnvironmentVariable ] keep over 0 = [
+        2drop f
+    ] [
+        nip utf16 alien>string
+    ] if ;
+
+M: winnt set-os-env ( value key -- )
+    swap SetEnvironmentVariable win32-error=0/f ;
+
+M: winnt unset-os-env ( key -- )
+    f SetEnvironmentVariable 0 = [
+        GetLastError ERROR_ENVVAR_NOT_FOUND =
+        [ win32-error ] unless
+    ] when ;
+
+M: winnt (os-envs) ( -- seq )
+    GetEnvironmentStrings [ "\0" split ] [ FreeEnvironmentStrings ] bi ;