[Gd-chatter] r10903 - trunk/fundev/sources/environment/win32

[hannes at gwydiondylan.org]

Author: hannes
Date: Tue Sep  5 19:34:17 2006
New Revision: 10903

Modified:
   trunk/fundev/sources/environment/win32/start.dylan
Log:
Job: fd
*support for /user-root command-line argument, which only sets
  OPEN_DYLAN_USER_ROOT, _INSTALL and _BUILD, preserving
  REGISTRIES and SOURCES
*debugging win32-environment with win32-environment is now easier,
  sources and registries can be used in both, but root, install and
  build must be set to somewhere else (which can be done via /user-root)

Modified: trunk/fundev/sources/environment/win32/start.dylan
==============================================================================
--- trunk/fundev/sources/environment/win32/start.dylan	(original)
+++ trunk/fundev/sources/environment/win32/start.dylan	Tue Sep  5 19:34:17 2006
@@ -25,7 +25,8 @@
 
 define method maybe-set-roots
     (#key personal-root :: false-or(<directory-locator>),
-          system-root :: false-or(<directory-locator>))
+          system-root :: false-or(<directory-locator>),
+          user-root :: false-or(<directory-locator>))
  => ()
   local method set-variable
             (variable :: <string>, directory :: <directory-locator>,
@@ -46,7 +47,16 @@
       let subdirectories = directory-info.tail;
       set-variable(variable, system-root, subdirectories)
     end
-  end
+  end;
+  if (user-root)
+    for (directory-info :: <list> in $personal-directories)
+      let variable       = directory-info.head;
+      let subdirectories = directory-info.tail;
+      if (~ any?(curry(\=, "sources"), subdirectories))
+        set-variable(variable, user-root, subdirectories)
+      end;
+    end;
+  end;
 end method maybe-set-roots;
 
 define method process-arguments
@@ -54,6 +64,7 @@
  => (filename :: false-or(<file-locator>))
   let personal-root = #f;
   let system-root   = #f;
+  let user-root     = #f;
   let filename      = #f;
   let arguments     = as(<deque>, arguments);
   while (~empty?(arguments))
@@ -61,7 +72,8 @@
     if (argument[0] == '/')
       select (copy-sequence(argument, start: 1) by \=)
         "personal" => personal-root := as(<directory-locator>, pop(arguments));
-        "system"   => system-root   := as(<directory-locator>, pop(arguments));
+        "user-root" => user-root    := as(<directory-locator>, pop(arguments));
+        "system" => system-root     := as(<directory-locator>, pop(arguments));
         otherwise  => #f;
       end
     else
@@ -77,7 +89,8 @@
   end;
   if (release-internal?())
     maybe-set-roots(personal-root: personal-root,
-                    system-root:   system-root)
+                    system-root:   system-root,
+                    user-root:     user-root)
   end;
   filename
 end method process-arguments;