summaryrefslogtreecommitdiffstats
path: root/otherlibs/labltk/browser
diff options
context:
space:
mode:
Diffstat (limited to 'otherlibs/labltk/browser')
-rw-r--r--otherlibs/labltk/browser/Makefile.nt10
-rw-r--r--otherlibs/labltk/browser/fileselect.mli3
-rw-r--r--otherlibs/labltk/browser/setpath.ml2
-rw-r--r--otherlibs/labltk/browser/shell.ml35
-rw-r--r--otherlibs/labltk/browser/winmain.c6
5 files changed, 36 insertions, 20 deletions
diff --git a/otherlibs/labltk/browser/Makefile.nt b/otherlibs/labltk/browser/Makefile.nt
index eb0e3ae54..caa8f1176 100644
--- a/otherlibs/labltk/browser/Makefile.nt
+++ b/otherlibs/labltk/browser/Makefile.nt
@@ -29,13 +29,15 @@ JG = jg_tk.cmo jg_config.cmo jg_bind.cmo jg_completion.cmo \
.c.obj:
$(BYTECC) $(BYTECCCOMPOPTS) $(CCFLAGS) -c $<
-all: ocamlbrowser
+all: ocamlbrowser.exe
-ocamlbrowser: $(TOPDIR)/toplevel/toplevellib.cma jglib.cma $(OBJ) winmain.obj
- $(LABLC) -o ocamlbrowser -custom $(INCLUDES) \
+ocamlbrowser.exe: $(TOPDIR)/toplevel/toplevellib.cma \
+ ..\support\liblabltk41.lib
+ocamlbrowser.exe: jglib.cma $(OBJ) winmain.obj
+ $(LABLC) -o ocamlbrowser.exe -custom $(INCLUDES) \
$(TOPDIR)/toplevel/toplevellib.cma \
unix.cma threads.cma str.cma labltk.cma jglib.cma $(OBJ) \
- $(TK_LINK) winmain.obj
+ winmain.obj -cclib "/subsystem:windows"
jglib.cma: $(JG)
$(LABLCOMP) -a -o jglib.cma $(JG)
diff --git a/otherlibs/labltk/browser/fileselect.mli b/otherlibs/labltk/browser/fileselect.mli
index 83f93f706..75ee582ae 100644
--- a/otherlibs/labltk/browser/fileselect.mli
+++ b/otherlibs/labltk/browser/fileselect.mli
@@ -34,3 +34,6 @@ val f :
(* usepath
Enables/disables load path search. Defaults to true *)
+
+val caml_dir : string -> string
+(* Convert Windows-style directory separator '\' to caml-style '/' *)
diff --git a/otherlibs/labltk/browser/setpath.ml b/otherlibs/labltk/browser/setpath.ml
index 82d9b2a60..3e7470dfc 100644
--- a/otherlibs/labltk/browser/setpath.ml
+++ b/otherlibs/labltk/browser/setpath.ml
@@ -57,7 +57,7 @@ let add_to_path ~dirs ?(base="") box =
begin function
"." -> base
| ".." -> Filename.dirname base
- | x -> base ^ "/" ^ x
+ | x -> Filename.concat base x
end
in
set_load_path
diff --git a/otherlibs/labltk/browser/shell.ml b/otherlibs/labltk/browser/shell.ml
index 666ac3b49..63766ea12 100644
--- a/otherlibs/labltk/browser/shell.ml
+++ b/otherlibs/labltk/browser/shell.ml
@@ -51,6 +51,9 @@ let dump_handle (h : Unix.file_descr) =
let protect f x = try f x with _ -> ()
+let use_threads = Sys.os_type = "Win32"
+let use_sigpipe = Sys.os_type = "Win32"
+
class shell ~textw ~prog ~args ~env ~history =
let (in2,out1) = Unix.pipe ()
and (in1,out2) = Unix.pipe ()
@@ -59,7 +62,7 @@ class shell ~textw ~prog ~args ~env ~history =
object (self)
val pid =
let env =
- if Sys.os_type = "Win32" then
+ if use_sigpipe then
let sigdef = "CAMLSIGPIPE=" ^ dump_handle sig2 in
Array.append env [|sigdef|]
else env
@@ -80,13 +83,13 @@ object (self)
alive <- false;
protect close_out out;
try
- if Sys.os_type = "Win32" then begin
- ignore (Unix.write sig1 ~buf:"T" ~pos:0 ~len:1);
- List.iter ~f:(protect Unix.close) [sig1; sig2]
- end else begin
- List.iter ~f:(protect Unix.close) [in1; err1; sig1; sig2];
+ if use_sigpipe then ignore (Unix.write sig1 ~buf:"T" ~pos:0 ~len:1);
+ List.iter ~f:(protect Unix.close) [in1; err1; sig1; sig2];
+ if not use_threads then begin
Fileevent.remove_fileinput ~fd:in1;
Fileevent.remove_fileinput ~fd:err1;
+ end;
+ if not use_sigpipe then begin
Unix.kill ~pid ~signal:Sys.sigkill;
ignore (Unix.waitpid ~mode:[] pid)
end
@@ -95,7 +98,7 @@ object (self)
method interrupt =
if alive then try
reading <- false;
- if Sys.os_type = "Win32" then begin
+ if use_sigpipe then begin
ignore (Unix.write sig1 ~buf:"C" ~pos:0 ~len:1);
self#send " "
end else
@@ -108,8 +111,10 @@ object (self)
with Sys_error _ -> ()
method private read ~fd ~len =
begin try
+ prerr_endline "reading...";
let buf = String.create len in
let len = Unix.read fd ~buf ~pos:0 ~len in
+ prerr_endline "read";
if len > 0 then begin
self#insert (String.sub buf ~pos:0 ~len);
Text.mark_set textw ~mark:"input" ~index:(`Mark"insert",[`Char(-1)])
@@ -186,7 +191,7 @@ object (self)
bind textw ~events:[`KeyPressDetail"Return"] ~breakable:true
~action:(fun _ -> self#return; break());
List.iter ~f:Unix.close [in2;out2;err2];
- if Sys.os_type = "Win32" then begin
+ if use_threads then begin
let fileinput_thread fd =
let buf = String.create 1024 in
let len = ref 0 in
@@ -210,12 +215,16 @@ object (self)
in
read_buffer ()
end else begin
- try
+ try ()
+(*
+ prerr_endline "add inputs...";
List.iter [in1;err1] ~f:
begin fun fd ->
Fileevent.add_fileinput ~fd
~callback:(fun () -> ignore (self#read ~fd ~len:1024))
- end
+ end;
+ prerr_endline "added"
+*)
with _ -> ()
end
end
@@ -239,7 +248,7 @@ let may_exec_unix prog =
with Unix.Unix_error _ -> false
let may_exec_win prog =
- List.exists ~f:may_exec_unix [prog; prog^".exe"; prog^".cmo"; prog^".bat"]
+ List.exists ~f:may_exec_unix [prog; prog^".exe"; prog^".com"; prog^".bat"]
let may_exec =
if Sys.os_type = "Win32" then may_exec_win else may_exec_unix
@@ -319,7 +328,7 @@ let f ~prog ~title =
~sync:true ~dir:!current_dir ()
~action:(fun l ->
if l = [] then () else
- let name = List.hd l in
+ let name = Fileselect.caml_dir (List.hd l) in
current_dir := Filename.dirname name;
if Filename.check_suffix name ".ml"
then
@@ -332,7 +341,7 @@ let f ~prog ~title =
~dir:!current_dir
~action:(fun l ->
if l = [] then () else
- let name = List.hd l in
+ let name = Fileselect.caml_dir (List.hd l) in
current_dir := Filename.dirname name;
if Filename.check_suffix name ".cmo" ||
Filename.check_suffix name ".cma"
diff --git a/otherlibs/labltk/browser/winmain.c b/otherlibs/labltk/browser/winmain.c
index 8a81f6f1b..6805ecfcd 100644
--- a/otherlibs/labltk/browser/winmain.c
+++ b/otherlibs/labltk/browser/winmain.c
@@ -1,10 +1,12 @@
#include <callback.h>
#include <windows.h>
+extern int __argc;
extern char **__argv;
+extern void expand_command_line (int *, char ***);
+extern void caml_main (char **);
int WINAPI WinMain(HINSTANCE h, HINSTANCE HPrevInstance,
LPSTR lpCmdLine, int nCmdShow)
{
- caml_main(__argv);
- return 0;
+ return main(__argc, __argv);
}
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-19 21:05:31 +0000