From e434971164c4e90b986f0095b048fa9c7283e5e8 Mon Sep 17 00:00:00 2001 From: "Michael D. Lowis" Date: Tue, 29 Aug 2017 22:35:28 -0400 Subject: [PATCH] implemented base x11 primitives --- Makefile | 13 +++++--- edit.ml | 4 ++- lib/tide.mli | 2 +- lib/x11.ml | 31 +++++++++++++++++- lib/x11_prims.c | 84 +++++++++++++++++++++++++++++++++++++++++++++---- 5 files changed, 120 insertions(+), 14 deletions(-) diff --git a/Makefile b/Makefile index 24e219a..cf52dba 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,8 @@ # Toolchain Configuration #------------------------------------------------------------------------------- +INCS = -I . -I lib -I /usr/X11R6/include +LIBS = -L/usr/X11R6/lib -lX11 + ifeq ($(NATIVE), 1) OC = ocamlopt OCFLAGS = @@ -47,17 +50,17 @@ deps.mk: # Implicit Rule Definitions #------------------------------------------------------------------------------- %: - $(OC) $(OLDFLAGS) -o $@ $^ -I . -I lib + $(OC) $(OLDFLAGS) -o $@ $^ $(INCS) %.cmi: %.mli - $(OC) $(OCFLAGS) -c -o $@ $< -I . -I lib + $(OC) $(OCFLAGS) -c -o $@ $< $(INCS) %.$(OBJEXT): %.ml - $(OC) $(OCFLAGS) -c -o $@ $< -I . -I lib + $(OC) $(OCFLAGS) -c -o $@ $< $(INCS) %.$(LIBEXT): - $(MKLIB) $(MKLIBFLAGS) $(OCFLAGS) -o $* -oc $* $^ + $(MKLIB) $(MKLIBFLAGS) $(OCFLAGS) -o $* -oc $* $^ $(LIBS) %.o: %.c - $(OC) $(OCFLAGS) -c $^ + $(OC) $(OCFLAGS) -c $^ $(INCS) mv $(notdir $@) $(dir $@) diff --git a/edit.ml b/edit.ml index ccee621..d4a9c51 100644 --- a/edit.ml +++ b/edit.ml @@ -1,4 +1,5 @@ let () = + X11.connect (); let server = Tide.start_server () in let nargs = Array.length Sys.argv in for i = 1 to (nargs - 1) do @@ -7,4 +8,5 @@ let () = Tide.start_pty server (Array.sub Sys.argv i (nargs - i)) else Tide.edit_file server arg - done + done; + X11.disconnect () diff --git a/lib/tide.mli b/lib/tide.mli index 51191b8..38486a7 100644 --- a/lib/tide.mli +++ b/lib/tide.mli @@ -1,3 +1,3 @@ val start_server : unit -> int -val start_pty : int -> string array -> unit val edit_file : int -> string -> unit +val start_pty : int -> string array -> unit diff --git a/lib/x11.ml b/lib/x11.ml index 67e6965..32be06a 100644 --- a/lib/x11.ml +++ b/lib/x11.ml @@ -1 +1,30 @@ -external get : string -> string = "x11_get" +type atom +type window + +external connect : unit -> unit + = "x11_connect" + +external disconnect : unit -> unit + = "x11_disconnect" + +external errno : unit -> int + = "x11_errno" + +external intern : string -> atom + = "x11_intern" + +external prop_set : window -> atom -> string -> unit + = "x11_prop_set" + +external prop_get : window -> atom -> string + = "x11_prop_get" + +(* to be implemented *) +external mkwindow : int -> int -> window + = "x11_mkwindow" +external mkdialog : int -> int -> window + = "x11_mkdialog" +external sel_set : atom -> string -> unit + = "x11_sel_set" +external sel_get : atom -> unit + = "x11_sel_get" diff --git a/lib/x11_prims.c b/lib/x11_prims.c index 48145ae..f3953d3 100644 --- a/lib/x11_prims.c +++ b/lib/x11_prims.c @@ -1,12 +1,84 @@ #include #include +#include #include #include -#include -#include +//#include +//#include -CAMLprim value x11_get(value var) { - CAMLparam1(var); - puts("bar"); - CAMLreturn(caml_copy_string("")); +#include +#include + +static int error_handler(Display* disp, XErrorEvent* ev); +static char* readprop(Window win, Atom prop); + +static struct { + Display* display; + Visual* visual; + Colormap colormap; + unsigned depth; + int screen; + Window root; + int errno; +} X; + +CAMLprim value x11_connect(void) { + CAMLparam0(); + if (!(X.display = XOpenDisplay(NULL))) + caml_failwith("could not open display"); + XSetErrorHandler(error_handler); + X.root = DefaultRootWindow(X.display); + XWindowAttributes wa; + XGetWindowAttributes(X.display, X.root, &wa); + X.visual = wa.visual; + X.colormap = wa.colormap; + X.screen = DefaultScreen(X.display); + X.depth = DefaultDepth(X.display, X.screen); + CAMLreturn(Val_unit); +} + +CAMLprim value x11_disconnect(void) { + CAMLparam0(); + XCloseDisplay(X.display); + CAMLreturn(Val_unit); +} + +CAMLprim value x11_errno(void) { + CAMLparam0(); + CAMLreturn(Val_int(X.errno)); +} + +CAMLprim value x11_intern(value name) { + CAMLparam1(name); + Atom atom = XInternAtom(X.display, String_val(name), False); + CAMLreturn(Val_int(atom)); +} + +CAMLprim value x11_prop_set(value win, value atom, value val) { + CAMLparam3(win, atom, val); + unsigned char* propval = (unsigned char*)String_val(val); + XChangeProperty( + X.display, (Window)win, (Atom)atom, XA_STRING, 8, PropModeReplace, + propval, caml_string_length(val)+1); + CAMLreturn(Val_unit); +} + +CAMLprim value x11_prop_get(value win, value atom) { + CAMLparam2(win, atom); + char* prop = readprop((Window)win, (Atom)atom); + CAMLreturn(caml_copy_string(prop)); +} + +static char* readprop(Window win, Atom prop) { + Atom rtype; + unsigned long format = 0, nitems = 0, nleft = 0, nread = 0; + unsigned char* data = NULL; + XGetWindowProperty(X.display, win, prop, 0, -1, False, AnyPropertyType, &rtype, + (int*)&format, &nitems, &nleft, &data); + return (char*)data; +} + +static int error_handler(Display* disp, XErrorEvent* ev) { + X.errno = ev->error_code; + return 0; } -- 2.49.0