LablTk/OCamlBrowser portes sur Windows
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2773 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
8cb3080119
commit
dd1eae5c34
|
@ -16,17 +16,19 @@
|
|||
|
||||
######### General configuration
|
||||
|
||||
PREFIX=C:\Home\garrigue\ocaml
|
||||
|
||||
### Where to install the binaries
|
||||
BINDIR=c:\ocaml\bin
|
||||
BINDIR=$(PREFIX)\bin
|
||||
|
||||
### Where to install the standard library
|
||||
LIBDIR=c:\ocaml\lib
|
||||
LIBDIR=$(PREFIX)\lib
|
||||
|
||||
### Where to install the info files
|
||||
DISTRIB=c:\ocaml
|
||||
DISTRIB=$(PREFIX)
|
||||
|
||||
### Location of VC++ include files
|
||||
SYSTEM_INCLUDES=c:\msdev\VC98\include
|
||||
SYSTEM_INCLUDES=c:\progra~1\micros~1\VC98\include
|
||||
|
||||
########## Configuration for the bytecode compiler
|
||||
|
||||
|
@ -74,11 +76,15 @@ AFLAGS=/coff /Cp
|
|||
|
||||
############# Configuration for the contributed libraries
|
||||
|
||||
OTHERLIBRARIES=win32unix systhreads str num graph dynlink
|
||||
OTHERLIBRARIES=win32unix systhreads str num graph dynlink labltk
|
||||
|
||||
### Name of the target architecture for the "num" library
|
||||
BIGNUM_ARCH=C
|
||||
|
||||
### Configuration for LablTk
|
||||
TK_DEFS=-Ic:\progra~1\tcl\include
|
||||
TK_LINK=c:\progra~1\tcl\lib\tk80.lib c:\progra~1\tcl\lib\tcl80.lib
|
||||
|
||||
############# Aliases for common commands
|
||||
|
||||
MAKEREC=$(MAKE) -nologo -f Makefile.nt
|
||||
|
|
|
@ -0,0 +1,40 @@
|
|||
# Top Makefile for LablTk
|
||||
|
||||
!include ..\..\config\Makefile.nt
|
||||
|
||||
SUBDIRS=compiler support lib jpf example browser
|
||||
|
||||
all:
|
||||
cd support & $(MAKEREC)
|
||||
cd compiler & $(MAKEREC)
|
||||
cd lib & $(MAKE) -nologo -f Makefile.gen.nt & $(MAKEREC)
|
||||
cd jpf & $(MAKEREC)
|
||||
cd browser & $(MAKEREC)
|
||||
|
||||
allopt:
|
||||
cd support & $(MAKEREC) opt
|
||||
cd lib & $(MAKE) -nologo -f Makefile.gen.nt & $(MAKEREC) opt
|
||||
cd jpf & $(MAKEREC) opt
|
||||
|
||||
lib: Widgets.src
|
||||
compiler/tkcompiler
|
||||
cd lib & $(MAKEREC)
|
||||
|
||||
example: example/all
|
||||
|
||||
example/all:
|
||||
cd example & $(MAKEREC) all
|
||||
|
||||
install:
|
||||
cd lib & $(MAKEREC) install
|
||||
cd support & $(MAKEREC) install
|
||||
cd compiler & $(MAKEREC) install
|
||||
cd jpf & $(MAKEREC) install
|
||||
cd browser & $(MAKEREC) install
|
||||
|
||||
installopt:
|
||||
cd lib & $(MAKEREC) installopt
|
||||
cd jpf & $(MAKEREC) installopt
|
||||
|
||||
partialclean clean:
|
||||
for %d in ($(SUBDIRS)) do (cd %d & $(MAKEREC) clean & cd ..)
|
|
@ -1 +1,2 @@
|
|||
ocamlbrowser
|
||||
dummy.mli
|
||||
|
|
|
@ -40,9 +40,13 @@ install:
|
|||
if test -f ocamlbrowser; then : ; cp ocamlbrowser $(BINDIR); fi
|
||||
|
||||
clean:
|
||||
rm -f *.cm? ocamlbrowser *~ *.orig
|
||||
rm -f *.cm? ocamlbrowser dummy.mli *~ *.orig
|
||||
|
||||
depend:
|
||||
$(LABLDEP) *.ml *.mli > .depend
|
||||
|
||||
dummy.mli:
|
||||
ln -sf dummyUnix.mli dummy.mli
|
||||
shell.cmo: dummy.cmi
|
||||
|
||||
include .depend
|
||||
|
|
|
@ -0,0 +1,52 @@
|
|||
!include ..\support\Makefile.common.nt
|
||||
|
||||
LABLTKLIB=-I ../lib -I ../support
|
||||
OTHERSLIB=-I $(OTHERS)/unix -I $(OTHERS)/str -I $(OTHERS)/systhreads
|
||||
OCAMLTOPLIB=-I $(TOPDIR)/parsing -I $(TOPDIR)/utils -I $(TOPDIR)/typing
|
||||
INCLUDES=$(OTHERSLIB) $(LABLTKLIB) $(OCAMLTOPLIB)
|
||||
CLIBS=../support/liblabltk41.lib $(OTHERS)/str/libstr.lib $(OTHERS)/win32unix/libunix.lib $(OTHERS)/systhreads/libthreads.lib
|
||||
|
||||
OBJ = list2.cmo useunix.cmo setpath.cmo lexical.cmo \
|
||||
fileselect.cmo searchid.cmo searchpos.cmo shell.cmo \
|
||||
viewer.cmo typecheck.cmo editor.cmo main.cmo
|
||||
|
||||
JG = jg_tk.cmo jg_config.cmo jg_bind.cmo jg_completion.cmo \
|
||||
jg_box.cmo \
|
||||
jg_button.cmo jg_toplevel.cmo jg_text.cmo jg_message.cmo \
|
||||
jg_menu.cmo jg_entry.cmo jg_multibox.cmo jg_memo.cmo
|
||||
|
||||
# Default rules
|
||||
|
||||
.SUFFIXES: .ml .mli .cmo .cmi .cmx
|
||||
|
||||
.ml.cmo:
|
||||
$(LABLCOMP) $(INCLUDES) $<
|
||||
|
||||
.mli.cmi:
|
||||
$(LABLCOMP) $(INCLUDES) $<
|
||||
|
||||
all: ocamlbrowser
|
||||
|
||||
ocamlbrowser: $(TOPDIR)/toplevel/toplevellib.cma jglib.cma $(OBJ)
|
||||
$(LABLC) -custom -o ocamlbrowser $(INCLUDES) \
|
||||
$(TOPDIR)/toplevel/toplevellib.cma \
|
||||
unix.cma threads.cma str.cma tk41.cma jglib.cma $(OBJ) \
|
||||
-cclib "$(CLIBS)" $(TKLINKOPT)
|
||||
|
||||
jglib.cma: $(JG)
|
||||
$(LABLCOMP) -a -o jglib.cma $(JG)
|
||||
|
||||
install:
|
||||
if exist ocamlbrowser.exe cp ocamlbrowser.exe $(BINDIR)
|
||||
|
||||
clean:
|
||||
rm -f *.cm? ocamlbrowser dummy.mli *~ *.orig
|
||||
|
||||
depend:
|
||||
$(LABLDEP) *.ml *.mli > .depend
|
||||
|
||||
dummy.mli:
|
||||
cp dummyWin.mli dummy.mli
|
||||
shell.cmo: dummy.cmi
|
||||
|
||||
!include .depend
|
|
@ -0,0 +1,32 @@
|
|||
(*************************************************************************)
|
||||
(* *)
|
||||
(* Objective Caml LablTk library *)
|
||||
(* *)
|
||||
(* Jacques Garrigue, Kyoto University RIMS *)
|
||||
(* *)
|
||||
(* Copyright 2000 Institut National de Recherche en Informatique et *)
|
||||
(* en Automatique and Kyoto University. All rights reserved. *)
|
||||
(* This file is distributed under the terms of the GNU Library *)
|
||||
(* General Public License. *)
|
||||
(* *)
|
||||
(*************************************************************************)
|
||||
|
||||
(* $Id$ *)
|
||||
|
||||
module Mutex : sig
|
||||
type t
|
||||
external create : unit -> t = "%ignore"
|
||||
external lock : t -> unit = "%ignore"
|
||||
external unlock : t -> unit = "%ignore"
|
||||
end
|
||||
|
||||
module Thread : sig
|
||||
type t
|
||||
external create : ('a -> 'b) -> 'a -> t = "caml_input"
|
||||
end
|
||||
|
||||
module ThreadUnix : sig
|
||||
open Unix
|
||||
external read : file_descr -> buf:string -> pos:int -> len:int -> int
|
||||
= "caml_input"
|
||||
end
|
|
@ -0,0 +1,14 @@
|
|||
(*************************************************************************)
|
||||
(* *)
|
||||
(* Objective Caml LablTk library *)
|
||||
(* *)
|
||||
(* Jacques Garrigue, Kyoto University RIMS *)
|
||||
(* *)
|
||||
(* Copyright 2000 Institut National de Recherche en Informatique et *)
|
||||
(* en Automatique and Kyoto University. All rights reserved. *)
|
||||
(* This file is distributed under the terms of the GNU Library *)
|
||||
(* General Public License. *)
|
||||
(* *)
|
||||
(*************************************************************************)
|
||||
|
||||
(* $Id$ *)
|
|
@ -13,14 +13,21 @@
|
|||
|
||||
(* $Id$ *)
|
||||
|
||||
let fixed =
|
||||
if Sys.os_type = "Win32" then "{Courier New} 8" else "fixed"
|
||||
let variable =
|
||||
if Sys.os_type = "Win32" then "Arial 9" else "variable"
|
||||
|
||||
let init () =
|
||||
if Sys.os_type = "Win32" then Option.add path:"*font" fixed;
|
||||
let font =
|
||||
let font =
|
||||
Option.get Widget.default_toplevel name:"variableFont" class:"Font" in
|
||||
if font = "" then "variable" else font
|
||||
if font = "" then variable else font
|
||||
in
|
||||
List.iter ["Button"; "Label"; "Menu"; "Menubutton"; "Radiobutton"]
|
||||
fun:(fun cl -> Option.add path:("*" ^ cl ^ ".font") font);
|
||||
Option.add path:"*Menu.tearOff" "0" priority:`StartupFile;
|
||||
Option.add path:"*Button.padY" "0" priority:`StartupFile;
|
||||
Option.add path:"*Text.highlightThickness" "0" priority:`StartupFile;
|
||||
Option.add path:"*interface.background" "gray85" priority:`StartupFile;
|
||||
|
|
|
@ -15,6 +15,7 @@
|
|||
|
||||
open Tk
|
||||
open Jg_tk
|
||||
open Dummy
|
||||
|
||||
(* Here again, memoize regexps *)
|
||||
|
||||
|
@ -37,6 +38,19 @@ class ['a] history () = object
|
|||
List.nth history pos:((l + count - 1) mod l)
|
||||
end
|
||||
|
||||
let dump_mem ?(:pos = 0) ?:len obj =
|
||||
if not (Obj.is_block obj) then invalid_arg "Shell.dump_mem";
|
||||
let len =
|
||||
match len with
|
||||
| None -> Obj.size obj * Sys.word_size / 8 - pos
|
||||
| Some x -> x in
|
||||
let buf = Buffer.create 256 in
|
||||
for i = pos to len - 1 do
|
||||
let c = String.unsafe_get (Obj.obj obj) i in
|
||||
Buffer.add_string buf (Printf.sprintf "%02x" (Char.code c))
|
||||
done;
|
||||
Buffer.contents buf
|
||||
|
||||
(* The shell class. Now encapsulated *)
|
||||
|
||||
let protect f x = try f x with _ -> ()
|
||||
|
@ -44,32 +58,52 @@ let protect f x = try f x with _ -> ()
|
|||
class shell :textw :prog :args :env =
|
||||
let (in2,out1) = Unix.pipe ()
|
||||
and (in1,out2) = Unix.pipe ()
|
||||
and (err1,err2) = Unix.pipe () in
|
||||
and (err1,err2) = Unix.pipe ()
|
||||
and (sig2,sig1) = Unix.pipe () in
|
||||
object (self)
|
||||
val pid = Unix.create_process_env name:prog :args :env
|
||||
val pid =
|
||||
let env =
|
||||
if Sys.os_type = "Win32" then
|
||||
let sigdef = "CAMLSIGPIPE=" ^ dump_mem (Obj.repr sig2) in
|
||||
Array.append env [|sigdef|]
|
||||
else env
|
||||
in
|
||||
Unix.create_process_env name:prog :args :env
|
||||
stdin:in2 stdout:out2 stderr:err2
|
||||
val out = Unix.out_channel_of_descr out1
|
||||
val h = new history ()
|
||||
val mutable alive = true
|
||||
val mutable reading = false
|
||||
val ibuffer = Buffer.create 1024
|
||||
val imutex = Mutex.create ()
|
||||
val mutable ithreads = []
|
||||
method alive = alive
|
||||
method kill =
|
||||
if Winfo.exists textw then Text.configure textw state:`Disabled;
|
||||
if alive then begin
|
||||
alive <- false;
|
||||
protect close_out out;
|
||||
List.iter fun:(protect Unix.close) [in1; err1; in2; out2; err2];
|
||||
try
|
||||
Fileevent.remove_fileinput fd:in1;
|
||||
Fileevent.remove_fileinput fd:err1;
|
||||
Unix.kill :pid signal:Sys.sigkill;
|
||||
Unix.waitpid mode:[] pid; ()
|
||||
if Sys.os_type = "Win32" then begin
|
||||
ignore (Unix.write sig1 buf:"T" pos:0 len:1);
|
||||
List.iter fun:(protect Unix.close) [sig1; sig2]
|
||||
end else begin
|
||||
List.iter fun:(protect Unix.close) [in1; err1; sig1; sig2];
|
||||
Fileevent.remove_fileinput fd:in1;
|
||||
Fileevent.remove_fileinput fd:err1;
|
||||
Unix.kill :pid signal:Sys.sigkill;
|
||||
Unix.waitpid mode:[] pid; ()
|
||||
end
|
||||
with _ -> ()
|
||||
end
|
||||
method interrupt =
|
||||
if alive then try
|
||||
reading <- false;
|
||||
Unix.kill :pid signal:Sys.sigint
|
||||
if Sys.os_type = "Win32" then begin
|
||||
ignore (Unix.write sig1 buf:"C" pos:0 len:1);
|
||||
self#send " "
|
||||
end else
|
||||
Unix.kill :pid signal:Sys.sigint
|
||||
with Unix.Unix_error _ -> ()
|
||||
method send s =
|
||||
if alive then try
|
||||
|
@ -77,12 +111,16 @@ object (self)
|
|||
flush out
|
||||
with Sys_error _ -> ()
|
||||
method private read :fd :len =
|
||||
try
|
||||
begin try
|
||||
let buf = String.create :len in
|
||||
let len = Unix.read fd :buf pos:0 :len in
|
||||
self#insert (String.sub buf pos:0 :len);
|
||||
Text.mark_set textw mark:"input" index:(`Mark"insert",[`Char(-1)])
|
||||
with Unix.Unix_error _ -> ()
|
||||
if len > 0 then begin
|
||||
self#insert (String.sub buf pos:0 :len);
|
||||
Text.mark_set textw mark:"input" index:(`Mark"insert",[`Char(-1)])
|
||||
end;
|
||||
len
|
||||
with Unix.Unix_error _ -> 0
|
||||
end;
|
||||
method history (dir : [`next|`previous]) =
|
||||
if not h#empty then begin
|
||||
if reading then begin
|
||||
|
@ -151,13 +189,38 @@ object (self)
|
|||
end;
|
||||
bind textw events:[`KeyPressDetail"Return"] breakable:true
|
||||
action:(fun _ -> self#return; break());
|
||||
begin try
|
||||
List.iter [in1;err1] fun:
|
||||
begin fun fd ->
|
||||
Fileevent.add_fileinput :fd
|
||||
callback:(fun () -> self#read :fd len:1024)
|
||||
end
|
||||
with _ -> ()
|
||||
List.iter fun:Unix.close [in2;out2;err2];
|
||||
if Sys.os_type = "Win32" then begin
|
||||
let fileinput_thread fd =
|
||||
let buf = String.create len:1024 in
|
||||
let len = ref 0 in
|
||||
try while len := ThreadUnix.read fd :buf pos:0 len:1024; !len > 0 do
|
||||
Mutex.lock imutex;
|
||||
Buffer.add_substring ibuffer buf pos:0 len:!len;
|
||||
Mutex.unlock imutex
|
||||
done with Unix.Unix_error _ -> ()
|
||||
in
|
||||
ithreads <- List.map [in1; err1] fun:(Thread.create fileinput_thread);
|
||||
let rec read_buffer () =
|
||||
Mutex.lock imutex;
|
||||
if Buffer.length ibuffer > 0 then begin
|
||||
self#insert (Str.global_replace pat:~"\r\n" with:"\n"
|
||||
(Buffer.contents ibuffer));
|
||||
Buffer.reset ibuffer;
|
||||
Text.mark_set textw mark:"input" index:(`Mark"insert",[`Char(-1)])
|
||||
end;
|
||||
Mutex.unlock imutex;
|
||||
ignore (Timer.add ms:100 callback:read_buffer)
|
||||
in
|
||||
read_buffer ()
|
||||
end else begin
|
||||
try
|
||||
List.iter [in1;err1] fun:
|
||||
begin fun fd ->
|
||||
Fileevent.add_fileinput :fd
|
||||
callback:(fun () -> ignore (self#read :fd len:1024))
|
||||
end
|
||||
with _ -> ()
|
||||
end
|
||||
end
|
||||
|
||||
|
@ -175,17 +238,26 @@ let get_all () =
|
|||
shells := all;
|
||||
all
|
||||
|
||||
let may_exec prog =
|
||||
let may_exec_unix prog =
|
||||
try Unix.access name:prog perm:[Unix.X_OK]; true
|
||||
with Unix.Unix_error _ -> false
|
||||
|
||||
let may_exec_win prog =
|
||||
List.exists pred:may_exec_unix [prog; prog^".exe"; prog^".cmo"; prog^".bat"]
|
||||
|
||||
let may_exec =
|
||||
if Sys.os_type = "Win32" then may_exec_win else may_exec_unix
|
||||
|
||||
let path_sep = if Sys.os_type = "Win32" then ";" else ":"
|
||||
|
||||
let f :prog :title =
|
||||
let progargs =
|
||||
List.filter pred:((<>) "") (Str.split sep:~" " prog) in
|
||||
if progargs = [] then () else
|
||||
let prog = List.hd progargs in
|
||||
let path = try Sys.getenv "PATH" with Not_found -> "/bin:/usr/bin" in
|
||||
let exec_path = Str.split sep:~":" path in
|
||||
let path =
|
||||
try Sys.getenv "PATH" with Not_found -> "/bin" ^ path_sep ^ "/usr/bin" in
|
||||
let exec_path = Str.split sep:~path_sep path in
|
||||
let exists =
|
||||
if not (Filename.is_implicit prog) then may_exec prog else
|
||||
List.exists exec_path
|
||||
|
|
|
@ -0,0 +1,36 @@
|
|||
!include ..\support\Makefile.common.nt
|
||||
|
||||
OBJS=tsort.cmo tables.cmo lexer.cmo parser.cmo compile.cmo intf.cmo \
|
||||
maincompile.cmo
|
||||
|
||||
tkcompiler : $(OBJS)
|
||||
$(LABLC) $(LINKFLAGS) -o tkcompiler $(OBJS)
|
||||
|
||||
lexer.ml: lexer.mll
|
||||
$(LABLLEX) lexer.mll
|
||||
|
||||
parser.ml parser.mli: parser.mly
|
||||
$(LABLYACC) -v parser.mly
|
||||
|
||||
clean :
|
||||
rm -f *.cm* parser.ml parser.mli lexer.ml tkcompiler parser.output
|
||||
|
||||
scratch :
|
||||
rm -f *.cm* parser.ml parser.mli lexer.ml tkcompiler
|
||||
|
||||
install:
|
||||
cp tkcompiler $(LABLTKDIR)
|
||||
|
||||
.SUFFIXES :
|
||||
.SUFFIXES : .mli .ml .cmi .cmo .mlp
|
||||
|
||||
.mli.cmi:
|
||||
$(LABLCOMP) $(COMPFLAGS) $<
|
||||
|
||||
.ml.cmo:
|
||||
$(LABLCOMP) $(COMPFLAGS) $<
|
||||
|
||||
depend: parser.ml parser.mli lexer.ml
|
||||
$(LABLDEP) *.mli *.ml > .depend
|
||||
|
||||
!include .depend
|
|
@ -24,7 +24,7 @@ libjpf.cmxa: $(OBJSX)
|
|||
$(CAMLOPTLIBR) -o libjpf.cmxa $(OBJSX)
|
||||
|
||||
install: libjpf.cma
|
||||
cp *.cmi *.mli libjpf.cma $(LABLTKDIR)
|
||||
cp $(OBJS:.cmo=.cmi) $(OBJS:.cmo=.mli) libjpf.cma $(LABLTKDIR)
|
||||
|
||||
installopt: libjpf.cmxa
|
||||
cp libjpf.cmxa libjpf.a $(LABLTKDIR)
|
||||
|
|
|
@ -0,0 +1,71 @@
|
|||
!include ..\support\Makefile.common.nt
|
||||
|
||||
COMPFLAGS=-I ../lib -I ../support -I $(OTHERS)/unix -I $(OTHERS)/str
|
||||
|
||||
OBJS= fileselect.cmo balloon.cmo
|
||||
|
||||
OBJSX = $(OBJS:.cmo=.cmx)
|
||||
|
||||
all: libjpf.cma
|
||||
|
||||
opt: libjpf.cmxa
|
||||
|
||||
test: balloontest
|
||||
|
||||
testopt: balloontest.opt
|
||||
|
||||
libjpf.cma: $(OBJS)
|
||||
$(LABLLIBR) -o libjpf.cma $(OBJS)
|
||||
|
||||
libjpf.cmxa: $(OBJSX)
|
||||
$(CAMLOPTLIBR) -o libjpf.cmxa $(OBJSX)
|
||||
|
||||
install: libjpf.cma
|
||||
cp $(OBJS:.cmo=.cmi) $(OBJS:.cmo=.mli) libjpf.cma $(LABLTKDIR)
|
||||
|
||||
installopt: libjpf.cmxa
|
||||
cp libjpf.cmxa libjpf.a $(LABLTKDIR)
|
||||
|
||||
clean:
|
||||
rm -f *.cm* *.o *.a *~ *test
|
||||
|
||||
### Tests
|
||||
|
||||
balloontest: balloontest.cmo
|
||||
$(LABLC) -o balloontest -I ../support -I ../lib \
|
||||
-custom tk41.cma libjpf.cma balloontest.cmo $(TKLINKOPT)
|
||||
|
||||
balloontest.opt: balloontest.cmx
|
||||
$(CAMLOPT) -o balloontest.opt -I ../support -I ../lib \
|
||||
tk41.cmxa libjpf.cmxa balloontest.cmx $(TKLINKOPT)
|
||||
|
||||
balloontest.cmo : balloon.cmo libjpf.cma
|
||||
|
||||
balloontest.cmx : balloon.cmx libjpf.cmxa
|
||||
|
||||
.SUFFIXES :
|
||||
.SUFFIXES : .mli .ml .cmi .cmx .cmo
|
||||
|
||||
.mli.cmi:
|
||||
$(LABLCOMP) $(COMPFLAGS) $<
|
||||
|
||||
.ml.cmo:
|
||||
$(LABLCOMP) $(COMPFLAGS) $<
|
||||
|
||||
.ml.cmx:
|
||||
$(CAMLOPT) -c $(COMPFLAGS) $<
|
||||
|
||||
depend:
|
||||
mv Makefile Makefile.bak
|
||||
(sed -n -e '1,/^### DO NOT DELETE THIS LINE/p' Makefile.bak; \
|
||||
$(LABLDEP) *.mli *.ml) > Makefile
|
||||
|
||||
|
||||
### EVERYTHING THAT GOES BEYOND THIS COMMENT IS GENERATED
|
||||
### DO NOT DELETE THIS LINE
|
||||
balloon.cmo: balloon.cmi
|
||||
balloon.cmx: balloon.cmi
|
||||
balloontest.cmo: balloon.cmi
|
||||
balloontest.cmx: balloon.cmx
|
||||
fileselect.cmo: fileselect.cmi
|
||||
fileselect.cmx: fileselect.cmi
|
|
@ -19,11 +19,11 @@ open Balloon
|
|||
open Protocol
|
||||
|
||||
let _ =
|
||||
let t = openTk () in
|
||||
Balloon.init ();
|
||||
let b = Button.create parent: t text: "hello" in
|
||||
Button.configure b command: (fun () -> destroy b);
|
||||
pack [b];
|
||||
Balloon.put on: b ms: 1000 "Balloon";
|
||||
Printexc.catch mainLoop ()
|
||||
let t = openTk () in
|
||||
Balloon.init ();
|
||||
let b = Button.create t text: "hello" in
|
||||
Button.configure b command: (fun () -> destroy b);
|
||||
pack [b];
|
||||
Balloon.put on: b ms: 1000 "Balloon";
|
||||
Printexc.catch mainLoop ()
|
||||
|
||||
|
|
|
@ -0,0 +1,37 @@
|
|||
!include ..\support\Makefile.common.nt
|
||||
|
||||
all: tk.ml .depend
|
||||
|
||||
tkgen.ml: ..\Widgets.src ..\compiler\tkcompiler
|
||||
cd .. & ..\..\boot\ocamlrun compiler/tkcompiler
|
||||
|
||||
# dependencies are broken: wouldn't work with gmake 3.77
|
||||
|
||||
tk.ml .depend: tkgen.ml ..\builtin\report.ml #../builtin/builtin_*.ml
|
||||
cat << > tk.ml
|
||||
open Widget
|
||||
open Protocol
|
||||
open Support
|
||||
open Textvariable
|
||||
<<
|
||||
cat ../builtin/report.ml >> tk.ml
|
||||
cat ../builtin/builtin_*.ml >> tk.ml
|
||||
cat tkgen.ml >> tk.ml
|
||||
cat << >> tk.ml
|
||||
|
||||
|
||||
module Tkintf = struct
|
||||
<<
|
||||
cat ../builtin/builtini_*.ml >> tk.ml
|
||||
cat tkigen.ml >> tk.ml
|
||||
cat << >> tk.ml
|
||||
end (* module Tkintf *)
|
||||
|
||||
|
||||
open Tkintf
|
||||
|
||||
|
||||
<<
|
||||
cat ../builtin/builtinf_*.ml >> tk.ml
|
||||
cat tkfgen.ml >> tk.ml
|
||||
$(LABLDEP) *.mli *.ml > .depend
|
|
@ -0,0 +1,56 @@
|
|||
!include ..\support\Makefile.common.nt
|
||||
|
||||
COMPFLAGS= -I ../support
|
||||
|
||||
SUPPORT=../support/support.cmo ../support/widget.cmo ../support/protocol.cmo \
|
||||
../support/textvariable.cmo ../support/timer.cmo \
|
||||
../support/fileevent.cmo
|
||||
|
||||
SUPPORTX = $(SUPPORT:.cmo=.cmx)
|
||||
|
||||
TOPDEPS = $(TOPDIR)/toplevel/toplevellib.cma $(TOPDIR)/toplevel/topmain.cmo
|
||||
|
||||
all : tk41.cma labltk
|
||||
|
||||
opt : tk41.cmxa
|
||||
|
||||
include ./modules
|
||||
WIDGETOBJSX = $(WIDGETOBJS:.cmo=.cmx)
|
||||
|
||||
tk41.cma : $(SUPPORT) $(WIDGETOBJS) tk.cmo
|
||||
$(LABLLIBR) -o tk41.cma $(SUPPORT) tk.cmo $(WIDGETOBJS)
|
||||
|
||||
tk41.cmxa : $(SUPPORTX) $(WIDGETOBJSX) tk.cmx
|
||||
$(CAMLOPTLIBR) -o tk41.cmxa $(SUPPORTX) tk.cmx $(WIDGETOBJSX)
|
||||
|
||||
labltk : $(TOPDEPS) $(WIDGETOBJS) $(SUPPORT)
|
||||
$(LABLC) -custom -linkall -o $@ -I ../support $(TKLINKOPT) \
|
||||
-I $(TOPDIR)/toplevel toplevellib.cma tk41.cma topmain.cmo
|
||||
|
||||
# All .{ml,mli} files are generated in this directory
|
||||
clean :
|
||||
rm -f *.cm* *.ml *.mli *.o *.a labltktop
|
||||
|
||||
install: tk41.cma labltk
|
||||
@if not exist $(LABLTKDIR) mkdir $(LABLTKDIR)
|
||||
cp *.cmi tk41.cma $(LABLTKDIR)
|
||||
@if not exist $(BINDIR) mkdir $(BINDIR)
|
||||
cp labltk.exe $(BINDIR)
|
||||
|
||||
installopt: tk41.cmxa
|
||||
@if not exist $(LABLTKDIR) mkdir $(LABLTKDIR)
|
||||
cp tk41.cmxa tk41.a $(LABLTKDIR)
|
||||
|
||||
.SUFFIXES :
|
||||
.SUFFIXES : .mli .ml .cmi .cmx .cmo .mlp
|
||||
|
||||
.mli.cmi:
|
||||
$(LABLCOMP) $(COMPFLAGS) $<
|
||||
|
||||
.ml.cmo:
|
||||
$(LABLCOMP) $(COMPFLAGS) $<
|
||||
|
||||
.ml.cmx:
|
||||
$(CAMLOPT) -c $(COMPFLAGS) $<
|
||||
|
||||
!include .depend
|
|
@ -0,0 +1,29 @@
|
|||
## Paths are relative to subdirectories
|
||||
## Where you compiled Objective Caml
|
||||
TOPDIR=../../..
|
||||
TOPDIRNT=..\..\..
|
||||
## Where to find OCaml binaries
|
||||
EXEDIR=$(TOPDIRNT)
|
||||
## Path to the otherlibs subdirectory
|
||||
OTHERS=../..
|
||||
|
||||
!include $(TOPDIRNT)\config\Makefile.nt
|
||||
|
||||
LABLTKDIR=$(LIBDIR)\labltk
|
||||
TKLINKOPT=$(STATIC) -cclib ../support/liblabltk41.lib \
|
||||
-cclib "$(TK_LINK)" $(X11_LINK) -cclib "$(CCLIBS) $(DLLIB)"
|
||||
|
||||
## Tools from the Objective Caml distribution
|
||||
|
||||
CAMLRUN=$(EXEDIR)\boot\ocamlrun
|
||||
LABLC=$(CAMLRUN) $(TOPDIR)/ocamlc -I $(TOPDIR)/stdlib
|
||||
LABLCOMP=$(LABLC) -w s -modern -c
|
||||
LABLYACC=$(EXEDIR)\boot\ocamlyacc -v
|
||||
LABLLEX=$(CAMLRUN) $(TOPDIR)/boot/ocamllex
|
||||
LABLLIBR=$(LABLC) -a
|
||||
LABLDEP=$(CAMLRUN) $(TOPDIR)/tools/ocamldep
|
||||
COMPFLAGS=
|
||||
LINKFLAGS=
|
||||
|
||||
CAMLOPT=$(CAMLRUN) $(TOPDIR)/ocamlopt -I $(TOPDIR)/stdlib -modern -w s
|
||||
CAMLOPTLIBR=$(CAMLOPT) -a
|
|
@ -0,0 +1,54 @@
|
|||
!include Makefile.common.nt
|
||||
|
||||
all: support.cmo widget.cmo protocol.cmo \
|
||||
textvariable.cmo timer.cmo fileevent.cmo \
|
||||
liblabltk41.lib
|
||||
|
||||
opt: support.cmx widget.cmx protocol.cmx \
|
||||
textvariable.cmx timer.cmx fileevent.cmx \
|
||||
liblabltk41.lib
|
||||
|
||||
COBJS=cltkCaml.obj cltkEval.obj cltkEvent.obj cltkFile.obj cltkMain.obj \
|
||||
cltkMisc.obj cltkTimer.obj cltkVar.obj cltkWait.obj
|
||||
|
||||
CCFLAGS=-ccopt "/Zi $(TK_DEFS)"
|
||||
|
||||
COMPFLAGS=-I $(OTHERS)/win32unix
|
||||
|
||||
liblabltk41.lib : $(COBJS)
|
||||
rm -f liblabltk41.lib
|
||||
$(MKLIB)liblabltk41.lib $(COBJS)
|
||||
|
||||
PUB=fileevent.cmi fileevent.mli \
|
||||
protocol.cmi protocol.mli \
|
||||
textvariable.cmi textvariable.mli \
|
||||
timer.cmi timer.mli \
|
||||
widget.cmi widget.mli
|
||||
|
||||
install: liblabltk41.lib $(PUB)
|
||||
@if not exist $(LABLTKDIR) mkdir $(LABLTKDIR)
|
||||
cp $(PUB) $(LABLTKDIR)
|
||||
cp liblabltk41.lib $(LABLTKDIR)
|
||||
|
||||
clean :
|
||||
rm -f *.cm* *.obj *.lib
|
||||
|
||||
.SUFFIXES :
|
||||
.SUFFIXES : .mli .ml .cmi .cmo .cmx .mlp .c .obj
|
||||
|
||||
.mli.cmi:
|
||||
$(LABLCOMP) $(COMPFLAGS) $<
|
||||
|
||||
.ml.cmo:
|
||||
$(LABLCOMP) $(COMPFLAGS) $<
|
||||
|
||||
.ml.cmx:
|
||||
$(CAMLOPT) -c $(COMPFLAGS) $<
|
||||
|
||||
.c.obj:
|
||||
$(LABLCOMP) $(CCFLAGS) $<
|
||||
|
||||
depend:
|
||||
$(LABLDEP) *.mli *.ml > .depend
|
||||
|
||||
!include .depend
|
|
@ -32,8 +32,8 @@ val system : string -> Unix.process_status
|
|||
|
||||
(*** Basic input/output *)
|
||||
|
||||
val read : Unix.file_descr -> buffer:string -> pos:int -> len:int -> int
|
||||
val write : Unix.file_descr -> buffer:string -> pos:int -> len:int -> int
|
||||
val read : Unix.file_descr -> buf:string -> pos:int -> len:int -> int
|
||||
val write : Unix.file_descr -> buf:string -> pos:int -> len:int -> int
|
||||
|
||||
(*** Polling *)
|
||||
|
||||
|
@ -46,10 +46,10 @@ val select :
|
|||
|
||||
val timed_read :
|
||||
Unix.file_descr ->
|
||||
buffer:string -> pos:int -> len:int -> timeout:float -> int
|
||||
buf:string -> pos:int -> len:int -> timeout:float -> int
|
||||
val timed_write :
|
||||
Unix.file_descr ->
|
||||
buffer:string -> pos:int -> len:int -> timeout:float -> int
|
||||
buf:string -> pos:int -> len:int -> timeout:float -> int
|
||||
(* Behave as [read] and [write], except that
|
||||
[Unix_error(ETIMEDOUT,_,_)] is raised if no data is
|
||||
available for reading or ready for writing after [d] seconds.
|
||||
|
@ -72,12 +72,12 @@ val socket : domain:Unix.socket_domain ->
|
|||
type:Unix.socket_type -> proto:int -> Unix.file_descr
|
||||
val accept : Unix.file_descr -> Unix.file_descr * Unix.sockaddr
|
||||
external connect : Unix.file_descr -> Unix.sockaddr -> unit = "unix_connect"
|
||||
val recv : Unix.file_descr -> buffer:string ->
|
||||
val recv : Unix.file_descr -> buf:string ->
|
||||
pos:int -> len:int -> flags:Unix.msg_flag list -> int
|
||||
val recvfrom : Unix.file_descr -> buffer:string -> pos:int -> len:int ->
|
||||
val recvfrom : Unix.file_descr -> buf:string -> pos:int -> len:int ->
|
||||
flags:Unix.msg_flag list -> int * Unix.sockaddr
|
||||
val send : Unix.file_descr -> buffer:string -> pos:int -> len:int ->
|
||||
val send : Unix.file_descr -> buf:string -> pos:int -> len:int ->
|
||||
flags:Unix.msg_flag list -> int
|
||||
val sendto : Unix.file_descr -> buffer:string -> pos:int -> len:int ->
|
||||
val sendto : Unix.file_descr -> buf:string -> pos:int -> len:int ->
|
||||
flags:Unix.msg_flag list -> addr:Unix.sockaddr -> int
|
||||
val open_connection : Unix.sockaddr -> in_channel * out_channel
|
||||
|
|
|
@ -31,17 +31,17 @@ val system : string -> Unix.process_status
|
|||
|
||||
(*** Basic input/output *)
|
||||
|
||||
val read : Unix.file_descr -> buffer:string -> pos:int -> len:int -> int
|
||||
val write : Unix.file_descr -> buffer:string -> pos:int -> len:int -> int
|
||||
val read : Unix.file_descr -> buf:string -> pos:int -> len:int -> int
|
||||
val write : Unix.file_descr -> buf:string -> pos:int -> len:int -> int
|
||||
|
||||
(*** Input/output with timeout *)
|
||||
|
||||
val timed_read :
|
||||
Unix.file_descr ->
|
||||
buffer:string -> pos:int -> len:int -> timeout:float -> int
|
||||
buf:string -> pos:int -> len:int -> timeout:float -> int
|
||||
val timed_write :
|
||||
Unix.file_descr ->
|
||||
buffer:string -> pos:int -> len:int -> timeout:float -> int
|
||||
buf:string -> pos:int -> len:int -> timeout:float -> int
|
||||
(* Behave as [read] and [write], except that
|
||||
[Unix_error(ETIMEDOUT,_,_)] is raised if no data is
|
||||
available for reading or ready for writing after [d] seconds.
|
||||
|
@ -72,13 +72,13 @@ val socketpair : domain:Unix.socket_domain -> type:Unix.socket_type ->
|
|||
proto:int -> Unix.file_descr * Unix.file_descr
|
||||
val accept : Unix.file_descr -> Unix.file_descr * Unix.sockaddr
|
||||
val connect : Unix.file_descr -> Unix.sockaddr -> unit
|
||||
val recv : Unix.file_descr -> buffer:string ->
|
||||
val recv : Unix.file_descr -> buf:string ->
|
||||
pos:int -> len:int -> flags:Unix.msg_flag list -> int
|
||||
val recvfrom : Unix.file_descr -> buffer:string -> pos:int -> len:int ->
|
||||
val recvfrom : Unix.file_descr -> buf:string -> pos:int -> len:int ->
|
||||
flags:Unix.msg_flag list -> int * Unix.sockaddr
|
||||
val send : Unix.file_descr -> buffer:string -> pos:int -> len:int ->
|
||||
val send : Unix.file_descr -> buf:string -> pos:int -> len:int ->
|
||||
flags:Unix.msg_flag list -> int
|
||||
val sendto : Unix.file_descr -> buffer:string -> pos:int -> len:int ->
|
||||
val sendto : Unix.file_descr -> buf:string -> pos:int -> len:int ->
|
||||
flags:Unix.msg_flag list -> addr:Unix.sockaddr -> int
|
||||
val open_connection : Unix.sockaddr -> in_channel * out_channel
|
||||
val establish_server :
|
||||
|
|
Loading…
Reference in New Issue