# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1324145423 18000
# Node ID e374b6b8ab3844f07b7e4988dafe85d4521fff7e
# Parent  2b312f6d4007465b627c4d552e3a374f61f15f36
Allow .urp libraries to set prefix

diff -r 2b312f6d4007 -r e374b6b8ab38 src/compiler.sml
--- a/src/compiler.sml	Sat Dec 17 12:01:31 2011 -0500
+++ b/src/compiler.sml	Sat Dec 17 13:10:23 2011 -0500
@@ -500,7 +500,7 @@
                           | OnlyComment => readSources acc
                           | EndOfFile => rev acc
 
-                    val prefix = ref (case Settings.getUrlPrefix () of "/" => NONE | s => SOME s)
+                    val prefix = ref (case Settings.getUrlPrefixFull () of "/" => NONE | s => SOME s)
                     val database = ref (Settings.getDbstring ())
                     val exe = ref (Settings.getExe ())
                     val sql = ref (Settings.getSql ())
@@ -580,7 +580,16 @@
                                                         x))
 
                             fun merge (old : job, new : job) = {
-                                prefix = #prefix old,
+                                prefix = case #prefix old of
+                                             "/" => #prefix new
+                                           | pold => case #prefix new of
+                                                         "/" => pold
+                                                       | pnew => (if pold = pnew then
+                                                                      ()
+                                                                  else
+                                                                      ErrorMsg.error ("Multiple prefix values that don't agree: "
+                                                                                      ^ pold ^ ", " ^ pnew);
+                                                                  pold),
                                 database = mergeO (fn (old, _) => old) (#database old, #database new),
                                 exe = #exe old,
                                 sql = #sql old,
diff -r 2b312f6d4007 -r e374b6b8ab38 src/settings.sig
--- a/src/settings.sig	Sat Dec 17 12:01:31 2011 -0500
+++ b/src/settings.sig	Sat Dec 17 13:10:23 2011 -0500
@@ -36,6 +36,10 @@
     val setUrlPrefix : string -> unit
     val getUrlPrefix : unit -> string
     val getUrlPrePrefix : unit -> string
+    val getUrlPrefixFull : unit -> string
+    (* The full prefix is the value that was set explicitly, while the "pre"
+     * prefix gets the protocol/host/port part and the unqualified prefix gets
+     * the URI. *)
 
     (* How many seconds should the server wait before assuming a Comet client has left? *)
     val setTimeout : int -> unit
diff -r 2b312f6d4007 -r e374b6b8ab38 src/settings.sml
--- a/src/settings.sml	Sat Dec 17 12:01:31 2011 -0500
+++ b/src/settings.sml	Sat Dec 17 13:10:23 2011 -0500
@@ -27,12 +27,14 @@
 
 structure Settings :> SETTINGS = struct
 
+val urlPrefixFull = ref "/"
 val urlPrefix = ref "/"
 val urlPrePrefix = ref ""
 val timeout = ref 0
 val headers = ref ([] : string list)
 val scripts = ref ([] : string list)
 
+fun getUrlPrefixFull () = !urlPrefixFull
 fun getUrlPrefix () = !urlPrefix
 fun getUrlPrePrefix () = !urlPrePrefix
 fun setUrlPrefix p =
@@ -62,6 +64,7 @@
             else
                 ("", prefix)
     in
+        urlPrefixFull := p;
         urlPrePrefix := prepre;
         urlPrefix := prefix
     end