summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2011-12-17 13:10:23 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2011-12-17 13:10:23 -0500
commit800bdda2d12eaf2524d8464e66d23642f700f048 (patch)
treed66971cb868f768b134688c152b281c7850c46e2
parentc9b985223bc94657127b48fa3370bff4ea6ed5f3 (diff)
Allow .urp libraries to set prefix
-rw-r--r--src/compiler.sml13
-rw-r--r--src/settings.sig4
-rw-r--r--src/settings.sml3
3 files changed, 18 insertions, 2 deletions
diff --git a/src/compiler.sml b/src/compiler.sml
index 1318b561..2a890f32 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -500,7 +500,7 @@ fun parseUrp' accLibs fname =
| 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 @@ fun parseUrp' accLibs fname =
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 --git a/src/settings.sig b/src/settings.sig
index 8f82c8a5..26e220fd 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -36,6 +36,10 @@ signature SETTINGS = sig
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 --git a/src/settings.sml b/src/settings.sml
index 02fd3c10..b421f38a 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -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 @@ fun setUrlPrefix p =
else
("", prefix)
in
+ urlPrefixFull := p;
urlPrePrefix := prepre;
urlPrefix := prefix
end