|
@@ -541,14 +541,13 @@ module HighLevel = struct
|
|
lines
|
|
lines
|
|
|
|
|
|
(* Returns a list of contexts, but doesn't do anything yet *)
|
|
(* Returns a list of contexts, but doesn't do anything yet *)
|
|
- let process_params server_api create each_params has_display is_server pl =
|
|
|
|
- let curdir = Unix.getcwd () in
|
|
|
|
|
|
+ let process_params server_api create each_args has_display is_server args =
|
|
|
|
+ (* We want the loop below to actually see all the --each params, so let's prepend them *)
|
|
|
|
+ let args = !each_args @ args in
|
|
let added_libs = Hashtbl.create 0 in
|
|
let added_libs = Hashtbl.create 0 in
|
|
let server_mode = ref SMNone in
|
|
let server_mode = ref SMNone in
|
|
let create_context args =
|
|
let create_context args =
|
|
let ctx = create (server_api.on_context_create()) args in
|
|
let ctx = create (server_api.on_context_create()) args in
|
|
- (* --cwd triggers immediately, so let's reset *)
|
|
|
|
- Unix.chdir curdir;
|
|
|
|
ctx
|
|
ctx
|
|
in
|
|
in
|
|
let rec find_subsequent_libs acc args = match args with
|
|
let rec find_subsequent_libs acc args = match args with
|
|
@@ -559,16 +558,16 @@ module HighLevel = struct
|
|
in
|
|
in
|
|
let rec loop acc = function
|
|
let rec loop acc = function
|
|
| [] ->
|
|
| [] ->
|
|
- [],Some (create_context (!each_params @ (List.rev acc)))
|
|
|
|
|
|
+ [],Some (create_context (List.rev acc))
|
|
| "--next" :: l when acc = [] -> (* skip empty --next *)
|
|
| "--next" :: l when acc = [] -> (* skip empty --next *)
|
|
loop [] l
|
|
loop [] l
|
|
| "--next" :: l ->
|
|
| "--next" :: l ->
|
|
- let ctx = create_context (!each_params @ (List.rev acc)) in
|
|
|
|
|
|
+ let ctx = create_context (List.rev acc) in
|
|
ctx.has_next <- true;
|
|
ctx.has_next <- true;
|
|
l,Some ctx
|
|
l,Some ctx
|
|
| "--each" :: l ->
|
|
| "--each" :: l ->
|
|
- each_params := List.rev acc;
|
|
|
|
- loop [] l
|
|
|
|
|
|
+ each_args := List.rev acc;
|
|
|
|
+ loop acc l
|
|
| "--cwd" :: dir :: l | "-C" :: dir :: l ->
|
|
| "--cwd" :: dir :: l | "-C" :: dir :: l ->
|
|
(* we need to change it immediately since it will affect hxml loading *)
|
|
(* we need to change it immediately since it will affect hxml loading *)
|
|
(try Unix.chdir dir with _ -> raise (Arg.Bad ("Invalid directory: " ^ dir)));
|
|
(try Unix.chdir dir with _ -> raise (Arg.Bad ("Invalid directory: " ^ dir)));
|
|
@@ -591,14 +590,14 @@ module HighLevel = struct
|
|
loop acc l
|
|
loop acc l
|
|
| "--run" :: cl :: args ->
|
|
| "--run" :: cl :: args ->
|
|
let acc = cl :: "-x" :: acc in
|
|
let acc = cl :: "-x" :: acc in
|
|
- let ctx = create_context (!each_params @ (List.rev acc)) in
|
|
|
|
|
|
+ let ctx = create_context (List.rev acc) in
|
|
ctx.com.sys_args <- args;
|
|
ctx.com.sys_args <- args;
|
|
[],Some ctx
|
|
[],Some ctx
|
|
| ("-L" | "--library" | "-lib") :: name :: args ->
|
|
| ("-L" | "--library" | "-lib") :: name :: args ->
|
|
let libs,args = find_subsequent_libs [name] args in
|
|
let libs,args = find_subsequent_libs [name] args in
|
|
let libs = List.filter (fun l -> not (Hashtbl.mem added_libs l)) libs in
|
|
let libs = List.filter (fun l -> not (Hashtbl.mem added_libs l)) libs in
|
|
List.iter (fun l -> Hashtbl.add added_libs l ()) libs;
|
|
List.iter (fun l -> Hashtbl.add added_libs l ()) libs;
|
|
- let lines = add_libs libs pl server_api.cache has_display in
|
|
|
|
|
|
+ let lines = add_libs libs args server_api.cache has_display in
|
|
loop acc (lines @ args)
|
|
loop acc (lines @ args)
|
|
| ("--jvm" | "--java" | "-java" as arg) :: dir :: args ->
|
|
| ("--jvm" | "--java" | "-java" as arg) :: dir :: args ->
|
|
loop_lib arg dir "hxjava" acc args
|
|
loop_lib arg dir "hxjava" acc args
|
|
@@ -614,7 +613,7 @@ module HighLevel = struct
|
|
and loop_lib arg dir lib acc args =
|
|
and loop_lib arg dir lib acc args =
|
|
loop (dir :: arg :: acc) ("-lib" :: lib :: args)
|
|
loop (dir :: arg :: acc) ("-lib" :: lib :: args)
|
|
in
|
|
in
|
|
- let args,ctx = loop [] pl in
|
|
|
|
|
|
+ let args,ctx = loop [] args in
|
|
args,!server_mode,ctx
|
|
args,!server_mode,ctx
|
|
|
|
|
|
let execute_ctx server_api ctx server_mode =
|
|
let execute_ctx server_api ctx server_mode =
|
|
@@ -642,6 +641,7 @@ module HighLevel = struct
|
|
let entry server_api comm args =
|
|
let entry server_api comm args =
|
|
let create = create_context comm server_api.cache in
|
|
let create = create_context comm server_api.cache in
|
|
let each_args = ref [] in
|
|
let each_args = ref [] in
|
|
|
|
+ let curdir = Unix.getcwd () in
|
|
let has_display = ref false in
|
|
let has_display = ref false in
|
|
(* put --display in front if it was last parameter *)
|
|
(* put --display in front if it was last parameter *)
|
|
let args = match List.rev args with
|
|
let args = match List.rev args with
|
|
@@ -661,14 +661,18 @@ module HighLevel = struct
|
|
in
|
|
in
|
|
let code = match ctx with
|
|
let code = match ctx with
|
|
| Some ctx ->
|
|
| Some ctx ->
|
|
|
|
+ (* Need chdir here because --cwd is eagerly applied in process_params *)
|
|
|
|
+ Unix.chdir curdir;
|
|
execute_ctx server_api ctx server_mode
|
|
execute_ctx server_api ctx server_mode
|
|
| None ->
|
|
| None ->
|
|
(* caused by --connect *)
|
|
(* caused by --connect *)
|
|
0
|
|
0
|
|
in
|
|
in
|
|
- if code = 0 && args <> [] && not !has_display then
|
|
|
|
|
|
+ if code = 0 && args <> [] && not !has_display then begin
|
|
|
|
+ (* We have to chdir here again because any --cwd also takes effect in execute_ctx *)
|
|
|
|
+ Unix.chdir curdir;
|
|
loop args
|
|
loop args
|
|
- else
|
|
|
|
|
|
+ end else
|
|
code
|
|
code
|
|
in
|
|
in
|
|
let code = loop args in
|
|
let code = loop args in
|