implemented base x11 primitives

diff --git a/Makefile b/Makefile
index 24e219abaff14bbdd30fcc6edb3697281aca88cc..cf52dba7cc2e51b1719dbf368e14ac460c6d4485 100644 (file)
--- 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 ccee621bbab80e78c0d12ed49d062ef815a1a287..d4a9c5172d16adc87b2637ead30554ae6859bb1c 100644 (file)
--- 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 51191b8087496cd05a079be5b40c1770dfffec77..38486a711c0f5e4ec82c50407ac9da25649470bd 100644 (file)
--- 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 67e69654ce2fa0f04b20c7158d36e298b905a4ea..32be06ad3eda479bf597a46a3afa26aa4bb6b8f4 100644 (file)
--- 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 48145aeb39178aef082f463218e08ea4ee292a22..f3953d3aee258afb82d313134cd8044d806c62ac 100644 (file)
--- a/lib/x11_prims.c
+++ b/lib/x11_prims.c
@@ -1,12 +1,84 @@
 #include <curses.h>
 #include <caml/mlvalues.h>
+#include <caml/fail.h>
 #include <caml/memory.h>
 #include <caml/alloc.h>
-#include <caml/custom.h>
-#include <stdlib.h>
+//#include <caml/custom.h>
+//#include <stdlib.h>
 
-CAMLprim value x11_get(value var) {
-    CAMLparam1(var);
-    puts("bar");
-    CAMLreturn(caml_copy_string(""));
+#include <X11/Xlib.h>
+#include <X11/Xatom.h>
+
+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;
 }