From: Claudio Sacerdoti Coen Date: Fri, 1 Dec 2000 11:28:52 +0000 (+0000) Subject: lablgtk_20001129* created X-Git-Tag: nogzip~124 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=993347ab3975ccc7c39dc0324255fab4a75bc0e2;p=helm.git lablgtk_20001129* created --- diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0-1.spec b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0-1.spec new file mode 100644 index 000000000..09b4b2eb9 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0-1.spec @@ -0,0 +1,25 @@ +Summary: LablGTK : an interface to the GIMP Tool Kit for OCaml +Name: lablgtk_20001129 +Version: 0.1.0 +Release: 1 +Copyright: LGPL +Group: Development/Libraries +Source: ftp://ftp.kurims.kyoto-u.ac.jp/pub/lang/olabl/lablgtk-20001129.tar.gz +%description +LablGTK is an interface to the GIMP Tool Kit for OCaml. + +%prep +%setup + +%build +make configure +make +make opt + +%install +make install + +%files +%doc CHANGES COPYING README doc + +/usr/lib/ocaml/lablgtk/ diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0.tar.gz b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0.tar.gz new file mode 100644 index 000000000..dbb907aba Binary files /dev/null and b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0.tar.gz differ diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/CHANGES b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/CHANGES new file mode 100644 index 000000000..5b6669cc5 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/CHANGES @@ -0,0 +1,365 @@ +$Id$ + +2000.11.29 + * remove unison port, since unison already works with this snapshot + +2000.11.16 + * internal change: switch from var2def/var2conv to varcc, + and split ml_gtk.c in smaller files + +2000.8.29 + * bugs in color selection reported by Nicolas George + * changed the license + +2000.8.21 + * correct GtkStyle.set_font bug reported by Patrick Doane + +2000.7.27 + * changed GUtil.signal and GUtil.variable for better usability + * suppressed obsolete color settings in tooltips + +2000.6.19 + * patch by Michael Welsh for Gdk regions + +2000.6.15 + * add CList.set_cell_style/set_row_style + * change set_usize/set_uposition into set_geometry + * return an option rather than raise an exception for null pointers + * map empty strings to NULL when meaningful + * Gdk.Font.get_type/ascent/descent + +2000.6.14 + * add GDraw.optcolor for functions with a default (Jerome suggested) + +2000.6.8 + * apply Jerome Vouillon's patch + * changes in GtkSignal and GtkArgv.ml + +2000.6.7 + * create #misc#connect for widget generic signals + +2000.6.6 + * move notebook from GMisc to GPack + * #connect#event, #add_event, #misc#event, #misc#set_events_extension + transferred to #event su-bobject. + * #connect#drag -> #drag#connect. + * #get_type, #connect#disconnect, #connect#stop_emit transferred to #misc. + +2000.5.25 + * split misc.ml into gaux.ml and gpointer.ml + +2000.5.23 + * add GMisc.notebook#get_{tab,menu}_label. Rename nth_page to get_nth_page. + * modified ML signals in GUtil, to allow signals without widget. + +2000.5.22 + * Incompatible!: Change default for ~expand in Box.pack, + Pack.build_options, Table.build_options. Now defaults to false/`NONE. + This means that all options default to false/`NONE, except ~show + (true for all widgets except windows) and ~fill (always true but + effect controlled by ~expand). + * add GtkArgv.get_nativeint and GtkArgv.set_nativeint. + * make offset and length optional in GtkArgv.string_at_pointer. + +2000.5.10 + * rename GtkFrame to GtkBin and GFrame to GBin + * move socket to GBin + +2000.5.9 + * add arrow and image classes to GMisc + * add list and set_item_string methods to GEdit.combo + * add socket and plug classes to GContainer and GWindow + * two new examples: combo.ml and socket.ml + +2000.4.28 + * add GUtil.variable + +2000.4.27 + * add GtkXmHTML widget + +2000.4.26 + * release 1.00 + +2000.4.24 + * merge in changes for ocaml 3.00: label and syntax changes, autolink + * added better visual and colormap handling to Gdk + * GdkObj renamed to GDraw, GtkPixmap moved to GMisc + * Initialize Gtk in gtkInit.cmo/cmx, start a thread in gtkInitThread.cmo. + These are only included in toplevels, link them explicitely or call + GMain.Main.init and GtkThread.start otherwise. + * install to caml standard library + * many other forgotten changes... + +2000.3.02 + * move locale setting inside GtkMain.init, since it requires an + X display + +2000.2.24 + * add checks in add methods, to avoid critical errors + +2000.2.23 + * add dcalendar.ml (submitted by Ken Wakita) and csview.ml + * correct bug in GdkObj.pixmap#line + +1999.12.19 + * release lablGTK beta2 + +1999.12.16 + * upgraded unison to version 1.169 + * radio groups are of type {radio_menu_item,radio_button} obj option, + otherwise you could not use them several times + +1999.12.13 + * added GtkEdit::{insert_text,delete_text} signals + * better syntax highlighting and ergonomy in the browser's shell + +1999.11... + * switched to Objective Caml 3 + * constructors are no longer classes, but simple functions + +1999.10.29 + * changed GtkArgv.get_{string,pointer,object} to return option types + +1999.10.27 + * added radtest/CHANGES for cooperative editing on radtest + +1999.10.21 + * added a UI for unison + (ask bcpierce@saul.cis.upenn.edu about how to get unison) + +1999.10.20 + * corrected CList signals + * moved initialization out of the library, in gtkInit.cmo + +1999.10.15 + * release lablGTK beta1 + +1999.10.13 + * improved gtkThread.ml (no timer) + * modify Sys.argv in place (gtkMain.ml) + * add set_row_data and get_row_data for GtkCList + +1999.10.11 + * bugfixes in Makefile, radtest and lv + +1999.10.6 + * added Gdk.X.flush and Gdk.X.beep + * Gdk.X.flush is exported in GtkMain.Main + +1999.9.9 + * added font selection dialog + +1999.8.25 + * re-added connect#draw + +1999.8.10 + * reduced the number of methods in widget + * moved disconnect and stop_emit to object_signals + * moved ?:after to each signal + * more functions in applications/browser + +1999.8.9 + * Major change: created one set_param method by parameter, + rather than grouping them and using options. + You can get previous versions with tag "changing_set" + * corrected examples, radtest and browser for these changes + * a bit of clean-up in radtest (treew.ml and Makefile) + +1999.8.5 + * corrected a bad bug with indirected pointers in caml heap + +1999.7.15 + * add GdkKeysyms for exotic keysyms + +1999.7.14 + * moved Truecolor inside Gdk + * added COPYING + * prepared for release + +1999.7.12 + * clean up drag-and-drop + +1999.7.9 + * corrected bug in Container.children + * added ML signal support in GUtil + +1999.7.6 + * added DnD, improved radtest (Hubert) + * small corrections (Jacques) + +1999.7.1 + * added some gdk functions related window and ximage + * also added applications/lv, "labl image viewer" with + the camlimage library. + (JPF) + +1999.7.1 + * added applications/lablglade (Koji) + +1999.6.28 + * added applications/radtest (Hubert) + +1999.6.23 + * improved variant conversions for space. + +1999.6.22 + * updated olabl.patch. With this new version you can access fields + of records without opening modules. You can also use several times + the same label in one module. + * examples/GL/morph3d.ml uses it. + +1999.6.21 + * moved event functions to GdkEvent + +1999.6.20 + * new example: radtest.ml (Hubert) + +1999.6.18 + * added GL extension + +1999.6.15 + * grouped set methods into set_ + * added width and height option to all classes + * windows not shown are automatically destroyed by the GC + +1999.6.14 + * added GPack.layout, GPack.packer, GPack.paned, GMisc.notebook, + GRange.scale, GMisc.calendar + * added 3 examples + * #add_events only available on windowed widgets + +1999.6.11 + * added CList widget in GList module, and examples/clist.ml + * improved pixmap abstraction in GdkObj / GPix + +1999.6.10 + * suppressed almost all raw pointers from the code. Pointers are now + either boxed (second field of an abstract block) or marked (lowest + bit set to 1). + +1999.6.9 + * added GtkBase.Object.get_id and GObj.gtkobj#get_id to get an + unique identifier to gtk objects. Nice for hash-tables, etc... + * GUtil.memo is such an hash-table, allowing you to recover an + object's wrapper. + * added a show option to all classes, commanding whether the widget + should be shown immediately. It is by default true on all widgets + except in module GWindow. + * moved non-OO examples to examples/old. Do "cvs update -d old" to + get them. + * changes in Gdk/GtkData/GObj about styles. + +1999.6.8 + * updated olabl.patch + +1999.6.7 + * split gtk.ml into gtk*.ml + +1999.6.5 + * grouped Container focus operations in a "focus" subwidget + +1999.6.4 + * slightly reorganized widget grouping + +1999.6.3 + * disabled gtk_caller + * subtle hack to have GTree get the right interface + * switched completely to the new widget scheme (including examples) + * added olabl.patch to apply to olabl-2.02 to compile new sources + +1999.6.2 + * integrated changes from Hubert in Gtk, GtkObj and testgtk.ml + * added G* modules to replace GtkObj. "make lablgtk2" for it + +1999.6.1 + * added experimental GtkMenu for a cleaner approach to OO (Jacques) + +1999.5.31 + * GtkObj: list, tree and menu_shell inherit from item_container (Jacques) + * Argv.get_{string,pointer,object} may raise Null_pointer (Jacques) + * Support for creating new widgets (Hubert) + +1999.5.28 + * a few stylistic corrections + * added Packer in gtk.ml + +1999.5.27 + * new Gtk.Main.main Gtk.Main.quit and GtkThread.main (for modal windows) + * added x: and y: to Window.setter + * new methods: object#get_type widget#misc#lock_accelerators + widget#misc#visible widget#misc#parent container#set_focus#vadjustment + container#set_focus#hadjustment (could be container#set_focus#adjustment with a dir param) + window#set_modal window#set_position window#set_default_size + window#set_transient_for + menu#set_accel_group + * new classes: handle_box_skel handle_box_signals handle_box + bbox color_selection color_selection_dialog toolbar + and the corresponding modules in gtk.ml + new class type: is_window and method as_window + * new param tearoff: in new_menu_item + new param x: and y: modal: in Window.setter + * Widget.event and Widget.activate return bool + * new example: examples/testgtk.ml and test.xpm + (Hubert) + +1999.5.25 + * upgraded to gtk+-1.2.3 (all examples work) + * suppressed deprecated function calls and corrected examples + * added a patch to use toplevel threads in olabl-2.02 + +1998.12.13 + * upgraded to olabl-2.01 + +1998.12.9 + * replicated Main, Timeout and Grab to GtkObj (no need to open Gtk anymore) + * moved some non standard classes to GtkExt + +1998.12.8 + * added the first application, xxaplay, Playstation audio track + player for linux. (How architecture specific!) (Furuse) + +1998.12.8 + * more widgets in GtkObj + * refined memory management + * all variants in upper case + +1998.12.7 + * after deeper thought, re-introduced the connect sub-object + * simplified GtkObj: use simple inheritance and allow easy subtyping + * updated olabl.diffs for bugs in class functions parsing and printing + * add ThreadObj for concurrent object programming + (Jacques) + +1998.12.3 + * pousse.ml is now a reversi game (idea for strategy ?) + * solved startup bug (a value checker for ocaml is now available) + (Jacques) + +1998.12.2 + * added GdkObj for high level drawing primitives (Jacques) + +1998.11.30 + * removed cast checking for NULL valued widgets (ml_gtk.[ch]) + * module Arg is renamed as GtkArg because of the name corrision with + the module Arg in the standard library + * Makefile : native code compilation added + (Furuse) + +1998.11.29 + * renamed widget_ops sub-object to misc + * various improvements of set functions + (Jacques) + +1998.11.28 + * switched to object-oriented model. GtkObj is now the standard way + to access the library, but not all objects are ready (see README) + * removed inheritance in gtk.ml + (Jacques) + +1998.11.24 + * added inheritance in gtk.ml + +1998.11.22 + * added gtkObj.ml and examples/*_obj.ml + * various modifications in gtk.ml + diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/COPYING b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/COPYING new file mode 100644 index 000000000..d417b8b7e --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/COPYING @@ -0,0 +1,28 @@ +This library is made available under the LGPL. +You should have got a copy of the LGPL with Objective Caml. +The LGPL applies to all the files in this directory, but not in +subdirectories. + +For the examples subdirectory, there is no specific licensing policy, +but you may freely take inspiration from the code, and copy parts of +it in your application. + +For the applications subdirectory, stricter rules apply: + +* You are free to do anything you want with this code as long as it is + for personal use. + +* Redistribution can only be "as is". Binary distribution and bug + fixes are allowed, but you cannot extensively modify the code + without asking the authors. + +The authors may choose to remove any of the above restrictions on a +per request basis. + +Authors: + Jacques Garrigue + Hubert Fauque + Jun Furuse + Koji Kagawa + +$Id$ \ No newline at end of file diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/Makefile b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/Makefile new file mode 100644 index 000000000..a0ac04f33 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/Makefile @@ -0,0 +1,187 @@ +# $Id$ +# Makefile for lablgtk. + +TARGETS = varcc lablgtktop lablgtktop_t lablgtkrun lablgtk + +all: $(TARGETS) + +opt: lablgtkopt + +configure: + @rm -f config.make + @$(MAKE) --no-print-directory -f configure.mk + +depend: + @rm -f .depend + @$(MAKE) --no-print-directory -f configure.mk .depend + +.depend config.make: + @$(MAKE) --no-print-directory -f configure.mk + +COMPILER = $(CAMLC) $(MLFLAGS) -w s -labels -c +LINKER = $(CAMLC) $(MLFLAGS) +COMPOPT = $(CAMLOPT) $(MLFLAGS) -w s -labels -c +LINKOPT = $(CAMLOPT) $(MLFLAGS) +TOPLEVEL = ocamlmktop $(MLFLAGS) + +include config.make + +INSTALLDIR = $(LIBDIR)/lablgtk +LABLGLDIR = $(LIBDIR)/lablGL + +MLLIBS = lablgtk.cma +CLIBS = liblablgtk.a +MLLINK = unix.cma str.cma + +ifdef DEBUG +CFLAGS = -g $(GTKCFLAGS) +MLLINK += -cclib -lcamlrund +MLFLAGS = -g +else +CFLAGS = -O -DGTK_NO_CHECK_CASTS -DGTK_DISABLE_COMPAT_H $(GTKCFLAGS) +endif + +THFLAGS = -thread +THLINK = unix.cma threads.cma + +ifdef USE_CC +CCOMPILER = $(CC) -c -I$(LIBDIR) $(CFLAGS) +else +CCOMPILER = ocamlc -c -ccopt "$(CFLAGS)" +endif + +ifdef USE_GL +MLFLAGS += -I $(LABLGLDIR) +MLLINK += lablgl.cma +MLLIBS += lablgtkgl.cma +CLIBS += liblablgtkgl.a +GLLINK = -cclib -llablgtkgl -cclib -lgtkgl +GLMLOBJS = glGtk.cmo +GLCOBJS = ml_gtkgl.o + +endif + +ifdef USE_GNOME +MLLIBS += lablgnome.cma +CLIBS += liblablgnome.a +GNOMEMLOBJS = gtkXmHTML.cmo gHtml.cmo +GNOMECOBJS = ml_gtkxmhtml.o +endif + +# Rules +.SUFFIXES: .ml .mli .cmo .cmi .cmx .c .o .var .h .opt .def +.c.o: + $(CCOMPILER) $< +.ml.cmo: + $(COMPILER) $< +.mli.cmi: + $(COMPILER) $< +.ml.cmx: + $(COMPOPT) $< +.var.h: + ./varcc $< + +# Targets +GTKOBJS = ml_gtk.o ml_gtkbin.o ml_gtkbutton.o ml_gtkedit.o ml_gtklist.o \ + ml_gtkmenu.o ml_gtkmisc.o ml_gtknew.o ml_gtkpack.o ml_gtkrange.o \ + ml_gtktree.o +COBJS = ml_gdk.o ml_glib.o wrappers.o $(GTKOBJS) +MLOBJS = gaux.cmo gpointer.cmo glib.cmo gdk.cmo gdkEvent.cmo gdkKeysyms.cmo \ + gtk.cmo gtkArgv.cmo gtkSignal.cmo \ + gtkData.cmo gtkBase.cmo gtkPack.cmo gtkButton.cmo \ + gtkMenu.cmo gtkMisc.cmo gtkWindow.cmo gtkTree.cmo gtkList.cmo \ + gtkBin.cmo gtkEdit.cmo gtkRange.cmo gtkMain.cmo gtkNew.cmo \ + gDraw.cmo \ + gObj.cmo gMain.cmo gData.cmo gContainer.cmo gPack.cmo gButton.cmo \ + gMenu.cmo gMisc.cmo gWindow.cmo gTree.cmo gList.cmo gBin.cmo \ + gEdit.cmo gRange.cmo gUtil.cmo +THOBJS = gtkThread.cmo +INITOBJS = gtkInit.cmo +THINITOBJS = gtkThInit.cmo +ALLOBJS = $(MLOBJS) $(GLMLOBJS) $(GNOMEMLOBJS) $(THOBJS) \ + $(INITOBJS) $(THINITOBJS) + +lablgtktop: $(CLIBS) $(MLLIBS) $(INITOBJS) + $(TOPLEVEL) -o $@ $(MLLINK) -ccopt -L. $(MLLIBS) $(INITOBJS) + +lablgtktop_t: $(CLIBS) $(MLLIBS) $(THOBJS) $(INITOBJS) $(THINITOBJS) + $(TOPLEVEL) $(THFLAGS) -o $@ $(THLINK) $(MLLINK) \ + -ccopt -L. $(MLLIBS) $(THOBJS) $(INITOBJS) $(THINITOBJS) + +lablgtk: Makefile config.make lablgtk.in + sed -e "s|@INSTALLDIR@|$(INSTALLDIR)|g" \ + -e "s|@LABLGLDIR@|$(LABLGLDIR)|g" \ + -e "s|@LIBDIR@|$(LIBDIR)|g" \ + < lablgtk.in > $@ + chmod 755 $@ + +lablgtkrun: $(CLIBS) $(MLLIBS) + $(LINKER) -o $@ -make-runtime $(MLLINK) -ccopt -L. $(MLLIBS) + +lablgtkopt: $(CLIBS) $(MLLIBS:.cma=.cmxa) $(INITOBJS:.cmo=.cmx) \ + $(THOBJS:.cmo=.cmx) + +install: + if test -d $(INSTALLDIR); then : ; else mkdir -p $(INSTALLDIR); fi + cp $(ALLOBJS:.cmo=.cmi) $(INSTALLDIR) + cp *.mli $(INSTALLDIR) + cp *.h $(INSTALLDIR) + cp $(ALLOBJS:.cmo=.ml) $(INSTALLDIR) + cp $(MLLIBS) $(THOBJS) $(INITOBJS) $(THINITOBJS) $(INSTALLDIR) + cp $(CLIBS) $(INSTALLDIR) + cp lablgtktop lablgtktop_t $(INSTALLDIR) + cp lablgtk lablgtkrun $(BINDIR) + if test -f lablgtk.cmxa; then \ + cp $(MLLIBS:.cma=.cmxa) $(MLLIBS:.cma=.a) \ + $(INITOBJS:.cmo=.cmx) $(INITOBJS:.cmo=.o) $(INSTALLDIR); fi + if test -f gtkThread.cmx; then \ + cp $(THOBJS:.cmo=.cmx) $(THOBJS:.cmo=.o) $(INSTALLDIR); fi + +liblablgtk.a: $(COBJS) + ar rc $@ $(COBJS) + $(RANLIB) $@ +lablgtk.cma: $(MLOBJS) + $(LINKER) -a -custom -o $@ $(MLOBJS) \ + -cclib -llablgtk $(GTKLIBS) +lablgtk.cmxa: $(MLOBJS:.cmo=.cmx) + $(LINKOPT) -a -o $@ $(MLOBJS:.cmo=.cmx) \ + -cclib -llablgtk $(GTKLIBS) + +liblablgtkgl.a: $(GLCOBJS) + ar rc $@ $(GLCOBJS) + $(RANLIB) $@ +lablgtkgl.cma: $(GLMLOBJS) + $(LINKER) -a -custom -o $@ $(GLLINK) $(GLMLOBJS) +lablgtkgl.cmxa: $(GLMLOBJS:.cmo=.cmx) + $(LINKOPT) -a -o $@ $(GLLINK) $(GLMLOBJS:.cmo=.cmx) + +liblablgnome.a: $(GNOMECOBJS) + ar rc $@ $(GNOMECOBJS) + $(RANLIB) $@ +lablgnome.cma: $(GNOMEMLOBJS) + $(LINKER) -a -custom -o $@ $(GNOMEMLOBJS) \ + -cclib -llablgnome $(GNOMELIBS) +lablgnome.cmxa: $(GNOMEMLOBJS:.cmo=.cmx) + $(LINKOPT) -a -o $@ $(GNOMEMLOBJS:.cmo=.cmx) \ + -cclib -llablgnome $(GNOMELIBS) + +gtkThread.cmo: gtkThread.ml + $(COMPILER) $(THFLAGS) gtkThread.ml + +gtkThread.cmx: gtkThread.ml + if test -f $(LIBDIR)/libthreadsnat.a; then \ + $(COMPOPT) $(THFLAGS) gtkThread.ml; fi + +varcc: varcc.cmo + $(LINKER) -o $@ varcc.cmo + rm -f *_tags.h *_tags.c + +clean: + rm -f *.cm* *.o *.a *_tags.[ch] $(TARGETS) + +$(GTKOBJS): gtk_tags.h ml_gtk.h ml_gdk.h wrappers.h +ml_gdk.o: gdk_tags.h ml_gdk.h wrappers.h +ml_gtkgl.o: gtkgl_tags.h ml_gtk.h ml_gdk.h wrappers.h +ml_gtkxmhtml.o: gtkxmhtml_tags.h ml_gtk.h ml_gdk.h wrappers.h + +include .depend diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/Makefile.nt b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/Makefile.nt new file mode 100644 index 000000000..bdf5b6cfd --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/Makefile.nt @@ -0,0 +1,147 @@ +# $Id$ +# Makefile for lablgtk. + +EXE = .exe +TARGETS = var2conv var2def lablgtk$(EXE) lablgtk_t$(EXE) \ + lablgtkrun$(EXE) config.make + +all: $(TARGETS) + +opt: lablgtkopt + +CAMLC = ocamlc +CAMLOPT = ocamlopt +COMPILER = $(CAMLC) $(MLFLAGS) -w s -labels -c +LINKER = $(CAMLC) $(MLFLAGS) +COMPOPT = $(CAMLOPT) $(MLFLAGS) -w s -labels -c +LINKOPT = $(CAMLOPT) $(MLFLAGS) + +TOPLEVEL = ocamlmktop $(MLFLAGS) +### How to invoke the librarian +MKLIB=lib /nologo /debugtype:CV /out: + +!include config.make.nt + +INSTALLDIR = $(LIBDIR:/=\)\lablgtk +BINDIR = $(LIBDIR:/=\)\..\bin +LABLGLDIR = $(LIBDIR)/lablGL + +CFLAGS = -O -DGTK_NO_CHECK_CASTS -DGTK_DISABLE_COMPAT_H $(GTKCFLAGS) +LDFLAGS = $(GTKLIBS) + +THFLAGS = -thread +THLIBS = unix.cma threads.cma + +!if $(USE_CC) == 1 +CCOMPILER = $(CC) -c -I$(LIBDIR) $(CFLAGS) +!else +CCOMPILER = ocamlc -c -ccopt "$(CFLAGS)" +!endif + +!if $(USE_GL) == 1 +MLFLAGS = $(MLFLAGS) -I $(LIBDIR)/lablGL +GLLINK = -I $(LABLGLDIR) lablgl.cma -cclib -lgtkgl +GLMLOBJS = glGtk.cmo +GLCOBJS = ml_gtkgl.o +!endif + +# Rules +.SUFFIXES: .ml .mli .cmo .cmi .cmx .c .obj .var .h .opt .def +.c.obj: + $(CCOMPILER) $< +.ml.cmo: + $(COMPILER) $< +.mli.cmi: + $(COMPILER) $< +.ml.cmx: + $(COMPOPT) $< +.var.h: + ocamlrun ./var2def < $< > $@ +.var.c: + ocamlrun ./var2conv < $< > $@ + +# Targets +COBJS = ml_gtk.obj ml_gdk.obj ml_glib.obj wrappers.obj $(GLCOBJS) +OLDMLOBJS = misc.cmo glib.cmo gdk.cmo gtk.cmo gdkObj.cmo gtkObj.cmo gtkExt.cmo +MLOBJS = misc.cmo glib.cmo gdk.cmo gdkEvent.cmo gdkKeysyms.cmo \ + gtk.cmo gtkArgv.cmo gtkSignal.cmo \ + gtkData.cmo gtkBase.cmo gtkPack.cmo gtkButton.cmo \ + gtkMenu.cmo gtkMisc.cmo gtkWindow.cmo gtkTree.cmo gtkList.cmo \ + gtkFrame.cmo gtkEdit.cmo gtkRange.cmo gtkMain.cmo gtkNew.cmo \ + gDraw.cmo \ + gObj.cmo gMain.cmo gData.cmo gContainer.cmo gPack.cmo gButton.cmo \ + gMenu.cmo gMisc.cmo gWindow.cmo gTree.cmo gList.cmo gFrame.cmo \ + gEdit.cmo gRange.cmo gUtil.cmo $(GLMLOBJS) +THOBJS = gtkThread.cmo threadObj.cmo +INITOBJS = gtkInit.cmo +THINITOBJS = gtkThInit.cmo +ALLOBJS = $(MLOBJS) $(THOBJS) $(INITOBJS) $(THINITOBJS) + +lablgtk$(EXE): liblablgtk.lib lablgtk.cma $(INITOBJS) + $(TOPLEVEL) -custom -o $@ unix.cma str.cma $(GLLINK) \ + lablgtk.cma $(INITOBJS) + +lablgtk_t$(EXE): liblablgtk.lib lablgtk.cma $(THOBJS) $(INITOBJS) $(THINITOBJS) + $(TOPLEVEL) -custom $(THFLAGS) -o $@ $(THLIBS) str.cma $(GLLINK) \ + lablgtk.cma $(THOBJS) $(INITOBJS) $(THINITOBJS) + +lablgtkrun$(EXE): liblablgtk.lib lablgtk.cma + $(LINKER) -o $@ -make-runtime $(GLLINK) lablgtk.cma + +lablgtkopt: liblablgtk.lib lablgtk.cmxa gtkInit.cmx + +install: + if not exist $(INSTALLDIR) mkdir $(INSTALLDIR) + cp $(ALLOBJS:.cmo=.cmi) $(INSTALLDIR) + cp *.mli $(INSTALLDIR) + cp $(ALLOBJS:.cmo=.ml) $(INSTALLDIR) + cp lablgtk.cma $(THOBJS) $(INITOBJS) $(THINITOBJS) $(INSTALLDIR) + cp liblablgtk.lib $(INSTALLDIR) + cp lablgtk$(EXE) lablgtk_t$(EXE) lablgtkrun$(EXE) $(BINDIR) + if exist lablgtk.cmxa cp lablgtk.cmxa lablgtk.lib gtkInit.cmx gtkInit.obj $(INSTALLDIR) + +liblablgtk.lib: $(COBJS) + $(MKLIB)$@ $(COBJS) + +lablgtk.cma: $(MLOBJS) + $(LINKER) -a -custom -o $@ $(MLOBJS) \ + -cclib -llablgtk $(GTKLIBS) + +lablgtk.cmxa: $(MLOBJS:.cmo=.cmx) + $(LINKOPT) -a -o $@ $(MLOBJS:.cmo=.cmx) \ + -cclib -llablgtk $(GTKLIBS) + +gtkThread.cmo: gtkThread.ml + $(COMPILER) $(THFLAGS) gtkThread.ml + +threadObj.cmo: threadObj.ml + $(COMPILER) $(THFLAGS) threadObj.ml + +gtkThread.cmx: gtkThread.ml + $(COMPOPT) $(THFLAGS) gtkThread.ml + +threadObj.cmx: threadObj.ml + $(COMPOPT) $(THFLAGS) threadObj.ml + +var2conv: var2conv.cmo + $(LINKER) -o $@ var2conv.cmo + rm -f *_tags.c + +var2def: var2def.cmo + $(LINKER) -o $@ var2def.cmo + rm -f *_tags.h + +clean: + rm -f *.cm* *.obj *.lib *_tags.[ch] $(TARGETS) + +config.make: config.make.nt + cp config.make.nt config.make + +depend .depend: + ocamldep *.ml *.mli > .depend + +ml_gtk.obj: gtk_tags.c gtk_tags.h ml_gtk.h ml_gdk.h wrappers.h +ml_gdk.obj: gdk_tags.c gdk_tags.h ml_gdk.h wrappers.h +ml_gtkgl.obj: gtkgl_tags.c gtkgl_tags.h ml_gtk.h ml_gdk.h wrappers.h + +!include .depend diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/README b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/README new file mode 100644 index 000000000..78c4ed3da --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/README @@ -0,0 +1,239 @@ + + LablGTK : an interface to the GIMP Tool Kit + + +Needed: + ocaml-3.00 + gtk-1.2.x + gmake (there is no standard for conditionals) + +How to compile: + + You should normally not need to modify Makefiles. + First type "make configure ". + Options are + USE_CC=1 to use $(CC) rather than gcc + USE_GL=1 to compile with OpenGL support (see lower) + USE_GNOME=1 to compile GtkXmHTML support (requires gnome) + + Then just type "make" to build the library and toplevels. + + On FreeBSD, you need to link with libxpg4.so for Japanese + output. + +Contents: + + gdk.ml low-level interface to the General Drawing Kit + gtk.ml low-level interface to the GIMP Tool Kit + gtkThread.ml main loop for threaded version + g[A-Z]*.ml object-oriented interface to GTK + gdkObj.ml object-oriented interface to GDK + + lablgtk toplevel + + examples/*.ml various examples + applications/* applications using the library + radtest a very experimental RAD for lablgtk + (by Hubert Fauque) + browser the begin of a port of OCamlBrowser + (by Jacques Garrigue) + unison a frontend for the Unison file synchronizer + see the README for details. + +Upgrading from lablgtk-1.00: + There are a few incompatibilities between this version and the + previous release. We do not describe them all, since usually a type + error message will inform you. + * all signals are no longer under #connect. #connect#event changed + to #event#connect, and some signals are under #misc#connect or + #grab#connect. See lower for a description of the new widget + structure. + * some defaults changed. In particular GPack.box#pack have now all + its parameter defaulting to false rather than true. See lower for + the new default policy. Beware that this does not cause type + errors, just changes in the aspect. + +How to run the examples: + In the examples directory just type: + lablgtk -labels examples/???.ml + + Before installing lablgtk you have to be more explicit: + ../lablgtktop -labels -w s -I .. ???.ml + +How to link them: + lablgtktop contains an extra module GtkInit, whose only contents is: + let locale = GtkMain.Main.init () + You must either add this line, or add this module to your link, + before calling any Gtk function. + ocamlc -I CAMLLIB/lablgtk -labels -w s lablgtk.cma gtkInit.cmo ???.ml -o ??? + +How to use the threaded toplevel: + + % lablgtk -thread (or lablgtktop_t before installing) + Objective Caml version 3.00 + + # let w = GWindow.window ~show:true ();; + + You should at once see a window appear. + The GTK main loop is running in a separate thread. Any command + is immediately reflected by the system. + Beware that you cannot switch threads within a callback, that is the + only thread related command you may use in a callback is + Thread.create. On the other hand, all newly created threads will be + run directly by the caml main loop, so they can use all thread + operations. + +Structure of the (raw) Gtk* modules: + + These modules are composed of one submodule for each class. + Signals specific to a widget are in a Signals inner module. + A setter function is defined to give access to set_param functions. + +Structure of the G[A-Z]* modules: + + These modules provide classes to wrap the raw function calls. + Here are the widget classes contained in each module: + + GDraw Gdk pixmaps, etc... + GObj gtkobj, widget, style + GData data, adjustment, tooltips + GContainer container, item_container + GWindow window, dialog, color_selection_dialog, file_selection, plug + GPack box, button_box, table, fixed, layout, packer, paned, notebook + GBin scrolled_window, event_box, handle_box, frame, + aspect_frame, viewport, socket + GButton button, toggle_button, check_button, radio_button, toolbar + GMenu menu_item, tearoff_item, check_menu_item, radio_menu_item, + menu_shell, menu, option_menu, menu_bar, factory + GMisc separator, statusbar, calendar, drawing_area, + misc, arrow, image, pixmap, label, tips_query, + color_selection, font_selection + GTree tree_item, tree + GList list_item, liste, clist + GEdit editable, entry, spin_button, combo, text + GRange progress, progress_bar, range, scale, scrollbar + + While subtyping follows the Gtk widget hierarchy, you cannot always + use width subtyping (i.e. #super is not unifiable with all the + subclasses of super). Still, it works for some classes, like + #widget and #container, and allows subtyping without coercion towards + these classes (cf. #container in pousse.ml for instance). + + Practically, each widget class is composed of: + * a coerce method, returning the object coerced to the type widget. + * an as_widget method, returning the raw Gtk widget used for packing, etc... + * a connect sub-object, allowing one to widget specific + signals (this is what prevents width subtyping in subclasses.) + * a misc sub-object, giving access to miscellanous functionality of + the basic gtkwidget class, and a misc#connect sub-object. + * an event sub-object, for Xevent related functions (only if the widget + has an Xwindow), and an event#connect sub-object. + * a grab sub-object, containing drag and drop functions, + and a grab#connect sub-object. + * widget specific methods. + + Here is a diagram of the structure (- for methods, + for sub-objects) + - coerce : widget + - as_widget : Gtk.widget obj + - destroy : unit -> unit + - ... + + connect : mywidget_signals + | - after + | - signal_name : callback:(... -> ...) -> GtkSignal.id + + misc : misc_ops + | - show, hide, disconnect, ... + | + connect : misc_signals + + event : event_ops + | - add, ... + | + connect : event_signals + + grab : grab_ops + | - ... + | + connect : grab_signals + + You create a widget by [. options ... ()]. + Many optional arguments are admitted. The last two of them, packing: + and show:, allow you respectively to call a function on your newly + created widget, and to decide wether to show it immediately or not. + By default all widgets except toplevel windows (GWindow module) are + shown immediately. + +Default arguments: + For many constructor or method arguments, default values are provided. + Generally, this default value is defined by GTK, and you must refer + to GTK's documentation. + For ML defined defaults, usually default values are either false, 0, None + or `NONE, according to the expected type. + Important exceptions are ~show, which default to true in all widgets + except those in GWindow, and ~fill, which defaults to true or `BOTH. + +Note about unit as method argument: + + O'Caml introduces no distinction between methods having side-effects + and methods simply returning a value. In practice, this is + confusing, and awkward when used as callbacks. For this reason all + methods having noticeable side-effects should take arguments, and + unit if they have no argument. + +Memory management: + + Important efforts have been dedicated to cooperate with Gtk's + reference counting mechanism. As a result you should generally be + able to use Gdk/Gtk data structures without caring about memory + management. They will be freed when nobody points to them any more. + This also means that you do not need to pay too much attention to + whether a data structure is still alive or not. If it is not, you + should get an error rather than a core dump. + The case of Gtk objects deserves special care. Since they are + interactive, we cannot just destroy them when they are no longer + referenced. They have to be explicitely destroyed. If a widget was + added to a container widget, it will automatically be destroyed when + its last container is destroyed. For this reason you need only + destroy toplevel widgets. + +GL extension + + You can use lablgtk in combination with LablGL + + * get and install lablGL 0.94 from + http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgl.html + * get and install gtkglarea-1.2.x.tar.gz from + http://www.student.oulu.fi/~jlof/gtkglarea/index.html + * reconfigure: "make configure USE_GL=1" + + You can then use the widget GlGtk.gl_area as an OpenGL window. + Some examples are in examples/GL, but basically any LablGL example + can be easily ported. + +Windows port + + A Win32 port is provided. In order to compile it, you will need to + get and unpack glib-dev-????.zip and gtk+-dev-????.zip from + http://www.gimp.org/~tml/gimp/win32/ + Do not forget to get also extralibs-dev-????.zip, since you will + need some of the DLLs. + + Edit config.make.nt, then, using Visual C++, + nmake -f Makefile.nt + nmake -f Makefile.nt opt (if you have an MS Assembler) + Then install with + nmake -f Makefile.nt install + + Since the link is dynamic you will also need to have in your path: + gnu-intl.dll (extralibs), glib-1.3.dll, module-1.3.dll and + gthread-1.3.dll (glib), gdk-1.3.dll and gtk-1.3.dll (gtk+). + + I checked with the 2000-02-02 version of these libraries. + Currently threads do not seem to work, but otherwise everything + seems OK. In particular, you can run all examples, and build + applications\unison as usual. + +Authors: + Jacques Garrigue + Hubert Fauque + Jun Furuse + Koji Kagawa + +Bug reports: + Jacques Garrigue + +$Id$ diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gBin.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gBin.ml new file mode 100644 index 000000000..f248ba0f8 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gBin.ml @@ -0,0 +1,153 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase +open GtkBin +open GObj +open GContainer + +class scrolled_window obj = object + inherit container_full (obj : Gtk.scrolled_window obj) + method hadjustment = + new GData.adjustment (ScrolledWindow.get_hadjustment obj) + method vadjustment = + new GData.adjustment (ScrolledWindow.get_vadjustment obj) + method set_hadjustment adj = + ScrolledWindow.set_hadjustment obj (GData.as_adjustment adj) + method set_vadjustment adj = + ScrolledWindow.set_vadjustment obj (GData.as_adjustment adj) + method set_hpolicy hpolicy = ScrolledWindow.set_policy' obj ~hpolicy + method set_vpolicy vpolicy = ScrolledWindow.set_policy' obj ~vpolicy + method set_placement = ScrolledWindow.set_placement obj + method add_with_viewport w = + ScrolledWindow.add_with_viewport obj (as_widget w) +end + +let scrolled_window ?hadjustment ?vadjustment ?hpolicy ?vpolicy + ?placement ?border_width ?width ?height ?packing ?show () = + let w = + ScrolledWindow.create () + ?hadjustment:(may_map ~f:GData.as_adjustment hadjustment) + ?vadjustment:(may_map ~f:GData.as_adjustment vadjustment) in + ScrolledWindow.set w ?hpolicy ?vpolicy ?placement; + Container.set w ?border_width ?width ?height; + pack_return (new scrolled_window w) ~packing ~show + +class event_box obj = object + inherit container_full (obj : Gtk.event_box obj) + method event = new GObj.event_ops obj +end + +let event_box ?border_width ?width ?height ?packing ?show () = + let w = EventBox.create () in + Container.set w ?border_width ?width ?height; + pack_return (new event_box w) ~packing ~show + +class handle_box_signals obj = object + inherit container_signals obj + method child_attached ~callback = + GtkSignal.connect ~sgn:HandleBox.Signals.child_attached obj ~after + ~callback:(fun obj -> callback (new widget obj)) + method child_detached ~callback = + GtkSignal.connect ~sgn:HandleBox.Signals.child_detached obj ~after + ~callback:(fun obj -> callback (new widget obj)) +end + +class handle_box obj = object + inherit container (obj : Gtk.handle_box obj) + method set_shadow_type = HandleBox.set_shadow_type obj + method set_handle_position = HandleBox.set_handle_position obj + method set_snap_edge = HandleBox.set_snap_edge obj + method connect = new handle_box_signals obj + method event = new GObj.event_ops obj +end + +let handle_box ?border_width ?width ?height ?packing ?show () = + let w = HandleBox.create () in + let () = Container.set w ?border_width ?width ?height in + pack_return (new handle_box w) ~packing ~show + +class frame_skel obj = object + inherit container obj + method set_label = Frame.set_label obj + method set_label_align ?x ?y () = Frame.set_label_align' obj ?x ?y + method set_shadow_type = Frame.set_shadow_type obj +end + +class frame obj = object + inherit frame_skel (Frame.coerce obj) + method connect = new container_signals obj +end + +let frame ?(label="") ?label_xalign ?label_yalign ?shadow_type + ?border_width ?width ?height ?packing ?show () = + let w = Frame.create label in + Frame.set w ?label_xalign ?label_yalign ?shadow_type; + Container.set w ?border_width ?width ?height; + pack_return (new frame w) ~packing ~show + +class aspect_frame obj = object + inherit frame_skel (obj : Gtk.aspect_frame obj) + method connect = new container_signals obj + method set_alignment ?x ?y () = AspectFrame.set obj ?xalign:x ?yalign:y + method set_ratio ratio = AspectFrame.set obj ~ratio + method set_obey_child obey_child = AspectFrame.set obj ~obey_child +end + +let aspect_frame ?label ?xalign ?yalign ?ratio ?obey_child + ?label_xalign ?label_yalign ?shadow_type + ?border_width ?width ?height ?packing ?show () = + let w = + AspectFrame.create ?label ?xalign ?yalign ?ratio ?obey_child () in + Frame.set w ?label_xalign ?label_yalign ?shadow_type; + Container.set w ?border_width ?width ?height; + pack_return (new aspect_frame w) ~packing ~show + +class viewport obj = object + inherit container_full (obj : Gtk.viewport obj) + method event = new event_ops obj + method set_hadjustment adj = + Viewport.set_hadjustment obj (GData.as_adjustment adj) + method set_vadjustment adj = + Viewport.set_vadjustment obj (GData.as_adjustment adj) + method set_shadow_type = Viewport.set_shadow_type obj + method hadjustment = new GData.adjustment (Viewport.get_hadjustment obj) + method vadjustment = new GData.adjustment (Viewport.get_vadjustment obj) +end + +let viewport ?hadjustment ?vadjustment ?shadow_type + ?border_width ?width ?height ?packing ?show () = + let w = Viewport.create () + ?hadjustment:(may_map ~f:GData.as_adjustment hadjustment) + ?vadjustment:(may_map ~f:GData.as_adjustment vadjustment) in + may shadow_type ~f:(Viewport.set_shadow_type w); + Container.set w ?border_width ?width ?height; + pack_return (new viewport w) ~packing ~show + +class alignment obj = object + inherit container_full (obj : Gtk.alignment obj) + method set_alignment ?x ?y () = Alignment.set ?x ?y obj + method set_scale ?x ?y () = Alignment.set ?xscale:x ?yscale:y obj +end + +let alignment ?x ?y ?xscale ?yscale + ?border_width ?width ?height ?packing ?show () = + let w = Alignment.create ?x ?y ?xscale ?yscale () in + Container.set w ?border_width ?width ?height; + pack_return (new alignment w) ~packing ~show + +let alignment_cast w = new alignment (Alignment.cast w#as_widget) + +class socket obj = object (self) + inherit container_full (obj : Gtk.socket obj) + method steal = Socket.steal obj + method xwindow = + self#misc#realize (); + Gdk.Window.get_xwindow self#misc#window +end + +let socket ?border_width ?width ?height ?packing ?show () = + let w = Socket.create () in + Container.set w ?border_width ?width ?height; + pack_return (new socket w) ?packing ?show diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gBin.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gBin.mli new file mode 100644 index 000000000..9593650c3 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gBin.mli @@ -0,0 +1,163 @@ +(* $Id$ *) + +open Gtk +open GObj +open GContainer + +class scrolled_window : Gtk.scrolled_window obj -> + object + inherit container_full + val obj : Gtk.scrolled_window obj + method add_with_viewport : widget -> unit + method hadjustment : GData.adjustment + method set_hadjustment : GData.adjustment -> unit + method set_hpolicy : Tags.policy_type -> unit + method set_placement : Tags.corner_type -> unit + method set_vadjustment : GData.adjustment -> unit + method set_vpolicy : Tags.policy_type -> unit + method vadjustment : GData.adjustment + end +val scrolled_window : + ?hadjustment:GData.adjustment -> + ?vadjustment:GData.adjustment -> + ?hpolicy:Tags.policy_type -> + ?vpolicy:Tags.policy_type -> + ?placement:Tags.corner_type -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> scrolled_window + +class event_box : Gtk.event_box obj -> + object + inherit container_full + val obj : Gtk.event_box obj + method event : event_ops + end +val event_box : + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> event_box + +class handle_box_signals : 'a obj -> + object + inherit container_signals + constraint 'a = [>`handlebox|`container|`widget] + val obj : 'a obj + method child_attached : callback:(widget -> unit) -> GtkSignal.id + method child_detached : callback:(widget -> unit) -> GtkSignal.id + end + +class handle_box : Gtk.handle_box obj -> + object + inherit container + val obj : Gtk.handle_box obj + method event : event_ops + method connect : handle_box_signals + method set_handle_position : Tags.position -> unit + method set_shadow_type : Tags.shadow_type -> unit + method set_snap_edge : Tags.position -> unit + end +val handle_box : + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> handle_box + +class frame_skel : 'a obj -> + object + inherit container + constraint 'a = [>`frame|`container|`widget] + val obj : 'a obj + method set_label : string -> unit + method set_label_align : ?x:clampf -> ?y:clampf -> unit -> unit + method set_shadow_type : Tags.shadow_type -> unit + end +class frame : [>`frame] obj -> + object + inherit frame_skel + val obj : Gtk.frame obj + method connect : GContainer.container_signals + end +val frame : + ?label:string -> + ?label_xalign:clampf -> + ?label_yalign:clampf -> + ?shadow_type:Tags.shadow_type -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> frame + +class aspect_frame : Gtk.aspect_frame obj -> + object + inherit frame + val obj : Gtk.aspect_frame obj + method set_alignment : ?x:clampf -> ?y:clampf -> unit -> unit + method set_obey_child : bool -> unit + method set_ratio : clampf -> unit + end +val aspect_frame : + ?label:string -> + ?xalign:clampf -> + ?yalign:clampf -> + ?ratio:float -> + ?obey_child:bool -> + ?label_xalign:clampf -> + ?label_yalign:clampf -> + ?shadow_type:Tags.shadow_type -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> aspect_frame + +class viewport : Gtk.viewport obj -> + object + inherit container_full + val obj : Gtk.viewport obj + method event : event_ops + method hadjustment : GData.adjustment + method set_hadjustment : GData.adjustment -> unit + method set_shadow_type : Gtk.Tags.shadow_type -> unit + method set_vadjustment : GData.adjustment -> unit + method vadjustment : GData.adjustment + end +val viewport : + ?hadjustment:GData.adjustment -> + ?vadjustment:GData.adjustment -> + ?shadow_type:Tags.shadow_type -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> viewport + +class alignment : Gtk.alignment obj -> + object + inherit container_full + val obj : Gtk.alignment obj + method set_alignment : ?x:Gtk.clampf -> ?y:Gtk.clampf -> unit -> unit + method set_scale : ?x:Gtk.clampf -> ?y:Gtk.clampf -> unit -> unit + end +val alignment : + ?x:Gtk.clampf -> + ?y:Gtk.clampf -> + ?xscale:Gtk.clampf -> + ?yscale:Gtk.clampf -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> alignment +val alignment_cast : < as_widget : 'a obj; .. > -> alignment + +class socket : Gtk.socket obj -> + object + inherit container_full + val obj : Gtk.socket obj + method steal : Gdk.xid -> unit + method xwindow : Gdk.xid + end + +val socket : + ?border_width:int -> ?width:int -> ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> socket diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gButton.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gButton.ml new file mode 100644 index 000000000..08ac70445 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gButton.ml @@ -0,0 +1,124 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase +open GtkButton +open GObj +open GContainer + +class button_skel obj = object (self) + inherit container obj + method clicked () = Button.clicked obj + method grab_default () = + Widget.set_can_default obj true; + Widget.grab_default obj +end + +class button_signals obj = object + inherit container_signals obj + method clicked = GtkSignal.connect ~sgn:Button.Signals.clicked ~after obj + method pressed = GtkSignal.connect ~sgn:Button.Signals.pressed ~after obj + method released = GtkSignal.connect ~sgn:Button.Signals.released ~after obj + method enter = GtkSignal.connect ~sgn:Button.Signals.enter ~after obj + method leave = GtkSignal.connect ~sgn:Button.Signals.leave ~after obj +end + +class button obj = object + inherit button_skel (Button.coerce obj) + method connect = new button_signals obj + method event = new GObj.event_ops obj +end + +let button ?label ?border_width ?width ?height ?packing ?show () = + let w = Button.create ?label () in + Container.set w ?border_width ?width ?height; + pack_return (new button w) ~packing ~show + +class toggle_button_signals obj = object + inherit button_signals obj + method toggled = + GtkSignal.connect ~sgn:ToggleButton.Signals.toggled obj ~after +end + +class toggle_button obj = object + inherit button_skel obj + method connect = new toggle_button_signals obj + method active = ToggleButton.get_active obj + method set_active = ToggleButton.set_active obj + method set_draw_indicator = ToggleButton.set_mode obj +end + +let toggle_button ?label ?active ?draw_indicator + ?border_width ?width ?height ?packing ?show () = + let w = ToggleButton.create_toggle ?label () in + ToggleButton.set w ?active ?draw_indicator; + Container.set w ?border_width ?width ?height; + pack_return (new toggle_button w) ~packing ~show + +let check_button ?label ?active ?draw_indicator + ?border_width ?width ?height ?packing ?show () = + let w = ToggleButton.create_check ?label () in + ToggleButton.set w ?active ?draw_indicator; + Container.set w ?border_width ?width ?height; + pack_return (new toggle_button w) ~packing ~show + +class radio_button obj = object + inherit toggle_button (obj : Gtk.radio_button obj) + method set_group = RadioButton.set_group obj + method group = Some obj +end + +let radio_button ?group ?label ?active ?draw_indicator + ?border_width ?width ?height ?packing ?show () = + let w = RadioButton.create ?group ?label () in + ToggleButton.set w ?active ?draw_indicator; + Container.set w ?border_width ?width ?height; + pack_return (new radio_button w) ~packing ~show + +class toolbar obj = object + inherit container_full (obj : Gtk.toolbar obj) + method insert_widget ?tooltip ?tooltip_private ?pos w = + Toolbar.insert_widget obj (as_widget w) ?tooltip ?tooltip_private ?pos + + method insert_button ?text ?tooltip ?tooltip_private ?icon + ?pos ?callback () = + let icon = may_map icon ~f:as_widget in + new button + (Toolbar.insert_button obj ~kind:`BUTTON ?icon ?text + ?tooltip ?tooltip_private ?pos ?callback ()) + + method insert_toggle_button ?text ?tooltip ?tooltip_private ?icon + ?pos ?callback () = + let icon = may_map icon ~f:as_widget in + new toggle_button + (ToggleButton.cast + (Toolbar.insert_button obj ~kind:`TOGGLEBUTTON ?icon ?text + ?tooltip ?tooltip_private ?pos ?callback ())) + + method insert_radio_button ?text ?tooltip ?tooltip_private ?icon + ?pos ?callback () = + let icon = may_map icon ~f:as_widget in + new radio_button + (RadioButton.cast + (Toolbar.insert_button obj ~kind:`RADIOBUTTON ?icon ?text + ?tooltip ?tooltip_private ?pos ?callback ())) + + method insert_space = Toolbar.insert_space obj + + method set_orientation = Toolbar.set_orientation obj + method set_style = Toolbar.set_style obj + method set_space_size = Toolbar.set_space_size obj + method set_space_style = Toolbar.set_space_style obj + method set_tooltips = Toolbar.set_tooltips obj + method set_button_relief = Toolbar.set_button_relief obj + method button_relief = Toolbar.get_button_relief obj +end + +let toolbar ?(orientation=`HORIZONTAL) ?style + ?space_size ?space_style ?tooltips ?button_relief + ?border_width ?width ?height ?packing ?show () = + let w = Toolbar.create orientation ?style () in + Toolbar.set w ?space_size ?space_style ?tooltips ?button_relief; + Container.set w ?border_width ?width ?height; + pack_return (new toolbar w) ~packing ~show diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gButton.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gButton.mli new file mode 100644 index 000000000..ee2653da1 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gButton.mli @@ -0,0 +1,144 @@ +(* $Id$ *) + +open Gtk +open GObj +open GContainer + +class button_skel : + 'a obj -> + object + inherit container + constraint 'a = [>`widget|`button|`container] + val obj : 'a obj + method clicked : unit -> unit + method grab_default : unit -> unit + end +class button_signals : + 'b obj -> + object ('a) + inherit container_signals + constraint 'b = [>`button|`container|`widget] + val obj : 'b obj + method clicked : callback:(unit -> unit) -> GtkSignal.id + method enter : callback:(unit -> unit) -> GtkSignal.id + method leave : callback:(unit -> unit) -> GtkSignal.id + method pressed : callback:(unit -> unit) -> GtkSignal.id + method released : callback:(unit -> unit) -> GtkSignal.id + end + +class button : + [>`button] obj -> + object + inherit button_skel + val obj : Gtk.button obj + method event : event_ops + method connect : button_signals + end +val button : + ?label:string -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> button + +class toggle_button_signals : + 'b obj -> + object ('a) + inherit button_signals + constraint 'b = [>`toggle|`button|`container|`widget] + val obj : 'b obj + method toggled : callback:(unit -> unit) -> GtkSignal.id + end + +class toggle_button : + 'a obj -> + object + inherit button_skel + constraint 'a = [>`toggle|`button|`container|`widget] + val obj : 'a obj + method active : bool + method connect : toggle_button_signals + method set_active : bool -> unit + method set_draw_indicator : bool -> unit + end +val toggle_button : + ?label:string -> + ?active:bool -> + ?draw_indicator:bool -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> toggle_button +val check_button : + ?label:string -> + ?active:bool -> + ?draw_indicator:bool -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> toggle_button + +class radio_button : + Gtk.radio_button obj -> + object + inherit toggle_button + val obj : Gtk.radio_button obj + method group : Gtk.radio_button group + method set_group : Gtk.radio_button group -> unit + end +val radio_button : + ?group:Gtk.radio_button group -> + ?label:string -> + ?active:bool -> + ?draw_indicator:bool -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> radio_button + +class toolbar : + Gtk.toolbar obj -> + object + inherit container_full + val obj : Gtk.toolbar obj + method button_relief : Tags.relief_style + method insert_button : + ?text:string -> + ?tooltip:string -> + ?tooltip_private:string -> + ?icon:widget -> + ?pos:int -> ?callback:(unit -> unit) -> unit -> button + method insert_radio_button : + ?text:string -> + ?tooltip:string -> + ?tooltip_private:string -> + ?icon:widget -> + ?pos:int -> ?callback:(unit -> unit) -> unit -> radio_button + method insert_space : ?pos:int -> unit -> unit + method insert_toggle_button : + ?text:string -> + ?tooltip:string -> + ?tooltip_private:string -> + ?icon:widget -> + ?pos:int -> ?callback:(unit -> unit) -> unit -> toggle_button + method insert_widget : + ?tooltip:string -> + ?tooltip_private:string -> ?pos:int -> widget -> unit + method set_button_relief : Tags.relief_style -> unit + method set_orientation : Tags.orientation -> unit + method set_space_size : int -> unit + method set_space_style : [`EMPTY|`LINE] -> unit + method set_style : Tags.toolbar_style -> unit + method set_tooltips : bool -> unit + end +val toolbar : + ?orientation:Tags.orientation -> + ?style:Tags.toolbar_style -> + ?space_size:int -> + ?space_style:[`EMPTY|`LINE] -> + ?tooltips:bool -> + ?button_relief:Tags.relief_style -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> toolbar diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gContainer.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gContainer.ml new file mode 100644 index 000000000..2ea765e83 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gContainer.ml @@ -0,0 +1,75 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase +open GObj +open GData + +class focus obj = object + val obj = obj + method circulate = Container.focus obj + method set (child : widget option) = + let child = may_map child ~f:(fun x -> x#as_widget) in + Container.set_focus_child obj (Gpointer.optboxed child) + method set_hadjustment adj = + Container.set_focus_hadjustment obj + (Gpointer.optboxed (may_map adj ~f:as_adjustment)) + method set_vadjustment adj = + Container.set_focus_vadjustment obj + (Gpointer.optboxed (may_map adj ~f:as_adjustment)) +end + +class container obj = object (self) + inherit widget obj + method add w = + (* Hack to avoid creating a bin class *) + if GtkBase.Object.is_a obj "GtkBin" && Container.children obj <> [] then + raise (Gtk.Error "GContainer.container#add: already full"); + Container.add obj (as_widget w) + method remove w = Container.remove obj (as_widget w) + method children = List.map ~f:(new widget) (Container.children obj) + method set_border_width = Container.set_border_width obj + method focus = new focus obj +end + +class container_signals obj = object + inherit widget_signals obj + method add ~callback = + GtkSignal.connect ~sgn:Container.Signals.add obj ~after + ~callback:(fun w -> callback (new widget w)) + method remove ~callback = + GtkSignal.connect ~sgn:Container.Signals.remove obj ~after + ~callback:(fun w -> callback (new widget w)) +end + +class container_full obj = object + inherit container obj + method connect = new container_signals obj +end + +let cast_container (w : widget) = + new container_full (GtkBase.Container.cast w#as_widget) + +class virtual ['a] item_container obj = object (self) + inherit widget obj + method add (w : 'a) = + Container.add obj w#as_item + method remove (w : 'a) = + Container.remove obj w#as_item + method private virtual wrap : Gtk.widget obj -> 'a + method children : 'a list = + List.map ~f:self#wrap (Container.children obj) + method set_border_width = Container.set_border_width obj + method focus = new focus obj + method virtual insert : 'a -> pos:int -> unit + method append (w : 'a) = self#insert w ~pos:(-1) + method prepend (w : 'a) = self#insert w ~pos:0 +end + +class item_signals obj = object + inherit container_signals obj + method select = GtkSignal.connect ~sgn:Item.Signals.select obj ~after + method deselect = GtkSignal.connect ~sgn:Item.Signals.deselect obj ~after + method toggle = GtkSignal.connect ~sgn:Item.Signals.toggle obj ~after +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gContainer.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gContainer.mli new file mode 100644 index 000000000..290982942 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gContainer.mli @@ -0,0 +1,79 @@ +(* $Id$ *) + +open Gtk +open GObj + +class focus : + 'a obj -> + object + constraint 'a = [>`container] + val obj : 'a obj + method circulate : Tags.direction_type -> bool + method set : widget option -> unit + method set_hadjustment : GData.adjustment option -> unit + method set_vadjustment : GData.adjustment option -> unit + end + +class container : + 'a obj -> + object + inherit widget + constraint 'a = [>`container|`widget] + val obj : 'a obj + method add : widget -> unit + method children : widget list + method remove : widget -> unit + method focus : focus + method set_border_width : int -> unit + end + +class container_signals : + 'a obj -> + object + inherit widget_signals + constraint 'a = [>`container|`widget] + val obj : 'a obj + method add : callback:(widget -> unit) -> GtkSignal.id + method remove : callback:(widget -> unit) -> GtkSignal.id + end + +class container_full : + 'a obj -> + object + inherit container + constraint 'a = [>`container|`widget] + val obj : 'a obj + method connect : container_signals + end + +val cast_container : widget -> container_full +(* may raise [Gtk.Cannot_cast "GtkContainer"] *) + +class virtual ['a] item_container : + 'c obj -> + object + constraint 'a = < as_item : [>`widget] obj; .. > + constraint 'c = [>`container|`widget] + inherit widget + val obj : 'c obj + method add : 'a -> unit + method append : 'a -> unit + method children : 'a list + method virtual insert : 'a -> pos:int -> unit + method prepend : 'a -> unit + method remove : 'a -> unit + method focus : focus + method set_border_width : int -> unit + method private virtual wrap : Gtk.widget obj -> 'a + end + +class item_signals : + 'a obj -> + object + inherit container_signals + constraint 'a = [>`container|`item|`widget] + val obj : 'a obj + method deselect : callback:(unit -> unit) -> GtkSignal.id + method select : callback:(unit -> unit) -> GtkSignal.id + method toggle : callback:(unit -> unit) -> GtkSignal.id + end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gData.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gData.ml new file mode 100644 index 000000000..52aa3f1f4 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gData.ml @@ -0,0 +1,60 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkData +open GObj + +class data_signals obj = object + inherit gtkobj_signals obj + method disconnect_data = + GtkSignal.connect ~sgn:Data.Signals.disconnect obj ~after +end + +class adjustment_signals obj = object + inherit data_signals obj + method changed = GtkSignal.connect ~sgn:Adjustment.Signals.changed obj ~after + method value_changed = + GtkSignal.connect ~sgn:Adjustment.Signals.value_changed obj ~after +end + +class adjustment obj = object + inherit gtkobj obj + method as_adjustment : Gtk.adjustment obj = obj + method connect = new adjustment_signals obj + method set_value = Adjustment.set_value obj + method clamp_page = Adjustment.clamp_page obj + method lower = Adjustment.get_lower obj + method upper = Adjustment.get_upper obj + method value = Adjustment.get_value obj + method step_increment = Adjustment.get_step_increment obj + method page_increment = Adjustment.get_page_increment obj + method page_size = Adjustment.get_page_size obj +end + +let adjustment ?(value=0.) ?(lower=0.) ?(upper=100.) + ?(step_incr=1.) ?(page_incr=10.) ?(page_size=10.) () = + let w = + Adjustment.create ~value ~lower ~upper ~step_incr ~page_incr ~page_size in + new adjustment w + +let as_adjustment (adj : adjustment) = adj#as_adjustment + +class tooltips obj = object + inherit gtkobj (obj : Gtk.tooltips obj) + method as_tooltips = obj + method connect = new data_signals obj + method enable () = Tooltips.enable obj + method disable () = Tooltips.disable obj + method set_tip ?text ?privat w = + Tooltips.set_tip obj (as_widget w) ?text ?privat + method set_delay = Tooltips.set_delay obj +end + +let tooltips ?delay () = + let tt = Tooltips.create () in + Tooltips.set tt ?delay; + new tooltips tt + + + diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gData.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gData.mli new file mode 100644 index 000000000..ae7b29eb5 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gData.mli @@ -0,0 +1,60 @@ +(* $Id$ *) + +open Gtk + +class data_signals : + 'a obj -> + object + inherit GObj.gtkobj_signals + constraint 'a = [>`data] + val obj : 'a obj + method disconnect_data : callback:(unit -> unit) -> GtkSignal.id + end + +class adjustment_signals : + 'a obj -> + object + inherit data_signals + constraint 'a = [>`adjustment|`data] + val obj : 'a obj + method changed : callback:(unit -> unit) -> GtkSignal.id + method value_changed : callback:(unit -> unit) -> GtkSignal.id + end + +class adjustment : Gtk.adjustment obj -> + object + inherit GObj.gtkobj + val obj : Gtk.adjustment obj + method as_adjustment : Gtk.adjustment obj + method clamp_page : lower:float -> upper:float -> unit + method connect : adjustment_signals + method set_value : float -> unit + method lower : float + method upper : float + method value : float + method step_increment : float + method page_increment : float + method page_size : float + end +val adjustment : + ?value:float -> + ?lower:float -> + ?upper:float -> + ?step_incr:float -> + ?page_incr:float -> ?page_size:float -> unit -> adjustment + +val as_adjustment : adjustment -> Gtk.adjustment obj + +class tooltips : + Gtk.tooltips obj -> + object + inherit GObj.gtkobj + val obj : Gtk.tooltips obj + method as_tooltips : Gtk.tooltips obj + method connect : data_signals + method disable : unit -> unit + method enable : unit -> unit + method set_delay : int -> unit + method set_tip : ?text:string -> ?privat:string -> GObj.widget -> unit + end +val tooltips : ?delay:int -> unit -> tooltips diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gDraw.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gDraw.ml new file mode 100644 index 000000000..5782079a0 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gDraw.ml @@ -0,0 +1,163 @@ +(* $Id$ *) + +open Gaux +open Gdk + +type color = [ + | `COLOR of Color.t + | `WHITE + | `BLACK + | `NAME of string + | `RGB of int * int * int +] + +let default_colormap = GtkBase.Widget.get_default_colormap + +let color ?(colormap = default_colormap ()) (c : color) = + match c with + | `COLOR col -> col + | #Gdk.Color.spec as def -> Color.alloc ~colormap def + +type optcolor = [ + | `COLOR of Color.t + | `WHITE + | `BLACK + | `NAME of string + | `RGB of int * int * int + | `DEFAULT +] + +let optcolor ?colormap (c : optcolor) = + match c with + | `DEFAULT -> None + | #color as c -> Some (color ?colormap c) + +class ['a] drawable ?(colormap = default_colormap ()) w = +object (self) + val colormap = colormap + val gc = GC.create w + val w : 'a Gdk.drawable = w + method color = color ~colormap + method set_foreground col = GC.set_foreground gc (self#color col) + method set_background col = GC.set_background gc (self#color col) + method gc_values = GC.get_values gc + method set_clip_region region = GC.set_clip_region gc region + method set_line_attributes ?width ?style ?cap ?join () = + let v = GC.get_values gc in + GC.set_line_attributes gc + ~width:(default v.GC.line_width ~opt:width) + ~style:(default v.GC.line_style ~opt:style) + ~cap:(default v.GC.cap_style ~opt:cap) + ~join:(default v.GC.join_style ~opt:join) + method point = Draw.point w gc + method line = Draw.line w gc + method rectangle = Draw.rectangle w gc + method arc = Draw.arc w gc + method polygon ?filled l = Draw.polygon w gc ?filled l + method string s = Draw.string w gc ~string:s + method image ~width ~height ?(xsrc=0) ?(ysrc=0) ?(xdest=0) ?(ydest=0) image = + Draw.image w gc ~image ~width ~height ~xsrc ~ysrc ~xdest ~ydest +end + +class pixmap ?colormap ?mask pm = object + inherit [[`pixmap]] drawable ?colormap pm as pixmap + val bitmap = may_map mask ~f: + begin fun x -> + let mask = new drawable x in + mask#set_foreground `WHITE; + mask + end + val mask : Gdk.bitmap option = mask + method pixmap = w + method mask = mask + method set_line_attributes ?width ?style ?cap ?join () = + pixmap#set_line_attributes ?width ?style ?cap ?join (); + may bitmap ~f:(fun m -> m#set_line_attributes ?width ?style ?cap ?join ()) + method point ~x ~y = + pixmap#point ~x ~y; + may bitmap ~f:(fun m -> m#point ~x ~y) + method line ~x ~y ~x:x' ~y:y' = + pixmap#line ~x ~y ~x:x' ~y:y'; + may bitmap ~f:(fun m -> m#line ~x ~y ~x:x' ~y:y') + method rectangle ~x ~y ~width ~height ?filled () = + pixmap#rectangle ~x ~y ~width ~height ?filled (); + may bitmap ~f:(fun m -> m#rectangle ~x ~y ~width ~height ?filled ()) + method arc ~x ~y ~width ~height ?filled ?start ?angle () = + pixmap#arc ~x ~y ~width ~height ?filled ?start ?angle (); + may bitmap + ~f:(fun m -> m#arc ~x ~y ~width ~height ?filled ?start ?angle ()); + method polygon ?filled l = + pixmap#polygon ?filled l; + may bitmap ~f:(fun m -> m#polygon ?filled l) + method string s ~font ~x ~y = + pixmap#string s ~font ~x ~y; + may bitmap ~f:(fun m -> m#string s ~font ~x ~y) +end + +class type misc_ops = object + method allocation : Gtk.rectangle + method colormap : colormap + method draw : Rectangle.t option -> unit + method hide : unit -> unit + method hide_all : unit -> unit + method intersect : Rectangle.t -> Rectangle.t option + method pointer : int * int + method realize : unit -> unit + method set_app_paintable : bool -> unit + method set_geometry : + ?x:int -> ?y:int -> ?width:int -> ?height:int -> unit -> unit + method show : unit -> unit + method unmap : unit -> unit + method unparent : unit -> unit + method unrealize : unit -> unit + method visible : bool + method visual : visual + method visual_depth : int + method window : window +end + +let pixmap ~(window : < misc : #misc_ops; .. >) + ~width ~height ?(mask=false) () = + window#misc#realize (); + let window = + try window#misc#window + with Gpointer.Null -> failwith "GDraw.pixmap : no window" + and depth = window#misc#visual_depth + and colormap = window#misc#colormap in + let mask = + if not mask then None else + let bm = Bitmap.create window ~width ~height in + let mask = new drawable bm in + mask#set_foreground `BLACK; + mask#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); + Some bm + in + new pixmap (Pixmap.create window ~width ~height ~depth) ~colormap ?mask + +let pixmap_from_xpm ~window ~file ?colormap ?transparent () = + window#misc#realize (); + let window = + try window#misc#window + with Gpointer.Null -> failwith "GDraw.pixmap_from_xpm : no window" in + let pm, mask = + try Pixmap.create_from_xpm window ~file ?colormap + ?transparent:(may_map transparent ~f:(fun c -> color c)) + with Gpointer.Null -> invalid_arg ("GDraw.pixmap_from_xpm : " ^ file) in + new pixmap pm ?colormap ~mask + +let pixmap_from_xpm_d ~window ~data ?colormap ?transparent () = + window#misc#realize (); + let window = + try window#misc#window + with Gpointer.Null -> failwith "GDraw.pixmap_from_xpm_d : no window" in + let pm, mask = + Pixmap.create_from_xpm_d window ~data ?colormap + ?transparent:(may_map transparent ~f:(fun c -> color c)) in + new pixmap pm ?colormap ~mask + +class drag_context context = object + val context = context + method status ?(time=0) act = DnD.drag_status context act ~time + method suggested_action = DnD.drag_context_suggested_action context + method targets = DnD.drag_context_targets context +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gDraw.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gDraw.mli new file mode 100644 index 000000000..2b5fc8627 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gDraw.mli @@ -0,0 +1,107 @@ +(* $Id$ *) + +open Gdk + +type color = + [ `COLOR of Color.t + | `WHITE + | `BLACK + | `NAME of string + | `RGB of int * int * int] + +val color : ?colormap:colormap -> color -> Color.t + +type optcolor = + [ `COLOR of Color.t + | `WHITE + | `BLACK + | `NAME of string + | `RGB of int * int * int + | `DEFAULT ] + +val optcolor : ?colormap:colormap -> optcolor -> Color.t option + +class ['a] drawable : ?colormap:colormap -> 'a Gdk.drawable -> + object + val gc : gc + val w : 'a Gdk.drawable + method arc : + x:int -> + y:int -> + width:int -> + height:int -> + ?filled:bool -> ?start:float -> ?angle:float -> unit -> unit + method color : color -> Color.t + method gc_values : GC.values + method image : + width:int -> + height:int -> + ?xsrc:int -> ?ysrc:int -> ?xdest:int -> ?ydest:int -> image -> unit + method line : x:int -> y:int -> x:int -> y:int -> unit + method point : x:int -> y:int -> unit + method polygon : ?filled:bool -> (int * int) list -> unit + method rectangle : + x:int -> + y:int -> width:int -> height:int -> ?filled:bool -> unit -> unit + method set_background : color -> unit + method set_foreground : color -> unit + method set_clip_region : region -> unit + method set_line_attributes : + ?width:int -> + ?style:GC.gdkLineStyle -> + ?cap:GC.gdkCapStyle -> ?join:GC.gdkJoinStyle -> unit -> unit + method string : string -> font:font -> x:int -> y:int -> unit + end + +class pixmap : + ?colormap:colormap -> ?mask:bitmap -> [ `pixmap] Gdk.drawable -> + object + inherit [[`pixmap]] drawable + val bitmap : [ `bitmap] drawable option + val mask : bitmap option + method mask : bitmap option + method pixmap : Gdk.pixmap + end + +class type misc_ops = + object + method allocation : Gtk.rectangle + method colormap : colormap + method draw : Rectangle.t option -> unit + method hide : unit -> unit + method hide_all : unit -> unit + method intersect : Rectangle.t -> Rectangle.t option + method pointer : int * int + method realize : unit -> unit + method set_app_paintable : bool -> unit + method set_geometry : + ?x:int -> ?y:int -> ?width:int -> ?height:int -> unit -> unit + method show : unit -> unit + method unmap : unit -> unit + method unparent : unit -> unit + method unrealize : unit -> unit + method visible : bool + method visual : visual + method visual_depth : int + method window : window + end + +val pixmap : + window:< misc : #misc_ops; .. > -> + width:int -> height:int -> ?mask:bool -> unit -> pixmap +val pixmap_from_xpm : + window:< misc : #misc_ops; .. > -> + file:string -> + ?colormap:colormap -> ?transparent:color -> unit -> pixmap +val pixmap_from_xpm_d : + window:< misc : #misc_ops; .. > -> + data:string array -> + ?colormap:colormap -> ?transparent:color -> unit -> pixmap + +class drag_context : Gdk.drag_context -> + object + val context : Gdk.drag_context + method status : ?time:int -> Tags.drag_action list -> unit + method suggested_action : Tags.drag_action + method targets : atom list + end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gEdit.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gEdit.ml new file mode 100644 index 000000000..467ee4505 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gEdit.ml @@ -0,0 +1,147 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase +open GtkEdit +open GObj + +class editable_signals obj = object + inherit widget_signals obj + method activate = GtkSignal.connect ~sgn:Editable.Signals.activate obj ~after + method changed = GtkSignal.connect ~sgn:Editable.Signals.changed obj ~after + method insert_text = + GtkSignal.connect ~sgn:Editable.Signals.insert_text obj ~after + method delete_text = + GtkSignal.connect ~sgn:Editable.Signals.delete_text obj ~after +end + +class editable obj = object + inherit widget obj + method connect = new editable_signals obj + method select_region = Editable.select_region obj + method insert_text = Editable.insert_text obj + method delete_text = Editable.delete_text obj + method get_chars = Editable.get_chars obj + method cut_clipboard () = Editable.cut_clipboard obj + method copy_clipboard () = Editable.copy_clipboard obj + method paste_clipboard () = Editable.paste_clipboard obj + method delete_selection () = Editable.delete_selection obj + method set_position = Editable.set_position obj + method position = Editable.get_position obj + method set_editable = Editable.set_editable obj + method selection = + if Editable.has_selection obj then + Some (Editable.selection_start_pos obj, Editable.selection_end_pos obj) + else None +end + +class entry obj = object + inherit editable obj + method event = new GObj.event_ops obj + method set_text = Entry.set_text obj + method append_text = Entry.append_text obj + method prepend_text = Entry.prepend_text obj + method set_visibility = Entry.set_visibility obj + method set_max_length = Entry.set_max_length obj + method text = Entry.get_text obj + method text_length = Entry.text_length obj +end + +let set_editable ?editable ?(width = -2) ?(height = -2) w = + may editable ~f:(Editable.set_editable w); + if width <> -2 || height <> -2 then Widget.set_usize w ~width ~height + +let entry ?max_length ?text ?visibility ?editable + ?width ?height ?packing ?show () = + let w = Entry.create ?max_length () in + Entry.set w ?text ?visibility; + set_editable w ?editable ?width ?height; + pack_return (new entry w) ~packing ~show + +class spin_button obj = object + inherit entry (obj : Gtk.spin_button obj) + method adjustment = new GData.adjustment (SpinButton.get_adjustment obj) + method value = SpinButton.get_value obj + method value_as_int = SpinButton.get_value_as_int obj + method spin = SpinButton.spin obj + method update = SpinButton.update obj + method set_adjustment adj = + SpinButton.set_adjustment obj (GData.as_adjustment adj) + method set_digits = SpinButton.set_digits obj + method set_value = SpinButton.set_value obj + method set_update_policy = SpinButton.set_update_policy obj + method set_numeric = SpinButton.set_numeric obj + method set_wrap = SpinButton.set_wrap obj + method set_shadow_type = SpinButton.set_shadow_type obj + method set_snap_to_ticks = SpinButton.set_snap_to_ticks obj +end + +let spin_button ?adjustment ?rate ?digits ?value ?update_policy + ?numeric ?wrap ?shadow_type ?snap_to_ticks + ?width ?height ?packing ?show () = + let w = SpinButton.create ?rate ?digits + ?adjustment:(may_map ~f:GData.as_adjustment adjustment) () in + SpinButton.set w ?value ?update_policy + ?numeric ?wrap ?shadow_type ?snap_to_ticks; + set_editable w ?width ?height; + pack_return (new spin_button w) ~packing ~show + +class combo obj = object + inherit GObj.widget (obj : Gtk.combo obj) + method entry = new entry (Combo.entry obj) + method list = new GList.liste (Combo.list obj) + method set_popdown_strings = Combo.set_popdown_strings obj + method set_use_arrows = Combo.set_use_arrows' obj + method set_case_sensitive = Combo.set_case_sensitive obj + method set_value_in_list = Combo.set_value_in_list obj + method disable_activate () = Combo.disable_activate obj + method set_item_string (item : GList.list_item) = + Combo.set_item_string obj item#as_item +end + +let combo ?popdown_strings ?use_arrows + ?case_sensitive ?value_in_list ?ok_if_empty + ?border_width ?width ?height ?packing ?show () = + let w = Combo.create () in + Combo.set w ?popdown_strings ?use_arrows + ?case_sensitive ?value_in_list ?ok_if_empty; + Container.set w ?border_width ?width ?height; + pack_return (new combo w) ~packing ~show + +class text obj = object (self) + inherit editable (obj : Gtk.text obj) as super + method get_chars ~start ~stop:e = + if start < 0 || e > Text.get_length obj || e < start then + invalid_arg "GEdit.text#get_chars"; + super#get_chars ~start ~stop:e + method event = new GObj.event_ops obj + method set_point = Text.set_point obj + method set_hadjustment adj = + Text.set_adjustment obj ~horizontal:(GData.as_adjustment adj) () + method set_vadjustment adj = + Text.set_adjustment obj ~vertical:(GData.as_adjustment adj) () + method set_word_wrap = Text.set_word_wrap obj + method set_line_wrap = Text.set_line_wrap obj + method hadjustment = new GData.adjustment (Text.get_hadjustment obj) + method vadjustment = new GData.adjustment (Text.get_vadjustment obj) + method point = Text.get_point obj + method length = Text.get_length obj + method freeze () = Text.freeze obj + method thaw () = Text.thaw obj + method insert ?font ?foreground ?background text = + let colormap = try Some self#misc#colormap with _ -> None in + Text.insert obj text ?font + ?foreground:(may_map foreground ~f:(GDraw.color ?colormap)) + ?background:(may_map background ~f:(GDraw.color ?colormap)) +end + +let text ?hadjustment ?vadjustment ?editable + ?word_wrap ?line_wrap ?width ?height ?packing ?show () = + let w = Text.create () + ?hadjustment:(may_map ~f:GData.as_adjustment hadjustment) + ?vadjustment:(may_map ~f:GData.as_adjustment vadjustment) in + may word_wrap ~f:(Text.set_word_wrap w); + may line_wrap ~f:(Text.set_line_wrap w); + set_editable w ?editable ?width ?height; + pack_return (new text w) ~packing ~show diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gEdit.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gEdit.mli new file mode 100644 index 000000000..3b2c286ea --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gEdit.mli @@ -0,0 +1,146 @@ +(* $Id$ *) + +open Gtk +open GObj + +class editable_signals : 'a obj -> + object + inherit widget_signals + constraint 'a = [>`editable|`widget] + val obj : 'a obj + method activate : callback:(unit -> unit) -> GtkSignal.id + method changed : callback:(unit -> unit) -> GtkSignal.id + method delete_text : + callback:(start:int -> stop:int -> unit) -> GtkSignal.id + method insert_text : + callback:(string -> pos:int -> unit) -> GtkSignal.id + end + +class editable : 'a obj -> + object + inherit widget + constraint 'a = [>`editable|`widget] + val obj : 'a obj + method connect : editable_signals + method copy_clipboard : unit -> unit + method cut_clipboard : unit -> unit + method delete_selection : unit -> unit + method delete_text : start:int -> stop:int -> unit + method get_chars : start:int -> stop:int -> string + method insert_text : string -> pos:int -> int + method paste_clipboard : unit -> unit + method position : int + method select_region : start:int -> stop:int -> unit + method selection : (int * int) option + method set_editable : bool -> unit + method set_position : int -> unit + end + +class entry : 'a obj -> + object + inherit editable + constraint 'a = [>`entry|`editable|`widget] + val obj : 'a obj + method event : event_ops + method append_text : string -> unit + method prepend_text : string -> unit + method set_max_length : int -> unit + method set_text : string -> unit + method set_visibility : bool -> unit + method text : string + method text_length : int + end +val entry : + ?max_length:int -> + ?text:string -> + ?visibility:bool -> + ?editable:bool -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> entry + +class spin_button : Gtk.spin_button obj -> + object + inherit entry + val obj : Gtk.spin_button obj + method adjustment : GData.adjustment + method set_adjustment : GData.adjustment -> unit + method set_digits : int -> unit + method set_numeric : bool -> unit + method set_shadow_type : Tags.shadow_type -> unit + method set_snap_to_ticks : bool -> unit + method set_update_policy : [`ALWAYS|`IF_VALID] -> unit + method set_value : float -> unit + method set_wrap : bool -> unit + method spin : Tags.spin_type -> unit + method update : unit + method value : float + method value_as_int : int + end +val spin_button : + ?adjustment:GData.adjustment -> + ?rate:float -> + ?digits:int -> + ?value:float -> + ?update_policy:[`ALWAYS|`IF_VALID] -> + ?numeric:bool -> + ?wrap:bool -> + ?shadow_type:Tags.shadow_type -> + ?snap_to_ticks:bool -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> spin_button + +class combo : Gtk.combo obj -> + object + inherit widget + val obj : Gtk.combo obj + method disable_activate : unit -> unit + method entry : entry + method list : GList.liste + method set_case_sensitive : bool -> unit + method set_item_string : GList.list_item -> string -> unit + method set_popdown_strings : string list -> unit + method set_use_arrows : [`NEVER|`DEFAULT|`ALWAYS] -> unit + method set_value_in_list : + ?required:bool -> ?ok_if_empty:bool -> unit -> unit + end +val combo : + ?popdown_strings:string list -> + ?use_arrows:[`NEVER|`DEFAULT|`ALWAYS] -> + ?case_sensitive:bool -> + ?value_in_list:bool -> + ?ok_if_empty:bool -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> combo + +class text : Gtk.text obj -> + object + inherit editable + val obj : Gtk.text obj + method event : event_ops + method freeze : unit -> unit + method hadjustment : GData.adjustment + method insert : + ?font:Gdk.font -> + ?foreground:GDraw.color -> ?background:GDraw.color -> string -> unit + method length : int + method point : int + method set_hadjustment : GData.adjustment -> unit + method set_point : int -> unit + method set_vadjustment : GData.adjustment -> unit + method set_word_wrap : bool -> unit + method set_line_wrap : bool -> unit + method thaw : unit -> unit + method vadjustment : GData.adjustment + end +val text : + ?hadjustment:GData.adjustment -> + ?vadjustment:GData.adjustment -> + ?editable:bool -> + ?word_wrap:bool -> + ?line_wrap:bool -> + ?width:int -> + ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> text diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gHtml.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gHtml.ml new file mode 100644 index 000000000..1150790c5 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gHtml.ml @@ -0,0 +1,33 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase +open GObj +open GtkXmHTML + +class xmhtml obj = object (self) + inherit widget_full (obj : GtkXmHTML.xmhtml obj) + method event = new GObj.event_ops obj + method freeze = freeze obj + method thaw = thaw obj + method source = source obj + method set_fonts = set_font_familty obj + method set_fonts_fixed = set_font_familty_fixed obj + method set_anchor_buttons = set_anchor_buttons obj + method set_anchor_cursor = set_anchor_cursor obj + method set_anchor_underline = set_anchor_underline_type obj + method set_anchor_visited_underline = set_anchor_visited_underline_type obj + method set_anchor_target_underline = set_anchor_target_underline_type obj + method set_topline = set_topline obj + method topline = get_topline obj + method set_strict_checking = set_strict_checking obj + method set_bad_html_warnings = set_bad_html_warnings obj + method set_imagemap_draw = set_imagemap_draw obj +end + +let xmhtml ?source ?border_width ?width ?height ?packing ?show () = + let w = create () in + Container.set w ?border_width ?width ?height; + may source ~f:(GtkXmHTML.source w); + pack_return (new xmhtml w) ~packing ~show diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gList.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gList.ml new file mode 100644 index 000000000..3b1abe43b --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gList.ml @@ -0,0 +1,162 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase +open GtkList +open GObj +open GContainer + +class list_item obj = object + inherit container (obj : Gtk.list_item obj) + method event = new GObj.event_ops obj + method as_item = obj + method select () = Item.select obj + method deselect () = Item.deselect obj + method toggle () = Item.toggle obj + method connect = new item_signals obj +end + +let list_item ?label ?border_width ?width ?height ?packing ?(show=true) () = + let w = ListItem.create ?label () in + Container.set w ?border_width ?width ?height; + let item = new list_item w in + may packing ~f:(fun f -> (f item : unit)); + if show then item#misc#show (); + item + +class liste obj = object + inherit [list_item] item_container (obj : Gtk.liste obj) + method private wrap w = new list_item (ListItem.cast w) + method insert w = Liste.insert_item obj w#as_item + method clear_items = Liste.clear_items obj + method select_item = Liste.select_item obj + method unselect_item = Liste.unselect_item obj + method child_position (w : list_item) = Liste.child_position obj w#as_item +end + +let liste ?selection_mode ?border_width ?width ?height + ?packing ?show () = + let w = Liste.create () in + may selection_mode ~f:(Liste.set_selection_mode w); + Container.set w ?border_width ?width ?height; + pack_return (new liste w) ~packing ~show + +(* Cell lists *) + +class clist_signals obj = object + inherit container_signals obj + method click_column = + GtkSignal.connect ~sgn:CList.Signals.click_column obj ~after + method select_row = + GtkSignal.connect ~sgn:CList.Signals.select_row obj ~after + method unselect_row = + GtkSignal.connect ~sgn:CList.Signals.unselect_row obj ~after + method scroll_vertical = + GtkSignal.connect ~sgn:CList.Signals.scroll_vertical obj ~after + method scroll_horizontal = + GtkSignal.connect ~sgn:CList.Signals.scroll_horizontal obj ~after +end + +class ['a] clist obj = object (self) + inherit widget (obj : Gtk.clist obj) + method set_border_width = Container.set_border_width obj + method event = new GObj.event_ops obj + method connect = new clist_signals obj + method rows = CList.get_rows obj + method columns = CList.get_columns obj + method focus_row = CList.get_focus_row obj + method hadjustment = new GData.adjustment (CList.get_hadjustment obj) + method vadjustment = new GData.adjustment (CList.get_vadjustment obj) + method set_button_actions = CList.set_button_actions obj + method freeze () = CList.freeze obj + method thaw () = CList.thaw obj + method column_title = CList.get_column_title obj + method column_widget col = + new widget (CList.get_column_widget obj col) + method columns_autosize () = CList.columns_autosize obj + method optimal_column_width = CList.optimal_column_width obj + method moveto ?(row_align=0.) ?(col_align=0.) row col = + CList.moveto obj row col ~row_align ~col_align + method row_is_visible = CList.row_is_visible obj + method cell_type = CList.get_cell_type obj + method cell_text = CList.get_text obj + method cell_pixmap row col = + let pm, mask = CList.get_pixmap obj row col in + may_map pm ~f:(fun x -> new GDraw.pixmap ?mask x) + method cell_style row col = + try Some (new style (CList.get_cell_style obj row col)) + with Gpointer.Null -> None + method row_selectable row = CList.get_selectable obj ~row + method row_style row = + try Some (new style (CList.get_row_style obj ~row)) + with Gpointer.Null -> None + method set_shift = CList.set_shift obj + method insert ~row texts = + let texts = List.map texts ~f:(fun x -> Some x) in + CList.insert obj ~row texts + method append = self#insert ~row:self#rows + method prepend = self#insert ~row:0 + method remove = CList.remove obj + method select = CList.select obj + method unselect = CList.unselect obj + method clear () = CList.clear obj + method get_row_column = CList.get_row_column obj + method select_all () = CList.select_all obj + method unselect_all () = CList.unselect_all obj + method swap_rows = CList.swap_rows obj + method row_move = CList.row_move obj + method sort () = CList.sort obj + method set_hadjustment adj = + CList.set_hadjustment obj (GData.as_adjustment adj) + method set_vadjustment adj = + CList.set_vadjustment obj (GData.as_adjustment adj) + method set_shadow_type = CList.set_shadow_type obj + method set_button_actions = CList.set_button_actions obj + method set_selection_mode = CList.set_selection_mode obj + method set_reorderable = CList.set_reorderable obj + method set_use_drag_icons = CList.set_use_drag_icons obj + method set_row_height = CList.set_row_height obj + method set_titles_show = CList.set_titles_show obj + method set_titles_active = CList.set_titles_active obj + method set_sort = CList.set_sort obj + method set_column ?widget = + CList.set_column obj ?widget:(may_map widget ~f:as_widget) + method set_row ?foreground ?background ?selectable ?style = + let color = may_map ~f:(fun c -> Gpointer.optboxed (GDraw.optcolor c)) + and style = may_map ~f:(fun (st : style) -> st#as_style) style in + CList.set_row obj + ?foreground:(color foreground) ?background:(color background) + ?selectable ?style + method set_cell ?text ?pixmap ?spacing ?style = + let pixmap, mask = + match pixmap with None -> None, None + | Some (pm : GDraw.pixmap) -> Some pm#pixmap, pm#mask + and style = may_map ~f:(fun (st : style) -> st#as_style) style in + CList.set_cell obj ?text ?pixmap ?mask ?spacing ?style + method set_row_data n ~data = + CList.set_row_data obj ~row:n (Obj.repr (data : 'a)) + method get_row_data n : 'a = Obj.obj (CList.get_row_data obj ~row:n) + method scroll_vertical = + CList.Signals.emit_scroll obj ~sgn:CList.Signals.scroll_vertical + method scroll_horizontal = + CList.Signals.emit_scroll obj ~sgn:CList.Signals.scroll_horizontal +end + +let clist ?(columns=1) ?titles ?hadjustment ?vadjustment + ?shadow_type ?button_actions ?selection_mode + ?reorderable ?use_drag_icons ?row_height + ?titles_show ?titles_active ?auto_sort ?sort_column ?sort_type + ?border_width ?width ?height ?packing ?show () = + let w = + match titles with None -> CList.create ~cols:columns + | Some titles -> CList.create_with_titles (Array.of_list titles) + in + CList.set w + ?hadjustment:(may_map ~f:GData.as_adjustment hadjustment) + ?vadjustment:(may_map ~f:GData.as_adjustment vadjustment) + ?shadow_type ?button_actions ?selection_mode ?reorderable + ?use_drag_icons ?row_height ?titles_show ?titles_active; + CList.set_sort w ?auto:auto_sort ?column:sort_column ?dir:sort_type (); + Container.set w ?border_width ?width ?height; + pack_return (new clist w) ~packing ~show diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gList.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gList.mli new file mode 100644 index 000000000..17f4cef96 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gList.mli @@ -0,0 +1,158 @@ +(* $Id$ *) + +open Gtk +open GObj +open GContainer + +class list_item : Gtk.list_item obj -> + object + inherit container + val obj : Gtk.list_item obj + method event : event_ops + method as_item : Gtk.list_item obj + method connect : item_signals + method deselect : unit -> unit + method select : unit -> unit + method toggle : unit -> unit + end +val list_item : + ?label:string -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(list_item -> unit) -> ?show:bool -> unit -> list_item + +class liste : Gtk.liste obj -> + object + inherit [list_item] item_container + val obj : Gtk.liste obj + method child_position : list_item -> int + method clear_items : start:int -> stop:int -> unit + method insert : list_item -> pos:int -> unit + method select_item : pos:int -> unit + method unselect_item : pos:int -> unit + method private wrap : Gtk.widget obj -> list_item + end +val liste : + ?selection_mode:Tags.selection_mode -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> liste + +class clist_signals : 'a obj -> + object + inherit container_signals + constraint 'a = [>`clist|`container|`widget] + val obj : 'a obj + method click_column : callback:(int -> unit) -> GtkSignal.id + method select_row : + callback:(row:int -> + column:int -> event:GdkEvent.Button.t option -> unit) -> + GtkSignal.id + method unselect_row : + callback:(row:int -> + column:int -> event:GdkEvent.Button.t option -> unit) -> + GtkSignal.id + method scroll_horizontal : + callback:(Tags.scroll_type -> pos:clampf -> unit) -> GtkSignal.id + method scroll_vertical : + callback:(Tags.scroll_type -> pos:clampf -> unit) -> GtkSignal.id + end + +class ['a] clist : Gtk.clist obj -> + object + inherit widget + val obj : Gtk.clist obj + method event : event_ops + method append : string list -> int + method cell_pixmap : int -> int -> GDraw.pixmap option + method cell_style : int -> int -> style option + method cell_text : int -> int -> string + method cell_type : int -> int -> Tags.cell_type + method clear : unit -> unit + method column_title : int -> string + method column_widget : int -> widget + method columns : int + method columns_autosize : unit -> unit + method connect : clist_signals + method focus_row : int + method freeze : unit -> unit + method get_row_column : x:int -> y:int -> int * int + method get_row_data : int -> 'a + method hadjustment : GData.adjustment + method insert : row:int -> string list -> int + method moveto : + ?row_align:clampf -> ?col_align:clampf -> int -> int -> unit + method optimal_column_width : int -> int + method prepend : string list -> int + method remove : row:int -> unit + method row_is_visible : int -> Tags.visibility + method row_move : int -> dst:int -> unit + method row_selectable : int -> bool + method row_style : int -> style option + method rows : int + method scroll_vertical : Tags.scroll_type -> pos:clampf -> unit + method scroll_horizontal : Tags.scroll_type -> pos:clampf -> unit + method select : int -> int -> unit + method select_all : unit -> unit + method set_border_width : int -> unit + method set_button_actions : int -> Tags.button_action list -> unit + method set_cell : + ?text:string -> + ?pixmap:GDraw.pixmap -> + ?spacing:int -> ?style:style -> int -> int -> unit + method set_column : + ?widget:widget -> + ?title:string -> + ?title_active:bool -> + ?justification:Tags.justification -> + ?visibility:bool -> + ?resizeable:bool -> + ?auto_resize:bool -> + ?width:int -> ?min_width:int -> ?max_width:int -> int -> unit + method set_hadjustment : GData.adjustment -> unit + method set_reorderable : bool -> unit + method set_row : + ?foreground:GDraw.optcolor -> + ?background:GDraw.optcolor -> + ?selectable:bool -> + ?style:style -> int -> unit + method set_row_data : int -> data:'a -> unit + method set_row_height : int -> unit + method set_selection_mode : Tags.selection_mode -> unit + method set_shadow_type : Tags.shadow_type -> unit + method set_shift : int -> int -> vertical:int -> horizontal:int -> unit + method set_sort : + ?auto:bool -> ?column:int -> ?dir:Tags.sort_type -> unit -> unit + method set_titles_active : bool -> unit + method set_titles_show : bool -> unit + method set_use_drag_icons : bool -> unit + method set_vadjustment : GData.adjustment -> unit + method sort : unit -> unit + method swap_rows : int -> int -> unit + method thaw : unit -> unit + method unselect : int -> int -> unit + method unselect_all : unit -> unit + method vadjustment : GData.adjustment + end +val clist : + ?columns:int -> + ?titles:string list -> + ?hadjustment:GData.adjustment -> + ?vadjustment:GData.adjustment -> + ?shadow_type:Tags.shadow_type -> + ?button_actions:(int * Tags.button_action list) list -> + ?selection_mode:Tags.selection_mode -> + ?reorderable:bool -> + ?use_drag_icons:bool -> + ?row_height:int -> + ?titles_show:bool -> + ?titles_active:bool -> + ?auto_sort:bool -> + ?sort_column:int -> + ?sort_type:Tags.sort_type -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> 'a clist diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMain.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMain.ml new file mode 100644 index 000000000..811f490d4 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMain.ml @@ -0,0 +1,26 @@ +(* $Id$ *) + +open Gtk +open GtkMain +open GObj + +module Main : sig + val init : unit -> string (* returns the locale name *) + val main : unit -> unit + val quit : unit -> unit + val version : int * int * int + val flush : unit -> unit +end = Main + +module Grab = struct + open Grab + let add (w : #widget) = add w#as_widget + let remove (w : #widget) = remove w#as_widget + let get_current () = new widget (get_current ()) +end + +module Timeout : sig + type id + val add : ms:int -> callback:(unit -> bool) -> id + val remove : id -> unit +end = Timeout diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMenu.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMenu.ml new file mode 100644 index 000000000..52f05a462 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMenu.ml @@ -0,0 +1,199 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkData +open GtkBase +open GtkMenu +open GObj +open GContainer + +(* Menu type *) + +class menu_shell_signals obj = object + inherit container_signals obj + method deactivate = + GtkSignal.connect ~sgn:MenuShell.Signals.deactivate obj ~after +end + +class type virtual ['a] pre_menu = object + inherit ['a] item_container + method as_menu : Gtk.menu Gtk.obj + method deactivate : unit -> unit + method connect : menu_shell_signals + method event : event_ops + method popup : button:int -> time:int -> unit + method popdown : unit -> unit + method set_accel_group : accel_group -> unit +end + +(* Menu items *) + +class menu_item_signals obj = object + inherit item_signals obj + method activate = GtkSignal.connect ~sgn:MenuItem.Signals.activate obj +end + + +class ['a] pre_menu_item_skel obj = object + inherit container obj + method as_item = MenuItem.coerce obj + method set_submenu (w : 'a pre_menu) = MenuItem.set_submenu obj w#as_menu + method remove_submenu () = MenuItem.remove_submenu obj + method configure = MenuItem.configure obj + method activate () = MenuItem.activate obj + method right_justify () = MenuItem.right_justify obj + method add_accelerator ~group ?modi:m ?flags key= + Widget.add_accelerator obj ~sgn:MenuItem.Signals.activate group ?flags + ?modi:m ~key +end + +class menu_item obj = object + inherit [menu_item] pre_menu_item_skel obj + method connect = new menu_item_signals obj + method event = new GObj.event_ops obj +end + +class menu_item_skel = [menu_item] pre_menu_item_skel + +let pack_item self ~packing ~show = + may packing ~f:(fun f -> (f (self :> menu_item) : unit)); + if show <> Some false then self#misc#show (); + self + +let menu_item ?label ?border_width ?width ?height ?packing ?show () = + let w = MenuItem.create ?label () in + Container.set w ?border_width ?width ?height; + pack_item (new menu_item w) ?packing ?show + +let tearoff_item ?border_width ?width ?height ?packing ?show () = + let w = MenuItem.tearoff_create () in + Container.set w ?border_width ?width ?height; + pack_item (new menu_item w) ?packing ?show + +class check_menu_item_signals obj = object + inherit menu_item_signals obj + method toggled = + GtkSignal.connect ~sgn:CheckMenuItem.Signals.toggled obj ~after +end + +class check_menu_item obj = object + inherit menu_item_skel obj + method set_active = CheckMenuItem.set_active obj + method set_show_toggle = CheckMenuItem.set_show_toggle obj + method active = CheckMenuItem.get_active obj + method toggled () = CheckMenuItem.toggled obj + method connect = new check_menu_item_signals obj + method event = new GObj.event_ops obj +end + +let check_menu_item ?label ?active ?show_toggle + ?border_width ?width ?height ?packing ?show () = + let w = CheckMenuItem.create ?label () in + CheckMenuItem.set w ?active ?show_toggle; + Container.set w ?border_width ?width ?height; + pack_item (new check_menu_item w) ?packing ?show + +class radio_menu_item obj = object + inherit check_menu_item (obj : Gtk.radio_menu_item obj) + method group = Some obj + method set_group = RadioMenuItem.set_group obj +end + +let radio_menu_item ?group ?label ?active ?show_toggle + ?border_width ?width ?height ?packing ?show () = + let w = RadioMenuItem.create ?group ?label () in + CheckMenuItem.set w ?active ?show_toggle; + Container.set w ?border_width ?width ?height; + pack_item (new radio_menu_item w) ?packing ?show + +(* Menus *) + +class menu_shell obj = object + inherit [menu_item] item_container obj + method private wrap w = new menu_item (MenuItem.cast w) + method insert w = MenuShell.insert obj w#as_item + method deactivate () = MenuShell.deactivate obj + method connect = new menu_shell_signals obj + method event = new GObj.event_ops obj +end + +class menu obj = object + inherit menu_shell obj + method popup = Menu.popup obj + method popdown () = Menu.popdown obj + method as_menu : Gtk.menu obj = obj + method set_accel_group = Menu.set_accel_group obj +end + +let menu ?border_width ?packing ?show () = + let w = Menu.create () in + may border_width ~f:(Container.set_border_width w); + let self = new menu w in + may packing ~f:(fun f -> (f (self :> menu) : unit)); + if show <> Some false then self#misc#show (); + self + +(* Option Menu (GtkButton?) *) + +class option_menu obj = object + inherit GButton.button_skel obj + method connect = new GButton.button_signals obj + method event = new GObj.event_ops obj + method set_menu (menu : menu) = OptionMenu.set_menu obj menu#as_menu + method get_menu = new menu (OptionMenu.get_menu obj) + method remove_menu () = OptionMenu.remove_menu obj + method set_history = OptionMenu.set_history obj +end + +let option_menu ?border_width ?width ?height ?packing ?show () = + let w = OptionMenu.create () in + Container.set w ?border_width ?width ?height; + pack_return (new option_menu w) ~packing ~show + +(* Menu Bar *) + +let menu_bar ?border_width ?width ?height ?packing ?show () = + let w = MenuBar.create () in + Container.set w ?border_width ?width ?height; + pack_return (new menu_shell w) ~packing ~show + +(* Menu Factory *) + +class ['a] factory + ?(accel_group=AccelGroup.create ()) + ?(accel_modi=[`CONTROL]) + ?(accel_flags=[`VISIBLE]) (menu_shell : 'a) = + object (self) + val menu_shell : #menu_shell = menu_shell + val group = accel_group + val m = accel_modi + val flags = accel_flags + method menu = menu_shell + method accel_group = group + method private bind ?key ?callback (item : menu_item) = + menu_shell#append item; + may key ~f:(item#add_accelerator ~group ~modi:m ~flags); + may callback ~f:(fun callback -> item#connect#activate ~callback) + method add_item ?key ?callback ?submenu label = + let item = menu_item ~label () in + self#bind item ?key ?callback; + may (submenu : menu option) ~f:item#set_submenu; + item + method add_check_item ?active ?key ?callback label = + let item = check_menu_item ~label ?active () in + self#bind (item :> menu_item) ?key + ?callback:(may_map callback ~f:(fun f () -> f item#active)); + item + method add_radio_item ?group ?active ?key ?callback label = + let item = radio_menu_item ~label ?group ?active () in + self#bind (item :> menu_item) ?key + ?callback:(may_map callback ~f:(fun f () -> f item#active)); + item + method add_separator () = menu_item ~packing:menu_shell#append () + method add_submenu ?key label = + let item = menu_item ~label () in + self#bind item ?key; + menu ~packing:item#set_submenu (); + method add_tearoff () = tearoff_item ~packing:menu_shell#append () +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMenu.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMenu.mli new file mode 100644 index 000000000..505249bea --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMenu.mli @@ -0,0 +1,196 @@ +(* $Id$ *) + +open Gtk +open GObj +open GContainer + +class menu_shell_signals : 'b obj -> + object ('a) + inherit container_signals + constraint 'b = [>`menushell|`container|`widget] + val obj : 'b obj + method deactivate : callback:(unit -> unit) -> GtkSignal.id + end + +class menu_item_signals : 'b obj -> + object ('a) + inherit item_signals + constraint 'b = [>`menuitem|`container|`item|`widget] + val obj : 'b obj + method activate : callback:(unit -> unit) -> GtkSignal.id + end + +class menu_item_skel : + 'a obj -> + object + inherit container + constraint 'a = [>`widget|`container|`menuitem] + val obj : 'a obj + method activate : unit -> unit + method add_accelerator : + group:accel_group -> + ?modi:Gdk.Tags.modifier list -> + ?flags:Tags.accel_flag list -> Gdk.keysym -> unit + method as_item : Gtk.menu_item obj + method configure : show_toggle:bool -> show_indicator:bool -> unit + method remove_submenu : unit -> unit + method right_justify : unit -> unit + method set_submenu : menu -> unit + end +and menu_item : 'a obj -> + object + inherit menu_item_skel + constraint 'a = [>`widget|`container|`item|`menuitem] + val obj : 'a obj + method event : event_ops + method connect : menu_item_signals + end +and menu : Gtk.menu obj -> + object + inherit [menu_item] item_container + val obj : Gtk.menu obj + method add : menu_item -> unit + method event : event_ops + method append : menu_item -> unit + method as_menu : Gtk.menu obj + method children : menu_item list + method connect : menu_shell_signals + method deactivate : unit -> unit + method insert : menu_item -> pos:int -> unit + method popdown : unit -> unit + method popup : button:int -> time:int -> unit + method prepend : menu_item -> unit + method remove : menu_item -> unit + method set_accel_group : accel_group -> unit + method set_border_width : int -> unit + method private wrap : Gtk.widget obj -> menu_item + end + +val menu : + ?border_width:int -> ?packing:(menu -> unit) -> ?show:bool -> unit -> menu +val menu_item : + ?label:string -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(menu_item -> unit) -> ?show:bool -> unit -> menu_item +val tearoff_item : + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(menu_item -> unit) -> ?show:bool -> unit -> menu_item + +class check_menu_item_signals : 'a obj -> + object + inherit menu_item_signals + constraint 'a = [>`checkmenuitem|`container|`item|`menuitem|`widget] + val obj : 'a obj + method toggled : callback:(unit -> unit) -> GtkSignal.id + end + +class check_menu_item : 'a obj -> + object + inherit menu_item_skel + constraint 'a = [>`widget|`checkmenuitem|`container|`item|`menuitem] + val obj : 'a obj + method active : bool + method event : event_ops + method connect : check_menu_item_signals + method set_active : bool -> unit + method set_show_toggle : bool -> unit + method toggled : unit -> unit + end +val check_menu_item : + ?label:string -> + ?active:bool -> + ?show_toggle:bool -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(menu_item -> unit) -> ?show:bool -> unit -> check_menu_item + +class radio_menu_item : Gtk.radio_menu_item obj -> + object + inherit check_menu_item + val obj : Gtk.radio_menu_item obj + method group : Gtk.radio_menu_item group + method set_group : Gtk.radio_menu_item group -> unit + end +val radio_menu_item : + ?group:Gtk.radio_menu_item group -> + ?label:string -> + ?active:bool -> + ?show_toggle:bool -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(menu_item -> unit) -> ?show:bool -> unit -> radio_menu_item + +class menu_shell : 'a obj -> + object + inherit [menu_item] item_container + constraint 'a = [>`widget|`container|`menushell] + val obj : 'a obj + method event : event_ops + method deactivate : unit -> unit + method connect : menu_shell_signals + method insert : menu_item -> pos:int -> unit + method private wrap : Gtk.widget obj -> menu_item + end + +val menu_bar : + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> menu_shell + +class option_menu : 'a obj -> + object + inherit GButton.button_skel + constraint 'a = [>`optionmenu|`button|`container|`widget] + val obj : 'a obj + method event : event_ops + method connect : GButton.button_signals + method get_menu : menu + method remove_menu : unit -> unit + method set_history : int -> unit + method set_menu : menu -> unit + end +val option_menu : + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> option_menu + +class ['a] factory : + ?accel_group:accel_group -> + ?accel_modi:Gdk.Tags.modifier list -> + ?accel_flags:Tags.accel_flag list -> + 'a -> + object + constraint 'a = #menu_shell + val flags : Tags.accel_flag list + val group : accel_group + val m : Gdk.Tags.modifier list + val menu_shell : 'a + method accel_group : accel_group + method add_check_item : + ?active:bool -> + ?key:Gdk.keysym -> + ?callback:(bool -> unit) -> string -> check_menu_item + method add_item : + ?key:Gdk.keysym -> + ?callback:(unit -> unit) -> + ?submenu:menu -> string -> menu_item + method add_radio_item : + ?group:Gtk.radio_menu_item group -> + ?active:bool -> + ?key:Gdk.keysym -> + ?callback:(bool -> unit) -> string -> radio_menu_item + method add_separator : unit -> menu_item + method add_submenu : ?key:Gdk.keysym -> string -> menu + method add_tearoff : unit -> menu_item + method private bind : + ?key:Gdk.keysym -> ?callback:(unit -> unit) -> menu_item -> unit + method menu : 'a + end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMisc.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMisc.ml new file mode 100644 index 000000000..13fd7b4dd --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMisc.ml @@ -0,0 +1,217 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase +open GtkMisc +open GObj + +let separator dir ?(width = -2) ?(height = -2) ?packing ?show () = + let w = Separator.create dir in + if width <> -2 || height <> -2 then Widget.set_usize w ~width ~height; + pack_return (new widget_full w) ~packing ~show + +class statusbar_context obj ctx = object (self) + val obj : statusbar obj = obj + val context : Gtk.statusbar_context = ctx + method context = context + method push text = Statusbar.push obj context ~text + method pop () = Statusbar.pop obj context + method remove = Statusbar.remove obj context + method flash ?(delay=1000) text = + let msg = self#push text in + GtkMain.Timeout.add ~ms:delay ~callback:(fun () -> self#remove msg; false); + () +end + +class statusbar obj = object + inherit GContainer.container_full (obj : Gtk.statusbar obj) + method new_context ~name = + new statusbar_context obj (Statusbar.get_context obj name) +end + +let statusbar ?border_width ?width ?height ?packing ?show () = + let w = Statusbar.create () in + Container.set w ?border_width ?width ?height; + pack_return (new statusbar w) ~packing ~show + +class calendar_signals obj = object + inherit widget_signals obj + method month_changed = + GtkSignal.connect obj ~sgn:Calendar.Signals.month_changed ~after + method day_selected = + GtkSignal.connect obj ~sgn:Calendar.Signals.day_selected ~after + method day_selected_double_click = + GtkSignal.connect obj + ~sgn:Calendar.Signals.day_selected_double_click ~after + method prev_month = + GtkSignal.connect obj ~sgn:Calendar.Signals.prev_month ~after + method next_month = + GtkSignal.connect obj ~sgn:Calendar.Signals.next_month ~after + method prev_year = + GtkSignal.connect obj ~sgn:Calendar.Signals.prev_year ~after + method next_year = + GtkSignal.connect obj ~sgn:Calendar.Signals.next_year ~after +end + +class calendar obj = object + inherit widget (obj : Gtk.calendar obj) + method event = new GObj.event_ops obj + method connect = new calendar_signals obj + method select_month = Calendar.select_month obj + method select_day = Calendar.select_day obj + method mark_day = Calendar.mark_day obj + method unmark_day = Calendar.unmark_day obj + method clear_marks = Calendar.clear_marks obj + method display_options = Calendar.display_options obj + method date = Calendar.get_date obj + method freeze () = Calendar.freeze obj + method thaw () = Calendar.thaw obj +end + +let calendar ?options ?(width = -2) ?(height = -2) ?packing ?show () = + let w = Calendar.create () in + if width <> -2 || height <> -2 then Widget.set_usize w ~width ~height; + may options ~f:(Calendar.display_options w); + pack_return (new calendar w) ~packing ~show + +class drawing_area obj = object + inherit widget_full (obj : Gtk.drawing_area obj) + method event = new GObj.event_ops obj + method set_size = DrawingArea.size obj +end + +let drawing_area ?(width=0) ?(height=0) ?packing ?show () = + let w = DrawingArea.create () in + if width <> 0 || height <> 0 then DrawingArea.size w ~width ~height; + pack_return (new drawing_area w) ~packing ~show + +class misc obj = object + inherit widget obj + method set_alignment = Misc.set_alignment obj + method set_padding = Misc.set_padding obj +end + +class arrow obj = object + inherit misc obj + method set_arrow kind ~shadow = Arrow.set obj ~kind ~shadow +end + +let arrow ~kind ~shadow + ?xalign ?yalign ?xpad ?ypad ?width ?height ?packing ?show () = + let w = Arrow.create ~kind ~shadow in + Misc.set w ?xalign ?yalign ?xpad ?ypad ?width ?height; + pack_return (new arrow w) ~packing ~show + +class image obj = object + inherit misc obj + method set_image ?mask image = Image.set obj image ?mask +end + +let image image ?mask + ?xalign ?yalign ?xpad ?ypad ?width ?height ?packing ?show () = + let w = Image.create image ?mask in + Misc.set w ?xalign ?yalign ?xpad ?ypad ?width ?height; + pack_return (new image w) ~packing ~show + +class label_skel obj = object + inherit misc obj + method set_text = Label.set_text obj + method set_justify = Label.set_justify obj + method set_pattern = Label.set_pattern obj + method set_line_wrap = Label.set_line_wrap obj + method text = Label.get_text obj +end + +class label obj = object + inherit label_skel (Label.coerce obj) + method connect = new widget_signals obj +end + +let label ?(text="") ?justify ?line_wrap ?pattern + ?xalign ?yalign ?xpad ?ypad ?width ?height ?packing ?show () = + let w = Label.create text in + Label.set w ?justify ?line_wrap ?pattern; + Misc.set w ?xalign ?yalign ?xpad ?ypad ?width ?height; + pack_return (new label w) ~packing ~show + +let label_cast w = new label (Label.cast w#as_widget) + +class tips_query_signals obj = object + inherit widget_signals obj + method widget_entered ~callback = + GtkSignal.connect ~sgn:TipsQuery.Signals.widget_entered obj ~after + ~callback:(function None -> callback None + | Some w -> callback (Some (new widget w))) + method widget_selected ~callback = + GtkSignal.connect ~sgn:TipsQuery.Signals.widget_selected obj ~after + ~callback:(function None -> callback None + | Some w -> callback (Some (new widget w))) +end + +class tips_query obj = object + inherit label_skel (obj : Gtk.tips_query obj) + method start () = TipsQuery.start obj + method stop () = TipsQuery.stop obj + method set_caller (w : widget) = TipsQuery.set_caller obj w#as_widget + method set_emit_always = TipsQuery.set_emit_always obj + method set_label_inactive inactive = TipsQuery.set_labels obj ~inactive + method set_label_no_tip no_tip = TipsQuery.set_labels obj ~no_tip + method connect = new tips_query_signals obj +end + +let tips_query ?caller ?emit_always ?label_inactive ?label_no_tip + ?xalign ?yalign ?xpad ?ypad ?width ?height ?packing ?show () = + let w = TipsQuery.create () in + let caller = may_map caller ~f:(fun (w : #widget) -> w#as_widget) in + TipsQuery.set w ?caller ?emit_always ?label_inactive ?label_no_tip; + Misc.set w ?xalign ?yalign ?xpad ?ypad ?width ?height; + pack_return (new tips_query w) ~packing ~show + +class color_selection obj = object + inherit GObj.widget_full (obj : Gtk.color_selection obj) + method set_update_policy = ColorSelection.set_update_policy obj + method set_opacity = ColorSelection.set_opacity obj + method set_color ~red ~green ~blue ?opacity () = + ColorSelection.set_color obj ~red ~green ~blue ?opacity + method get_color = ColorSelection.get_color obj +end + +let color_selection ?border_width ?width ?height ?packing ?show () = + let w = ColorSelection.create () in + Container.set w ?border_width ?width ?height; + pack_return (new color_selection w) ~packing ~show + +class pixmap obj = object + inherit misc (obj : Gtk.pixmap obj) + method connect = new widget_signals obj + method set_pixmap (pm : GDraw.pixmap) = + Pixmap.set obj ~pixmap:pm#pixmap ?mask:pm#mask + method pixmap = + new GDraw.pixmap (Pixmap.pixmap obj) + ?mask:(try Some(Pixmap.mask obj) with Gpointer.Null -> None) +end + +let pixmap (pm : #GDraw.pixmap) ?xalign ?yalign ?xpad ?ypad + ?(width = -2) ?(height = -2) ?packing ?show () = + let w = Pixmap.create pm#pixmap ?mask:pm#mask in + Misc.set w ?xalign ?yalign ?xpad ?ypad; + if width <> -2 || height <> -2 then Widget.set_usize w ~width ~height; + pack_return (new pixmap w) ~packing ~show + +class font_selection obj = object + inherit widget_full (obj : Gtk.font_selection obj) + method notebook = new GPack.notebook obj + method event = new event_ops obj + method font = FontSelection.get_font obj + method font_name = FontSelection.get_font_name obj + method set_font_name = FontSelection.set_font_name obj + method preview_text = FontSelection.get_preview_text obj + method set_preview_text = FontSelection.set_preview_text obj + method set_filter = FontSelection.set_filter obj +end + +let font_selection ?border_width ?width ?height ?packing ?show () = + let w = FontSelection.create () in + Container.set w ?border_width ?width ?height; + pack_return (new font_selection w) ~packing ~show diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMisc.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMisc.mli new file mode 100644 index 000000000..7008369b7 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gMisc.mli @@ -0,0 +1,263 @@ +(* $Id$ *) + +open Gtk +open GObj +open GContainer + +val separator : + Tags.orientation -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> widget_full + +class statusbar_context : + Gtk.statusbar obj -> Gtk.statusbar_context -> + object + val context : Gtk.statusbar_context + val obj : Gtk.statusbar obj + method context : Gtk.statusbar_context + method flash : ?delay:int -> string -> unit + method pop : unit -> unit + method push : string -> statusbar_message + method remove : statusbar_message -> unit + end + +class statusbar : Gtk.statusbar obj -> + object + inherit container_full + val obj : Gtk.statusbar obj + method new_context : name:string -> statusbar_context + end +val statusbar : + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> statusbar + +class calendar_signals : 'a obj -> + object + inherit widget_signals + constraint 'a = [>`calendar|`widget] + val obj : 'a obj + method day_selected : callback:(unit -> unit) -> GtkSignal.id + method day_selected_double_click : + callback:(unit -> unit) -> GtkSignal.id + method month_changed : callback:(unit -> unit) -> GtkSignal.id + method next_month : callback:(unit -> unit) -> GtkSignal.id + method next_year : callback:(unit -> unit) -> GtkSignal.id + method prev_month : callback:(unit -> unit) -> GtkSignal.id + method prev_year : callback:(unit -> unit) -> GtkSignal.id + end + +class calendar : Gtk.calendar obj -> + object + inherit widget + val obj : Gtk.calendar obj + method event : event_ops + method clear_marks : unit + method connect : calendar_signals + method date : int * int * int + method display_options : Tags.calendar_display_options list -> unit + method freeze : unit -> unit + method mark_day : int -> unit + method select_day : int -> unit + method select_month : month:int -> year:int -> unit + method thaw : unit -> unit + method unmark_day : int -> unit + end +val calendar : + ?options:Tags.calendar_display_options list -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> calendar + +class drawing_area : Gtk.drawing_area obj -> + object + inherit widget_full + val obj : Gtk.drawing_area obj + method event : event_ops + method set_size : width:int -> height:int -> unit + end +val drawing_area : + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> drawing_area + +class misc : 'a obj -> + object + inherit widget + constraint 'a = [>`misc|`widget] + val obj : 'a obj + method set_alignment : ?x:float -> ?y:float -> unit -> unit + method set_padding : ?x:int -> ?y:int -> unit -> unit + end + +class arrow : 'a obj -> + object + inherit misc + constraint 'a = [>`arrow|`misc|`widget] + val obj : 'a obj + method set_arrow : Tags.arrow_type -> shadow:Tags.shadow_type -> unit + end + +val arrow : + kind:Tags.arrow_type -> + shadow:Tags.shadow_type -> + ?xalign:float -> + ?yalign:float -> + ?xpad:int -> + ?ypad:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> arrow + +class image : 'a obj -> + object + inherit misc + constraint 'a = [>`image|`misc|`widget] + val obj : 'a obj + method set_image : ?mask:Gdk.bitmap -> Gdk.image -> unit + end + +val image : + Gdk.image -> + ?mask:Gdk.bitmap -> + ?xalign:float -> + ?yalign:float -> + ?xpad:int -> + ?ypad:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> image + +class label_skel : 'a obj -> + object + inherit misc + constraint 'a = [>`label|`misc|`widget] + val obj : 'a obj + method set_justify : Tags.justification -> unit + method set_line_wrap : bool -> unit + method set_pattern : string -> unit + method set_text : string -> unit + method text : string + end + +class label : [>`label] obj -> + object + inherit label_skel + val obj : Gtk.label obj + method connect : widget_signals + end +val label : + ?text:string -> + ?justify:Tags.justification -> + ?line_wrap:bool -> + ?pattern:string -> + ?xalign:float -> + ?yalign:float -> + ?xpad:int -> + ?ypad:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> label +val label_cast : < as_widget : 'a obj ; .. > -> label + +class tips_query_signals : 'a obj -> + object + inherit widget_signals + constraint 'a = [>`tipsquery|`widget] + val obj : 'a obj + method widget_entered : + callback:(widget option -> + text:string option -> privat:string option -> unit) -> + GtkSignal.id + method widget_selected : + callback:(widget option -> text:string option -> + privat:string option -> GdkEvent.Button.t option -> bool) -> + GtkSignal.id + end + +class tips_query : Gtk.tips_query obj -> + object + inherit label_skel + val obj : Gtk.tips_query obj + method connect : tips_query_signals + method set_caller : widget -> unit + method set_emit_always : bool -> unit + method set_label_inactive : string -> unit + method set_label_no_tip : string -> unit + method start : unit -> unit + method stop : unit -> unit + end +val tips_query : + ?caller:#widget -> + ?emit_always:bool -> + ?label_inactive:string -> + ?label_no_tip:string -> + ?xalign:float -> + ?yalign:float -> + ?xpad:int -> + ?ypad:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> tips_query + +class pixmap : Gtk.pixmap Gtk.obj -> + object + inherit misc + val obj : Gtk.pixmap Gtk.obj + method connect : GObj.widget_signals + method pixmap : GDraw.pixmap + method set_pixmap : GDraw.pixmap -> unit + end +val pixmap : + #GDraw.pixmap -> + ?xalign:float -> + ?yalign:float -> + ?xpad:int -> + ?ypad:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> pixmap + +class color_selection : Gtk.color_selection obj -> + object + inherit widget_full + val obj : Gtk.color_selection obj + method get_color : Gtk.color + method set_color : + red:float -> green:float -> blue:float -> ?opacity:float -> unit -> unit + method set_opacity : bool -> unit + method set_update_policy : Tags.update_type -> unit + end +val color_selection : + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> color_selection + +class font_selection : Gtk.font_selection obj -> + object + inherit widget_full + val obj : Gtk.font_selection obj + method event : event_ops + method notebook : GPack.notebook + method font : Gdk.font option + method font_name : string option + method preview_text : string + method set_filter : + ?kind:Tags.font_type list -> + ?foundry:string list -> + ?weight:string list -> + ?slant:string list -> + ?setwidth:string list -> + ?spacing:string list -> + ?charset:string list -> Tags.font_filter_type -> unit + method set_font_name : string -> unit + method set_preview_text : string -> unit + end +val font_selection : + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> font_selection diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gObj.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gObj.ml new file mode 100644 index 000000000..5c4819fa0 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gObj.ml @@ -0,0 +1,292 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkData +open GtkBase + +(* Object *) + +class gtkobj obj = object + val obj = obj + method destroy () = Object.destroy obj + method get_id = Object.get_id obj +end + +class gtkobj_misc obj = object + val obj = obj + method get_type = Type.name (Object.get_type obj) + method disconnect = GtkSignal.disconnect obj + method handler_block = GtkSignal.handler_block obj + method handler_unblock = GtkSignal.handler_unblock obj +end + +class gtkobj_signals ?(after=false) obj = object + val obj = obj + val after = after + method after = {< after = true >} + method destroy = GtkSignal.connect ~sgn:Object.Signals.destroy obj +end + +(* Widget *) + +class event_signals ?(after=false) obj = object + val obj = Widget.coerce obj + val after = after + method after = {< after = true >} + method any = GtkSignal.connect ~sgn:Widget.Signals.Event.any ~after obj + method button_press = + GtkSignal.connect ~sgn:Widget.Signals.Event.button_press ~after obj + method button_release = + GtkSignal.connect ~sgn:Widget.Signals.Event.button_release ~after obj + method configure = + GtkSignal.connect ~sgn:Widget.Signals.Event.configure ~after obj + method delete = + GtkSignal.connect ~sgn:Widget.Signals.Event.delete ~after obj + method destroy = + GtkSignal.connect ~sgn:Widget.Signals.Event.destroy ~after obj + method enter_notify = + GtkSignal.connect ~sgn:Widget.Signals.Event.enter_notify ~after obj + method expose = + GtkSignal.connect ~sgn:Widget.Signals.Event.expose ~after obj + method focus_in = + GtkSignal.connect ~sgn:Widget.Signals.Event.focus_in ~after obj + method focus_out = + GtkSignal.connect ~sgn:Widget.Signals.Event.focus_out ~after obj + method key_press = + GtkSignal.connect ~sgn:Widget.Signals.Event.key_press ~after obj + method key_release = + GtkSignal.connect ~sgn:Widget.Signals.Event.key_release ~after obj + method leave_notify = + GtkSignal.connect ~sgn:Widget.Signals.Event.leave_notify ~after obj + method map = GtkSignal.connect ~sgn:Widget.Signals.Event.map ~after obj + method motion_notify = + GtkSignal.connect ~sgn:Widget.Signals.Event.motion_notify ~after obj + method property_notify = + GtkSignal.connect ~sgn:Widget.Signals.Event.property_notify ~after obj + method proximity_in = + GtkSignal.connect ~sgn:Widget.Signals.Event.proximity_in ~after obj + method proximity_out = + GtkSignal.connect ~sgn:Widget.Signals.Event.proximity_out ~after obj + method selection_clear = + GtkSignal.connect ~sgn:Widget.Signals.Event.selection_clear ~after obj + method selection_notify = + GtkSignal.connect ~sgn:Widget.Signals.Event.selection_notify ~after obj + method selection_request = + GtkSignal.connect ~sgn:Widget.Signals.Event.selection_request ~after obj + method unmap = GtkSignal.connect ~sgn:Widget.Signals.Event.unmap ~after obj +end + +class event_ops obj = object + val obj = Widget.coerce obj + method add = Widget.add_events obj + method connect = new event_signals obj + method send : Gdk.Tags.event_type Gdk.event -> bool = Widget.event obj + method set_extensions = Widget.set_extension_events obj +end + +class style st = object + val style = st + method as_style = style + method copy = {< style = Style.copy style >} + method bg state = Style.get_bg style ~state + method colormap = Style.get_colormap style + method font = Style.get_font style + method set_bg = + List.iter ~f: + (fun (state,c) -> Style.set_bg style ~state ~color:(GDraw.color c)) + method set_font = Style.set_font style + method set_background = Style.set_background style +end + +class selection_data (sel : Selection.t) = object + val sel = sel + method selection = Selection.selection sel + method target = Selection.target sel + method seltype = Selection.seltype sel + method format = Selection.format sel + method data = Selection.get_data sel + method set = Selection.set sel +end + +class drag_signals ?(after=false) obj = object + val obj = Widget.coerce obj + val after = after + method after = {< after = true >} + method beginning ~callback = + GtkSignal.connect ~sgn:Widget.Signals.drag_begin ~after obj + ~callback:(fun context -> callback (new drag_context context)) + method ending ~callback = + GtkSignal.connect ~sgn:Widget.Signals.drag_end ~after obj + ~callback:(fun context -> callback (new drag_context context)) + method data_delete ~callback = + GtkSignal.connect ~sgn:Widget.Signals.drag_data_delete ~after obj + ~callback:(fun context -> callback (new drag_context context)) + method leave ~callback = + GtkSignal.connect ~sgn:Widget.Signals.drag_leave ~after obj + ~callback:(fun context -> callback (new drag_context context)) + method motion ~callback = + GtkSignal.connect ~sgn:Widget.Signals.drag_motion ~after obj + ~callback:(fun context -> callback (new drag_context context)) + method drop ~callback = + GtkSignal.connect ~sgn:Widget.Signals.drag_drop ~after obj + ~callback:(fun context -> callback (new drag_context context)) + method data_get ~callback = + GtkSignal.connect ~sgn:Widget.Signals.drag_data_get ~after obj + ~callback:(fun context data -> callback (new drag_context context) + (new selection_data data)) + method data_received ~callback = + GtkSignal.connect ~sgn:Widget.Signals.drag_data_received ~after obj + ~callback:(fun context ~x ~y data -> callback (new drag_context context) + ~x ~y (new selection_data data)) + +end + +and drag_ops obj = object + val obj = Widget.coerce obj + method connect = new drag_signals obj + method dest_set ?(flags=[`ALL]) ?(actions=[]) targets = + DnD.dest_set obj ~flags ~actions ~targets:(Array.of_list targets) + method dest_unset () = DnD.dest_unset obj + method get_data ?(time=0) ~context:(context : drag_context) target = + DnD.get_data obj (context : < context : Gdk.drag_context; .. >)#context + ~target ~time + method highlight () = DnD.highlight obj + method unhighlight () = DnD.unhighlight obj + method source_set ?modi:m ?(actions=[]) targets = + DnD.source_set obj ?modi:m ~actions ~targets:(Array.of_list targets) + method source_set_icon ?(colormap = Gdk.Color.get_system_colormap ()) + (pix : GDraw.pixmap) = + DnD.source_set_icon obj ~colormap pix#pixmap ?mask:pix#mask + method source_unset () = DnD.source_unset obj +end + +and drag_context context = object + inherit GDraw.drag_context context + method context = context + method finish = DnD.finish context + method source_widget = + new widget (Object.unsafe_cast (DnD.get_source_widget context)) + method set_icon_widget (w : widget) = + DnD.set_icon_widget context (w#as_widget) + method set_icon_pixmap ?(colormap = Gdk.Color.get_system_colormap ()) + (pix : GDraw.pixmap) = + DnD.set_icon_pixmap context ~colormap pix#pixmap ?mask:pix#mask +end + +and misc_signals ?after obj = object + inherit gtkobj_signals ?after obj + method draw ~callback = + GtkSignal.connect obj ~sgn:Widget.Signals.draw ~after ~callback: + begin fun rect -> + callback + { x = Gdk.Rectangle.x rect ; y = Gdk.Rectangle.y rect; + width = Gdk.Rectangle.width rect; + height = Gdk.Rectangle.height rect } + end + method show = GtkSignal.connect ~sgn:Widget.Signals.show ~after obj + method hide = GtkSignal.connect ~sgn:Widget.Signals.hide ~after obj + method map = GtkSignal.connect ~sgn:Widget.Signals.map ~after obj + method unmap = GtkSignal.connect ~sgn:Widget.Signals.unmap ~after obj + method realize = GtkSignal.connect ~sgn:Widget.Signals.realize ~after obj + method state_changed = + GtkSignal.connect ~sgn:Widget.Signals.state_changed ~after obj + method parent_set ~callback = + GtkSignal.connect obj ~sgn:Widget.Signals.parent_set ~after ~callback: + begin function + None -> callback None + | Some w -> callback (Some (new widget (Object.unsafe_cast w))) + end + method style_set ~callback = + GtkSignal.connect obj ~sgn:Widget.Signals.style_set ~after ~callback: + (fun opt -> callback (may opt ~f:(new style))) +end + +and misc_ops obj = object + inherit gtkobj_misc (Widget.coerce obj) + method connect = new misc_signals obj + method show () = Widget.show obj + method unparent () = Widget.unparent obj + method show_all () = Widget.show_all obj + method hide () = Widget.hide obj + method hide_all () = Widget.hide_all obj + method map () = Widget.map obj + method unmap () = Widget.unmap obj + method realize () = Widget.realize obj + method unrealize () = Widget.unrealize obj + method draw = Widget.draw obj + method activate () = Widget.activate obj + method reparent (w : widget) = Widget.reparent obj w#as_widget + method popup = Widget.popup obj + method intersect = Widget.intersect obj + method grab_focus () = Widget.grab_focus obj + method grab_default () = Widget.grab_default obj + method is_ancestor (w : widget) = Widget.is_ancestor obj w#as_widget + method add_accelerator ~sgn:sg ~group ?modi ?flags key = + Widget.add_accelerator obj ~sgn:sg group ~key ?modi ?flags + method remove_accelerator ~group ?modi key = + Widget.remove_accelerator obj group ~key ?modi + method lock_accelerators () = Widget.lock_accelerators obj + method set_name = Widget.set_name obj + method set_state = Widget.set_state obj + method set_sensitive = Widget.set_sensitive obj + method set_can_default = Widget.set_can_default obj + method set_can_focus = Widget.set_can_focus obj + method set_geometry ?(x = -2) ?(y = -2) ?(width = -2) ?(height = -2) () = + if x+y <> -4 then Widget.set_uposition obj ~x ~y; + if width+height <> -4 then Widget.set_usize obj ~width ~height + method set_style (style : style) = Widget.set_style obj style#as_style + (* get functions *) + method name = Widget.get_name obj + method toplevel = + try Some (new widget (Object.unsafe_cast (Widget.get_toplevel obj))) + with Gpointer.Null -> None + method window = Widget.window obj + method colormap = Widget.get_colormap obj + method visual = Widget.get_visual obj + method visual_depth = Gdk.Window.visual_depth (Widget.get_visual obj) + method pointer = Widget.get_pointer obj + method style = new style (Widget.get_style obj) + method visible = Widget.visible obj + method has_focus = Widget.has_focus obj + method parent = + try Some (new widget (Object.unsafe_cast (Widget.parent obj))) + with Gpointer.Null -> None + method set_app_paintable = Widget.set_app_paintable obj + method allocation = Widget.allocation obj +end + +and widget obj = object (self) + inherit gtkobj obj + method as_widget = Widget.coerce obj + method misc = new misc_ops obj + method drag = new drag_ops (Object.unsafe_cast obj) + method coerce = + (self :> < destroy : _; get_id : _; as_widget : _; misc : _; + drag : _; coerce : _ >) +end + +(* just to check that GDraw.misc_ops is compatible with misc_ops *) +let _ = fun (x : #GDraw.misc_ops) -> (x : misc_ops) + +class widget_signals ?after (obj : [> `widget] obj) = + gtkobj_signals ?after obj + +(* +class widget_coerce obj = object + inherit widget obj + method coerce = (self :> widget) +end +*) + +class widget_full obj = object + inherit widget obj + method connect = new widget_signals obj +end + +let as_widget (w : widget) = w#as_widget + +let pack_return self ~packing ~show = + may packing ~f:(fun f -> (f (self :> widget) : unit)); + if show <> Some false then self#misc#show (); + self diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gObj.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gObj.mli new file mode 100644 index 000000000..7c37cf124 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gObj.mli @@ -0,0 +1,267 @@ +(* $Id$ *) + +open Gtk + +(* Object *) + +class gtkobj : + 'a obj -> + object + val obj : 'a obj + method destroy : unit -> unit + method get_id : int + end + +class gtkobj_signals : + ?after:bool -> 'a obj -> + object ('b) + val obj : 'a obj + val after : bool + method after : 'b + method destroy : callback:(unit -> unit) -> GtkSignal.id + end + +class gtkobj_misc : 'a obj -> + object + method get_type : string + method disconnect : GtkSignal.id -> unit + method handler_block : GtkSignal.id -> unit + method handler_unblock : GtkSignal.id -> unit + end + +(* Widget *) + +class event_signals : + ?after:bool -> [>`widget] obj -> + object ('a) + method after : 'a + method any : + callback:(Gdk.Tags.event_type Gdk.event -> bool) -> GtkSignal.id + method button_press : callback:(GdkEvent.Button.t -> bool) -> GtkSignal.id + method button_release : + callback:(GdkEvent.Button.t -> bool) -> GtkSignal.id + method configure : callback:(GdkEvent.Configure.t -> bool) -> GtkSignal.id + method delete : callback:([`DELETE] Gdk.event -> bool) -> GtkSignal.id + method destroy : callback:([`DESTROY] Gdk.event -> bool) -> GtkSignal.id + method enter_notify : + callback:(GdkEvent.Crossing.t -> bool) -> GtkSignal.id + method expose : callback:(GdkEvent.Expose.t -> bool) -> GtkSignal.id + method focus_in : callback:(GdkEvent.Focus.t -> bool) -> GtkSignal.id + method focus_out : callback:(GdkEvent.Focus.t -> bool) -> GtkSignal.id + method key_press : callback:(GdkEvent.Key.t -> bool) -> GtkSignal.id + method key_release : callback:(GdkEvent.Key.t -> bool) -> GtkSignal.id + method leave_notify : + callback:(GdkEvent.Crossing.t -> bool) -> GtkSignal.id + method map : callback:([`MAP] Gdk.event -> bool) -> GtkSignal.id + method motion_notify : + callback:(GdkEvent.Motion.t -> bool) -> GtkSignal.id + method property_notify : + callback:(GdkEvent.Property.t -> bool) -> GtkSignal.id + method proximity_in : + callback:(GdkEvent.Proximity.t -> bool) -> GtkSignal.id + method proximity_out : + callback:(GdkEvent.Proximity.t -> bool) -> GtkSignal.id + method selection_clear : + callback:(GdkEvent.Selection.t -> bool) -> GtkSignal.id + method selection_notify : + callback:(GdkEvent.Selection.t -> bool) -> GtkSignal.id + method selection_request : + callback:(GdkEvent.Selection.t -> bool) -> GtkSignal.id + method unmap : callback:([`UNMAP] Gdk.event -> bool) -> GtkSignal.id + end + +class event_ops : [>`widget] obj -> + object + method add : Gdk.Tags.event_mask list -> unit + method connect : event_signals + method send : Gdk.Tags.event_type Gdk.event -> bool + method set_extensions : Gdk.Tags.extension_events -> unit + end + +class style : Gtk.style -> + object ('a) + val style : Gtk.style + method as_style : Gtk.style + method bg : Tags.state_type -> Gdk.Color.t + method colormap : Gdk.colormap + method copy : 'a + method font : Gdk.font + method set_background : Gdk.window -> Tags.state_type -> unit + method set_bg : (Tags.state_type * GDraw.color) list -> unit + method set_font : Gdk.font -> unit + end + +class selection_data : + GtkData.Selection.t -> + object + val sel : GtkData.Selection.t + method data : string (* May raise Null_pointer *) + method format : int + method selection : Gdk.atom + method seltype : Gdk.atom + method target : Gdk.atom + method set : typ:Gdk.atom -> format:int -> ?data:string -> unit + end + +class drag_ops : [>`widget] obj -> + object + method connect : drag_signals + method dest_set : + ?flags:Tags.dest_defaults list -> + ?actions:Gdk.Tags.drag_action list -> target_entry list -> unit + method dest_unset : unit -> unit + method get_data : ?time:int -> context:drag_context -> Gdk.atom ->unit + method highlight : unit -> unit + method source_set : + ?modi:Gdk.Tags.modifier list -> + ?actions:Gdk.Tags.drag_action list -> target_entry list -> unit + method source_set_icon : ?colormap:Gdk.colormap -> GDraw.pixmap -> unit + method source_unset : unit -> unit + method unhighlight : unit -> unit + end + +and misc_ops : + [>`widget] obj -> + object + inherit gtkobj_misc + val obj : Gtk.widget obj + method activate : unit -> bool + method add_accelerator : + sgn:(Gtk.widget, unit -> unit) GtkSignal.t -> + group:accel_group -> ?modi:Gdk.Tags.modifier list -> + ?flags:Tags.accel_flag list -> Gdk.keysym -> unit + method allocation : rectangle + method colormap : Gdk.colormap + method connect : misc_signals + method draw : Gdk.Rectangle.t option -> unit + method grab_default : unit -> unit + method grab_focus : unit -> unit + method has_focus : bool + method hide : unit -> unit + method hide_all : unit -> unit + method intersect : Gdk.Rectangle.t -> Gdk.Rectangle.t option + method is_ancestor : widget -> bool + method lock_accelerators : unit -> unit + method map : unit -> unit + method name : string + method parent : widget option + method pointer : int * int + method popup : x:int -> y:int -> unit + method realize : unit -> unit + method remove_accelerator : + group:accel_group -> ?modi:Gdk.Tags.modifier list -> Gdk.keysym -> unit + method reparent : widget -> unit + method set_app_paintable : bool -> unit + method set_can_default : bool -> unit + method set_can_focus : bool -> unit + method set_name : string -> unit + method set_sensitive : bool -> unit + method set_state : Tags.state_type -> unit + method set_style : style -> unit + method set_geometry : + ?x:int -> ?y:int -> ?width:int -> ?height:int -> unit -> unit + method show : unit -> unit + method show_all : unit -> unit + method style : style + method toplevel : widget option + method unmap : unit -> unit + method unparent : unit -> unit + method unrealize : unit -> unit + method visible : bool + method visual : Gdk.visual + method visual_depth : int + method window : Gdk.window + end + +and widget : + 'a obj -> + object + inherit gtkobj + constraint 'a = [>`widget] + val obj : 'a obj + method as_widget : Gtk.widget obj + method coerce : widget + method drag : drag_ops + method misc : misc_ops + end + +and misc_signals : + ?after:bool -> Gtk.widget obj -> + object ('b) + inherit gtkobj_signals + val obj : Gtk.widget obj + method after : 'b + method draw : callback:(Gtk.rectangle -> unit) -> GtkSignal.id + method hide : callback:(unit -> unit) -> GtkSignal.id + method map : callback:(unit -> unit) -> GtkSignal.id + method parent_set : callback:(widget option -> unit) -> GtkSignal.id + method realize : callback:(unit -> unit) -> GtkSignal.id + method show : callback:(unit -> unit) -> GtkSignal.id + method state_changed : + callback:(Gtk.Tags.state_type -> unit) -> GtkSignal.id + method style_set : callback:(unit -> unit) -> GtkSignal.id + method unmap : callback:(unit -> unit) -> GtkSignal.id + end + +and drag_context : + Gdk.drag_context -> + object + val context : Gdk.drag_context + method context : Gdk.drag_context + method finish : success:bool -> del:bool -> time:int -> unit + method source_widget : widget + method set_icon_pixmap : + ?colormap:Gdk.colormap -> GDraw.pixmap -> hot_x:int -> hot_y:int -> unit + method set_icon_widget : widget -> hot_x:int -> hot_y:int -> unit + method status : ?time:int -> Gdk.Tags.drag_action list -> unit + method suggested_action : Gdk.Tags.drag_action + method targets : Gdk.atom list + end + +and drag_signals : + ?after:bool -> Gtk.widget obj -> + object ('a) + method after : 'a + method beginning : + callback:(drag_context -> unit) -> GtkSignal.id + method data_delete : + callback:(drag_context -> unit) -> GtkSignal.id + method data_get : + callback:(drag_context -> selection_data -> info:int -> time:int -> unit) + -> GtkSignal.id + method data_received : + callback:(drag_context -> x:int -> y:int -> + selection_data -> info:int -> time:int -> unit) -> GtkSignal.id + method drop : + callback:(drag_context -> x:int -> y:int -> time:int -> bool) -> + GtkSignal.id + method ending : + callback:(drag_context -> unit) -> GtkSignal.id + method leave : + callback:(drag_context -> time:int -> unit) -> GtkSignal.id + method motion : + callback:(drag_context -> x:int -> y:int -> time:int -> bool) -> + GtkSignal.id + end + +class widget_signals : ?after:bool -> 'a obj -> + object + inherit gtkobj_signals + constraint 'a = [>`widget] + val obj : 'a obj + end + +class widget_full : 'a obj -> + object + inherit widget + constraint 'a = [>`widget] + val obj : 'a obj + method connect : widget_signals + end + +val as_widget : widget -> Gtk.widget obj + +val pack_return : + (#widget as 'a) -> + packing:(widget -> unit) option -> show:bool option -> 'a + (* To use in initializers to provide a ?packing: option *) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gPack.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gPack.ml new file mode 100644 index 000000000..3641349a9 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gPack.ml @@ -0,0 +1,217 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase +open GtkPack +open GObj +open GContainer + +class box_skel obj = object + inherit container obj + method pack ?from:f ?expand ?fill ?padding w = + Box.pack obj (as_widget w) ?from:f ?expand ?fill ?padding + method set_homogeneous = Box.set_homogeneous obj + method set_spacing = Box.set_spacing obj + method set_child_packing ?from:f ?expand ?fill ?padding w = + Box.set_child_packing obj (as_widget w) ?from:f ?expand ?fill ?padding + method reorder_child w = Box.reorder_child obj (as_widget w) +end + +class box obj = object + inherit box_skel obj + method connect = new container_signals obj +end + +let box dir ?homogeneous ?spacing ?border_width ?width ?height + ?packing ?show () = + let w = Box.create dir ?homogeneous ?spacing () in + Container.set w ?border_width ?width ?height; + pack_return (new box w) ~packing ~show + +let vbox = box `VERTICAL +let hbox = box `HORIZONTAL + +class button_box obj = object + inherit box_skel (obj : Gtk.button_box obj) + method connect = new container_signals obj + method set_layout = BBox.set_layout obj + method set_spacing = BBox.set_spacing obj + method set_child_size = BBox.set_child_size obj + method set_child_ipadding = BBox.set_child_ipadding obj +end + +let button_box dir ?spacing ?child_width ?child_height ?child_ipadx + ?child_ipady ?layout ?border_width ?width ?height ?packing ?show ()= + let w = BBox.create dir in + BBox.set w ?spacing ?child_width ?child_height ?child_ipadx + ?child_ipady ?layout; + Container.set w ?border_width ?width ?height; + pack_return (new button_box w) ~packing ~show + +class table obj = object + inherit container_full (obj : Gtk.table obj) + method attach ~left ~top ?right ?bottom ?expand ?fill ?shrink + ?xpadding ?ypadding w = + Table.attach obj (as_widget w) ~left ~top ?right ?bottom ?expand + ?fill ?shrink ?xpadding ?ypadding + method set_row_spacing = Table.set_row_spacing obj + method set_col_spacing = Table.set_col_spacing obj + method set_row_spacings = Table.set_row_spacings obj + method set_col_spacings = Table.set_col_spacings obj + method set_homogeneous = Table.set_homogeneous obj +end + +let table ~rows ~columns ?homogeneous ?row_spacings ?col_spacings + ?border_width ?width ?height ?packing ?show () = + let w = Table.create ~rows ~columns ?homogeneous () in + Table.set w ?row_spacings ?col_spacings; + Container.set w ?border_width ?width ?height; + pack_return (new table w) ~packing ~show + +class fixed obj = object + inherit container_full (obj : Gtk.fixed obj) + method event = new GObj.event_ops obj + method put w = Fixed.put obj (as_widget w) + method move w = Fixed.move obj (as_widget w) +end + +let fixed ?border_width ?width ?height ?packing ?show () = + let w = Fixed.create () in + Container.set w ?border_width ?width ?height; + pack_return (new fixed w) ~packing ~show + +class layout obj = object + inherit container_full (obj : Gtk.layout obj) + method event = new GObj.event_ops obj + method put w = Layout.put obj (as_widget w) + method move w = Layout.move obj (as_widget w) + method set_hadjustment adj = + Layout.set_hadjustment obj (GData.as_adjustment adj) + method set_vadjustment adj = + Layout.set_vadjustment obj (GData.as_adjustment adj) + method set_width width = Layout.set_size obj ~width + method set_height height = Layout.set_size obj ~height + method hadjustment = new GData.adjustment (Layout.get_hadjustment obj) + method vadjustment = new GData.adjustment (Layout.get_vadjustment obj) + method freeze () = Layout.freeze obj + method thaw () = Layout.thaw obj + method width = Layout.get_width obj + method height = Layout.get_height obj +end + +let layout ?hadjustment ?vadjustment ?layout_width ?layout_height + ?border_width ?width ?height ?packing ?show () = + let w = Layout.create + (Gpointer.optboxed (may_map ~f:GData.as_adjustment hadjustment)) + (Gpointer.optboxed (may_map ~f:GData.as_adjustment vadjustment)) in + if layout_width <> None || layout_height <> None then + Layout.set_size w ?width:layout_width ?height:layout_height; + Container.set w ?border_width ?width ?height; + pack_return (new layout w) ~packing ~show + + +class packer obj = object + inherit container_full (obj : Gtk.packer obj) + method pack ?side ?anchor ?expand ?fill + ?border_width ?pad_x ?pad_y ?i_pad_x ?i_pad_y w = + let options = Packer.build_options ?expand ?fill () in + if border_width == None && pad_x == None && pad_y == None && + i_pad_x == None && i_pad_y == None + then Packer.add_defaults obj (as_widget w) ?side ?anchor ~options + else Packer.add obj (as_widget w) ?side ?anchor ~options + ?border_width ?pad_x ?pad_y ?i_pad_x ?i_pad_y + method set_child_packing ?side ?anchor ?expand ?fill + ?border_width ?pad_x ?pad_y ?i_pad_x ?i_pad_y w = + Packer.set_child_packing obj (as_widget w) ?side ?anchor + ~options:(Packer.build_options ?expand ?fill ()) + ?border_width ?pad_x ?pad_y ?i_pad_x ?i_pad_y + method reorder_child w = Packer.reorder_child obj (as_widget w) + method set_spacing = Packer.set_spacing obj + method set_defaults = Packer.set_defaults obj +end + +let packer ?spacing ?border_width ?width ?height ?packing ?show () = + let w = Packer.create () in + may spacing ~f:(Packer.set_spacing w); + Container.set w ?border_width ?width ?height; + pack_return (new packer w) ~packing ~show + +class paned obj = object + inherit container_full (obj : Gtk.paned obj) + method event = new GObj.event_ops obj + method add w = + if List.length (Container.children obj) = 2 then + raise(Error "Gpack.paned#add: already full"); + Container.add obj (as_widget w) + method add1 w = + try ignore(Paned.child1 obj); raise(Error "GPack.paned#add1: already full") + with _ -> Paned.add1 obj (as_widget w) + method add2 w = + try ignore(Paned.child2 obj); raise(Error "GPack.paned#add2: already full") + with _ -> Paned.add2 obj (as_widget w) + method set_handle_size = Paned.set_handle_size obj + method set_gutter_size = Paned.set_gutter_size obj + method child1 = new widget (Paned.child1 obj) + method child2 = new widget (Paned.child2 obj) + method handle_size = Paned.handle_size obj + method gutter_size = Paned.gutter_size obj +end + +let paned dir ?handle_size ?gutter_size + ?border_width ?width ?height ?packing ?show () = + let w = Paned.create dir in + Paned.set w ?handle_size ?gutter_size; + Container.set w ?border_width ?width ?height; + pack_return (new paned w) ~packing ~show + +class notebook_signals obj = object + inherit GContainer.container_signals obj + method switch_page = + GtkSignal.connect obj ~sgn:Notebook.Signals.switch_page ~after +end + +class notebook obj = object (self) + inherit GContainer.container obj + method event = new GObj.event_ops obj + method connect = new notebook_signals obj + method insert_page ?tab_label ?menu_label ~pos child = + Notebook.insert_page obj (as_widget child) ~pos + ~tab_label:(Gpointer.may_box tab_label ~f:as_widget) + ~menu_label:(Gpointer.may_box menu_label ~f:as_widget) + method append_page = self#insert_page ~pos:(-1) + method prepend_page = self#insert_page ~pos:0 + method remove_page = Notebook.remove_page obj + method current_page = Notebook.get_current_page obj + method goto_page = Notebook.set_page obj + method previous_page () = Notebook.prev_page obj + method next_page () = Notebook.next_page obj + method set_tab_pos = Notebook.set_tab_pos obj + method set_show_tabs = Notebook.set_show_tabs obj + method set_homogeneous_tabs = Notebook.set_homogeneous_tabs obj + method set_show_border = Notebook.set_show_border obj + method set_scrollable = Notebook.set_scrollable obj + method set_tab_border = Notebook.set_tab_border obj + method set_popup = Notebook.set_popup obj + method page_num w = Notebook.page_num obj (as_widget w) + method get_nth_page n = new widget (Notebook.get_nth_page obj n) + method get_tab_label w = + new widget (Notebook.get_tab_label obj (as_widget w)) + method get_menu_label w = + new widget (Notebook.get_tab_label obj (as_widget w)) + method set_page ?tab_label ?menu_label page = + let child = as_widget page in + may tab_label + ~f:(fun lbl -> Notebook.set_tab_label obj child (as_widget lbl)); + may menu_label + ~f:(fun lbl -> Notebook.set_menu_label obj child (as_widget lbl)) +end + +let notebook ?tab_pos ?tab_border ?show_tabs ?homogeneous_tabs + ?show_border ?scrollable ?popup + ?border_width ?width ?height ?packing ?show () = + let w = Notebook.create () in + Notebook.set w ?tab_pos ?tab_border ?show_tabs + ?homogeneous_tabs ?show_border ?scrollable ?popup; + Container.set w ?border_width ?width ?height; + pack_return (new notebook w) ~packing ~show diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gPack.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gPack.mli new file mode 100644 index 000000000..994c8b87f --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gPack.mli @@ -0,0 +1,267 @@ +(* $Id$ *) + +open Gtk +open GObj +open GContainer + +class box_skel : + 'a obj -> + object + inherit container + constraint 'a = [>`box|`container|`widget] + val obj : 'a obj + method pack : + ?from:Tags.pack_type -> + ?expand:bool -> ?fill:bool -> ?padding:int -> widget -> unit + method reorder_child : widget -> pos:int -> unit + method set_child_packing : + ?from:Tags.pack_type -> + ?expand:bool -> ?fill:bool -> ?padding:int -> widget -> unit + method set_homogeneous : bool -> unit + method set_spacing : int -> unit + end +class box : + 'a obj -> + object + inherit box_skel + constraint 'a = [>`box|`container|`widget] + val obj : 'a obj + method connect : GContainer.container_signals + end + +val box : + Tags.orientation -> + ?homogeneous:bool -> + ?spacing:int -> + ?border_width:int -> + ?width:int -> + ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> box +val vbox : + ?homogeneous:bool -> + ?spacing:int -> + ?border_width:int -> + ?width:int -> + ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> box +val hbox : + ?homogeneous:bool -> + ?spacing:int -> + ?border_width:int -> + ?width:int -> + ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> box + +class button_box : + Gtk.button_box obj -> + object + inherit container_full + val obj : Gtk.button_box obj + method pack : + ?from:Tags.pack_type -> + ?expand:bool -> ?fill:bool -> ?padding:int -> widget -> unit + method reorder_child : widget -> pos:int -> unit + method set_child_ipadding : ?x:int -> ?y:int -> unit -> unit + method set_child_packing : + ?from:Tags.pack_type -> + ?expand:bool -> ?fill:bool -> ?padding:int -> widget -> unit + method set_child_size : ?width:int -> ?height:int -> unit -> unit + method set_homogeneous : bool -> unit + method set_layout : GtkPack.BBox.bbox_style -> unit + method set_spacing : int -> unit + end +val button_box : + Tags.orientation -> + ?spacing:int -> + ?child_width:int -> + ?child_height:int -> + ?child_ipadx:int -> + ?child_ipady:int -> + ?layout:GtkPack.BBox.bbox_style -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> button_box + +class table : + Gtk.table obj -> + object + inherit container_full + val obj : Gtk.table obj + method attach : + left:int -> + top:int -> + ?right:int -> + ?bottom:int -> + ?expand:Tags.expand_type -> + ?fill:Tags.expand_type -> + ?shrink:Tags.expand_type -> + ?xpadding:int -> ?ypadding:int -> widget -> unit + method set_col_spacing : int -> int -> unit + method set_col_spacings : int -> unit + method set_homogeneous : bool -> unit + method set_row_spacing : int -> int -> unit + method set_row_spacings : int -> unit + end +val table : + rows:int -> + columns:int -> + ?homogeneous:bool -> + ?row_spacings:int -> + ?col_spacings:int -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> table + +class fixed : + Gtk.fixed obj -> + object + inherit container_full + val obj : Gtk.fixed obj + method event : event_ops + method move : widget -> x:int -> y:int -> unit + method put : widget -> x:int -> y:int -> unit + end +val fixed : + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> fixed + +class layout : + Gtk.layout obj -> + object + inherit container_full + val obj : Gtk.layout obj + method event : event_ops + method freeze : unit -> unit + method hadjustment : GData.adjustment + method height : int + method move : widget -> x:int -> y:int -> unit + method put : widget -> x:int -> y:int -> unit + method set_hadjustment : GData.adjustment -> unit + method set_height : int -> unit + method set_vadjustment : GData.adjustment -> unit + method set_width : int -> unit + method thaw : unit -> unit + method vadjustment : GData.adjustment + method width : int + end +val layout : + ?hadjustment:GData.adjustment -> + ?vadjustment:GData.adjustment -> + ?layout_width:int -> + ?layout_height:int -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> layout + +class notebook_signals : 'a obj -> + object + inherit container_signals + constraint 'a = [>`notebook|`container|`widget] + val obj : 'a obj + method switch_page : callback:(int -> unit) -> GtkSignal.id + end + +class notebook : ([> `widget | `container | `notebook] as 'a) obj -> + object + inherit container + val obj : 'a obj + method event : event_ops + method append_page : + ?tab_label:widget -> ?menu_label:widget -> widget -> unit + method connect : notebook_signals + method current_page : int + method get_menu_label : widget -> widget + method get_nth_page : int -> widget + method get_tab_label : widget -> widget + method goto_page : int -> unit + method insert_page : + ?tab_label:widget -> ?menu_label:widget -> pos:int -> widget -> unit + method next_page : unit -> unit + method page_num : widget -> int + method prepend_page : + ?tab_label:widget -> ?menu_label:widget -> widget -> unit + method previous_page : unit -> unit + method remove_page : int -> unit + method set_homogeneous_tabs : bool -> unit + method set_page : + ?tab_label:widget -> ?menu_label:widget -> widget -> unit + method set_popup : bool -> unit + method set_scrollable : bool -> unit + method set_show_border : bool -> unit + method set_show_tabs : bool -> unit + method set_tab_border : int -> unit + method set_tab_pos : Tags.position -> unit + end +val notebook : + ?tab_pos:Tags.position -> + ?tab_border:int -> + ?show_tabs:bool -> + ?homogeneous_tabs:bool -> + ?show_border:bool -> + ?scrollable:bool -> + ?popup:bool -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> notebook + +class packer : + Gtk.packer obj -> + object + inherit container_full + val obj : Gtk.packer obj + method pack : + ?side:Tags.side_type -> + ?anchor:Tags.anchor_type -> + ?expand:bool -> + ?fill:Tags.expand_type -> + ?border_width:int -> + ?pad_x:int -> + ?pad_y:int -> ?i_pad_x:int -> ?i_pad_y:int -> widget -> unit + method reorder_child : widget -> pos:int -> unit + method set_child_packing : + ?side:Tags.side_type -> + ?anchor:Tags.anchor_type -> + ?expand:bool -> + ?fill:Tags.expand_type -> + ?border_width:int -> + ?pad_x:int -> + ?pad_y:int -> ?i_pad_x:int -> ?i_pad_y:int -> widget -> unit + method set_defaults : + ?border_width:int -> + ?pad_x:int -> + ?pad_y:int -> ?i_pad_x:int -> ?i_pad_y:int -> unit -> unit + method set_spacing : int -> unit + end +val packer : + ?spacing:int -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> packer + +class paned : + Gtk.paned obj -> + object + inherit container_full + val obj : Gtk.paned obj + method add1 : widget -> unit + method add2 : widget -> unit + method event : event_ops + method child1 : widget + method child2 : widget + method gutter_size : int + method handle_size : int + method set_gutter_size : int -> unit + method set_handle_size : int -> unit + end +val paned : + Tags.orientation -> + ?handle_size:int -> + ?gutter_size:int -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> paned diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gRange.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gRange.ml new file mode 100644 index 000000000..7df53ced1 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gRange.ml @@ -0,0 +1,83 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase +open GtkRange +open GObj + +class progress obj = object + inherit widget_full obj + method set_adjustment adj = + Progress.set_adjustment obj (GData.as_adjustment adj) + method set_show_text = Progress.set_show_text obj + method set_format_string = Progress.set_format_string obj + method set_text_alignment = Progress.set_text_alignment obj + method set_activity_mode = Progress.set_activity_mode obj + method set_value = Progress.set_value obj + method set_percentage = Progress.set_percentage obj + method configure = Progress.configure obj + method value = Progress.get_value obj + method percentage = Progress.get_percentage obj + method current_text = Progress.get_current_text obj + method adjustment = new GData.adjustment (Progress.get_adjustment obj) +end + +class progress_bar obj = object + inherit progress (obj : Gtk.progress_bar obj) + method event = new GObj.event_ops obj + method set_bar_style = ProgressBar.set_bar_style obj + method set_discrete_blocks = ProgressBar.set_discrete_blocks obj + method set_activity_step = ProgressBar.set_activity_step obj + method set_activity_blocks = ProgressBar.set_activity_blocks obj + method set_orientation = ProgressBar.set_orientation obj +end + +let progress_bar ?adjustment ?bar_style ?discrete_blocks + ?activity_step ?activity_blocks ?value ?percentage ?activity_mode + ?show_text ?format_string ?text_xalign ?text_yalign + ?packing ?show () = + let w = + match adjustment with None -> ProgressBar.create () + | Some adj -> + ProgressBar.create_with_adjustment (GData.as_adjustment adj) + in + ProgressBar.set w ?bar_style ?discrete_blocks + ?activity_step ?activity_blocks; + Progress.set w ?value ?percentage ?activity_mode + ?show_text ?format_string ?text_xalign ?text_yalign; + pack_return (new progress_bar w) ~packing ~show + +class range obj = object + inherit widget_full obj + method adjustment = new GData.adjustment (Range.get_adjustment obj) + method set_adjustment adj = + Range.set_adjustment obj (GData.as_adjustment adj) + method set_update_policy = Range.set_update_policy obj +end + +class scale obj = object + inherit range (obj : Gtk.scale obj) + method set_digits = Scale.set_digits obj + method set_draw_value = Scale.set_draw_value obj + method set_value_pos = Scale.set_value_pos obj +end + +let scale dir ?adjustment ?digits ?draw_value ?value_pos + ?packing ?show () = + let w = + Scale.create dir ?adjustment:(may_map ~f:GData.as_adjustment adjustment) + in + let () = Scale.set w ?digits ?draw_value ?value_pos in + pack_return (new scale w) ~packing ~show + +class scrollbar obj = object + inherit range (obj : Gtk.scrollbar obj) + method event = new GObj.event_ops obj +end + +let scrollbar dir ?adjustment ?update_policy ?packing ?show () = + let w = Scrollbar.create dir + ?adjustment:(may_map ~f:GData.as_adjustment adjustment) in + let () = may update_policy ~f:(Range.set_update_policy w) in + pack_return (new scrollbar w) ~packing ~show diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gRange.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gRange.mli new file mode 100644 index 000000000..ac9b38c27 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gRange.mli @@ -0,0 +1,87 @@ +(* $Id$ *) + +open Gtk +open GObj + +class progress : 'a obj -> + object + inherit widget_full + constraint 'a = [>`progress|`widget] + val obj : 'a obj + method adjustment : GData.adjustment + method configure : current:float -> min:float -> max:float -> unit + method current_text : string + method percentage : float + method set_activity_mode : bool -> unit + method set_adjustment : GData.adjustment -> unit + method set_format_string : string -> unit + method set_percentage : float -> unit + method set_show_text : bool -> unit + method set_text_alignment : ?x:float -> ?y:float -> unit -> unit + method set_value : float -> unit + method value : float + end + +class progress_bar : Gtk.progress_bar obj -> + object + inherit progress + val obj : Gtk.progress_bar obj + method event : event_ops + method set_activity_blocks : int -> unit + method set_activity_step : int -> unit + method set_bar_style : [`CONTINUOUS|`DISCRETE] -> unit + method set_discrete_blocks : int -> unit + method set_orientation : Tags.progress_bar_orientation -> unit + end +val progress_bar : + ?adjustment:GData.adjustment -> + ?bar_style:[`CONTINUOUS|`DISCRETE] -> + ?discrete_blocks:int -> + ?activity_step:int -> + ?activity_blocks:int -> + ?value:float -> + ?percentage:float -> + ?activity_mode:bool -> + ?show_text:bool -> + ?format_string:string -> + ?text_xalign:float -> + ?text_yalign:float -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> progress_bar + +class range : 'a obj -> + object + inherit widget_full + constraint 'a = [>`range|`widget] + val obj : 'a obj + method adjustment : GData.adjustment + method set_adjustment : GData.adjustment -> unit + method set_update_policy : Tags.update_type -> unit + end + +class scale : Gtk.scale obj -> + object + inherit range + val obj : Gtk.scale obj + method set_digits : int -> unit + method set_draw_value : bool -> unit + method set_value_pos : Tags.position -> unit + end +val scale : + Tags.orientation -> + ?adjustment:GData.adjustment -> + ?digits:int -> + ?draw_value:bool -> + ?value_pos:Tags.position -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> scale + +class scrollbar : Gtk.scrollbar obj -> + object + inherit range + val obj : Gtk.scrollbar obj + method event : event_ops + end +val scrollbar : + Tags.orientation -> + ?adjustment:GData.adjustment -> + ?update_policy:Tags.update_type -> + ?packing:(widget -> unit) -> ?show:bool -> unit -> scrollbar diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gTree.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gTree.ml new file mode 100644 index 000000000..80dab7be6 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gTree.ml @@ -0,0 +1,76 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase +open GtkTree +open GObj +open GContainer + +class tree_item_signals obj = object + inherit item_signals obj + method expand = GtkSignal.connect obj ~sgn:TreeItem.Signals.expand ~after + method collapse = GtkSignal.connect obj ~sgn:TreeItem.Signals.collapse ~after +end + +class tree_item obj = object + inherit container obj + method event = new GObj.event_ops obj + method as_item : Gtk.tree_item obj = obj + method connect = new tree_item_signals obj + method set_subtree (w : tree) = TreeItem.set_subtree obj w#as_tree + method remove_subtree () = TreeItem.remove_subtree obj + method expand () = TreeItem.expand obj + method collapse () = TreeItem.collapse obj + method subtree = + try Some(new tree (TreeItem.subtree obj)) with Gpointer.Null -> None +end + +and tree_signals obj = object + inherit container_signals obj + method selection_changed = + GtkSignal.connect obj ~sgn:Tree.Signals.selection_changed ~after + method select_child ~callback = + GtkSignal.connect obj ~sgn:Tree.Signals.select_child ~after + ~callback:(fun w -> callback (new tree_item (TreeItem.cast w))) + method unselect_child ~callback = + GtkSignal.connect obj ~sgn:Tree.Signals.unselect_child ~after + ~callback:(fun w -> callback (new tree_item (TreeItem.cast w))) +end + +and tree obj = object (self) + inherit [tree_item] item_container obj + method event = new GObj.event_ops obj + method as_tree = Tree.coerce obj + method insert w ~pos = Tree.insert obj w#as_item ~pos + method connect = new tree_signals obj + method clear_items = Tree.clear_items obj + method select_item = Tree.select_item obj + method unselect_item = Tree.unselect_item obj + method child_position (w : tree_item) = Tree.child_position obj w#as_item + method remove_items items = + Tree.remove_items obj + (List.map ~f:(fun (t : tree_item) -> t#as_item) items) + method set_selection_mode = Tree.set_selection_mode obj + method set_view_mode = Tree.set_view_mode obj + method set_view_lines = Tree.set_view_lines obj + method selection = + List.map ~f:(fun w -> self#wrap (Widget.coerce w)) (Tree.selection obj) + method private wrap w = + new tree_item (TreeItem.cast w) +end + +let tree_item ?label ?border_width ?width ?height ?packing ?show () = + let w = TreeItem.create ?label () in + Container.set w ?border_width ?width ?height; + let self = new tree_item w in + may packing ~f:(fun f -> (f self : unit)); + if show <> Some false then self#misc#show (); + self + +let tree ?selection_mode ?view_mode ?view_lines + ?border_width ?width ?height ?packing ?show () = + let w = Tree.create () in + Tree.set w ?selection_mode ?view_mode ?view_lines; + Container.set w ?border_width ?width ?height; + pack_return (new tree w) ~packing ~show diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gTree.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gTree.mli new file mode 100644 index 000000000..d48e09b2a --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gTree.mli @@ -0,0 +1,72 @@ +(* $Id$ *) + +open Gtk +open GObj +open GContainer + +class tree_item_signals : 'a obj -> + object + inherit item_signals + constraint 'a = [>`treeitem|`container|`item|`widget] + val obj : 'a obj + method collapse : callback:(unit -> unit) -> GtkSignal.id + method expand : callback:(unit -> unit) -> GtkSignal.id + end + +class tree_item : Gtk.tree_item obj -> + object + inherit GContainer.container + val obj : Gtk.tree_item obj + method event : event_ops + method as_item : Gtk.tree_item obj + method collapse : unit -> unit + method connect : tree_item_signals + method expand : unit -> unit + method remove_subtree : unit -> unit + method set_subtree : tree -> unit + method subtree : tree option + end + +and tree_signals : Gtk.tree obj -> + object + inherit container_signals + val obj : Gtk.tree obj + method select_child : callback:(tree_item -> unit) -> GtkSignal.id + method selection_changed : callback:(unit -> unit) -> GtkSignal.id + method unselect_child : callback:(tree_item -> unit) -> GtkSignal.id + end + +and tree : Gtk.tree obj -> + object + inherit [tree_item] item_container + val obj : Gtk.tree obj + method event : event_ops + method as_tree : Gtk.tree obj + method child_position : tree_item -> int + method clear_items : start:int -> stop:int -> unit + method connect : tree_signals + method insert : tree_item -> pos:int -> unit + method remove_items : tree_item list -> unit + method select_item : pos:int -> unit + method selection : tree_item list + method set_selection_mode : Tags.selection_mode -> unit + method set_view_lines : bool -> unit + method set_view_mode : [`LINE|`ITEM] -> unit + method unselect_item : pos:int -> unit + method private wrap : Gtk.widget obj -> tree_item + end + +val tree_item : + ?label:string -> + ?border_width:int -> + ?width:int -> + ?height:int -> + ?packing:(tree_item -> unit) -> ?show:bool -> unit -> tree_item + +val tree : + ?selection_mode:Tags.selection_mode -> + ?view_mode:[`LINE|`ITEM] -> + ?view_lines:bool -> + ?border_width:int -> + ?width:int -> + ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> tree diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gUtil.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gUtil.ml new file mode 100644 index 000000000..260c2acee --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gUtil.ml @@ -0,0 +1,80 @@ +(* $Id$ *) + +open GObj + +class ['a] memo () = object + constraint 'a = #widget + val tbl = Hashtbl.create 7 + method add (obj : 'a) = + Hashtbl.add tbl ~key:obj#get_id ~data:obj + method find (obj : widget) = Hashtbl.find tbl obj#get_id + method remove (obj : widget) = Hashtbl.remove tbl obj#get_id +end + +let signal_id = ref 0 + +let next_callback_id () : GtkSignal.id = + decr signal_id; Obj.magic (!signal_id : int) + +class ['a] signal () = object (self) + val mutable callbacks : (GtkSignal.id * ('a -> unit)) list = [] + method callbacks = callbacks + method connect ~after ~callback = + let id = next_callback_id () in + callbacks <- + if after then callbacks @ [id,callback] else (id,callback)::callbacks; + id + method call arg = + List.exists callbacks ~f: + begin fun (_,f) -> + let old = GtkSignal.push_callback () in + try f arg; GtkSignal.pop_callback old + with exn -> GtkSignal.pop_callback old; raise exn + end; + () + method disconnect key = + List.mem_assoc key callbacks && + (callbacks <- List.remove_assoc key callbacks; true) +end + +class virtual ml_signals disconnectors = + object (self) + val after = false + method after = {< after = true >} + val mutable disconnectors : (GtkSignal.id -> bool) list = disconnectors + method disconnect key = + ignore (List.exists disconnectors ~f:(fun f -> f key)) + end + +class virtual add_ml_signals obj disconnectors = + object (self) + val mutable disconnectors : (GtkSignal.id -> bool) list = disconnectors + method disconnect key = + if List.exists disconnectors ~f:(fun f -> f key) then () + else GtkSignal.disconnect obj key + end + +class ['a] variable_signals ~(set : 'a signal) ~(changed : 'a signal) = + object + inherit ml_signals [changed#disconnect; set#disconnect] + method changed = changed#connect ~after + method set = set#connect ~after + end + +class ['a] variable x = + object (self) + val changed = new signal () + val set = new signal () + method connect = new variable_signals ~set ~changed + val mutable x : 'a = x + method get = x + method set = set#call + method private equal : 'a -> 'a -> bool = (=) + method private real_set y = + let x0 = x in x <- y; + if changed#callbacks <> [] && not (self#equal x x0) + then changed#call y + initializer + ignore (set#connect ~after:false ~callback:self#real_set) + end + diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gUtil.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gUtil.mli new file mode 100644 index 000000000..cd88d8697 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gUtil.mli @@ -0,0 +1,109 @@ +(* $Id$ *) + +open GObj + +(* The memo class provides an easy way to remember the real class of + a widget. + Insert all widgets of class in one single t memo, and you can then + recover their original ML object with #find. +*) + +class ['a] memo : unit -> + object + constraint 'a = #widget + val tbl : (int, 'a) Hashtbl.t + method add : 'a -> unit + method find : widget -> 'a + method remove : widget -> unit + end + +(* The ML signal mechanism allows one to add GTK-like signals to + arbitrary objects. +*) + +val next_callback_id : unit -> GtkSignal.id + +class ['a] signal : + unit -> + object + val mutable callbacks : (GtkSignal.id * ('a -> unit)) list + method callbacks : (GtkSignal.id * ('a -> unit)) list + method call : 'a -> unit + method connect : after:bool -> callback:('a -> unit) -> GtkSignal.id + method disconnect : GtkSignal.id -> bool + end +(* As with GTK signals, you can use [GtkSignal.stop_emit] inside a + callback to prevent other callbacks from being called. *) + +class virtual ml_signals : (GtkSignal.id -> bool) list -> + object ('a) + val after : bool + method after : 'a + method disconnect : GtkSignal.id -> unit + val mutable disconnectors : (GtkSignal.id -> bool) list + end +class virtual add_ml_signals : + 'a Gtk.obj -> (GtkSignal.id -> bool) list -> + object + method disconnect : GtkSignal.id -> unit + val mutable disconnectors : (GtkSignal.id -> bool) list + end + +(* To add ML signals to a LablGTK object: + + class mywidget_signals obj ~mysignal1 ~mysignal2 = object + inherit somewidget_signals obj + inherit add_ml_signals obj [mysignal1#disconnect; mysignal2#disconnect] + method mysignal1 = mysignal1#connect ~after + method mysignal2 = mysignal2#connect ~after + end + + class mywidget obj = object (self) + inherit somewidget obj + val mysignal1 = new signal obj + val mysignal2 = new signal obj + method connect = new mywidget_signals obj ~mysignal1 ~mysignal2 + method call1 = mysignal1#call + method call2 = mysignal2#call + end + + You can also add ML signals to an arbitrary object; just inherit + from [ml_signals] in place of [widget_signals]+[add_ml_signals]. + + class mysignals ~mysignal1 ~mysignal2 = object + inherit ml_signals [mysignal1#disconnect; mysignal2#disconnect] + method mysignal1 = mysignal1#connect ~after + method mysignal2 = mysignal2#connect ~after + end +*) + +(* The variable class provides an easy way to propagate state modifications. + A new variable is created by [new variable init]. The [#set] method just + calls the [set] signal, which by default only calls [real_set]. + [real_set] sets the variable and calls [changed] when needed. + Deep equality is used to compare values, but check is only done if + there are callbacks for [changed]. +*) + +class ['a] variable_signals : + set:'a signal -> changed:'a signal -> + object ('b) + val after : bool + method after : 'b + method set : callback:('a -> unit) -> GtkSignal.id + method changed : callback:('a -> unit) -> GtkSignal.id + method disconnect : GtkSignal.id -> unit + val mutable disconnectors : (GtkSignal.id -> bool) list + end + +class ['a] variable : 'a -> + object + val set : 'a signal + val changed : 'a signal + val mutable x : 'a + method connect : 'a variable_signals + method get : 'a + method set : 'a -> unit + method private equal : 'a -> 'a -> bool + method private real_set : 'a -> unit + end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gWindow.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gWindow.ml new file mode 100644 index 000000000..9ee313647 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gWindow.ml @@ -0,0 +1,151 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase +open GtkWindow +open GtkMisc +open GObj +open GContainer + +class ['a] window_skel obj = object + constraint 'a = _ #window_skel + inherit container obj + method event = new GObj.event_ops obj + method as_window = Window.coerce obj + method activate_focus () = Window.activate_focus obj + method activate_default () = Window.activate_default obj + method add_accel_group = Window.add_accel_group obj + method set_modal = Window.set_modal obj + method set_default_size = Window.set_default_size obj + method set_position = Window.set_position obj + method set_resize_mode = Container.set_resize_mode obj + method set_transient_for (w : 'a) = + Window.set_transient_for obj w#as_window + method set_title = Window.set_title obj + method set_wm_name name = Window.set_wmclass obj ~name + method set_wm_class cls = Window.set_wmclass obj ~clas:cls + method set_allow_shrink allow_shrink = Window.set_policy obj ~allow_shrink + method set_allow_grow allow_grow = Window.set_policy obj ~allow_grow + method set_auto_shrink auto_shrink = Window.set_policy obj ~auto_shrink + method show () = Widget.show obj +end + +class window obj = object + inherit [window] window_skel (Window.coerce obj) + method connect = new container_signals obj +end + +let window ?kind:(t=`TOPLEVEL) ?title ?wm_name ?wm_class ?position + ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y + ?border_width ?width ?height ?(show=false) () = + let w = Window.create t in + Window.set w ?title ?wm_name ?wm_class ?position + ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y; + Container.set w ?border_width ?width ?height; + if show then Widget.show w; + new window w + +class dialog obj = object + inherit [window] window_skel (Dialog.coerce obj) + method connect = new container_signals obj + method action_area = new GPack.box (Dialog.action_area obj) + method vbox = new GPack.box (Dialog.vbox obj) +end + +let dialog ?title ?wm_name ?wm_class ?position ?allow_shrink + ?allow_grow ?auto_shrink ?modal ?x ?y ?border_width ?width ?height + ?(show=false) () = + let w = Dialog.create () in + Window.set w ?title ?wm_name ?wm_class ?position + ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y; + Container.set w ?border_width ?width ?height; + if show then Widget.show w; + new dialog w + +class color_selection_dialog obj = object + inherit [window] window_skel (obj : Gtk.color_selection_dialog obj) + method connect = new container_signals obj + method ok_button = + new GButton.button (ColorSelection.ok_button obj) + method cancel_button = + new GButton.button (ColorSelection.cancel_button obj) + method help_button = + new GButton.button (ColorSelection.help_button obj) + method colorsel = + new GMisc.color_selection (ColorSelection.colorsel obj) +end + +let color_selection_dialog ?(title="Pick a color") + ?wm_name ?wm_class ?position + ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y + ?border_width ?width ?height ?(show=false) () = + let w = ColorSelection.create_dialog title in + Window.set w ?wm_name ?wm_class ?position + ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y; + Container.set w ?border_width ?width ?height; + if show then Widget.show w; + new color_selection_dialog w + +class file_selection obj = object + inherit [window] window_skel (obj : Gtk.file_selection obj) + method connect = new container_signals obj + method set_filename = FileSelection.set_filename obj + method get_filename = FileSelection.get_filename obj + method set_fileop_buttons = FileSelection.set_fileop_buttons obj + method ok_button = new GButton.button (FileSelection.get_ok_button obj) + method cancel_button = + new GButton.button (FileSelection.get_cancel_button obj) + method help_button = new GButton.button (FileSelection.get_help_button obj) +end + +let file_selection ?(title="Choose a file") ?filename + ?(fileop_buttons=false) + ?wm_name ?wm_class ?position + ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y + ?border_width ?width ?height ?(show=false) () = + let w = FileSelection.create title in + FileSelection.set w ?filename ~fileop_buttons; + Window.set w ?wm_name ?wm_class ?position + ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y; + Container.set w ?border_width ?width ?height; + if show then Widget.show w; + new file_selection w + +class font_selection_dialog obj = object + inherit [window] window_skel (obj : Gtk.font_selection_dialog obj) + method connect = new container_signals obj +(* + method font = FontSelectionDialog.get_font obj + method font_name = FontSelectionDialog.get_font_name obj + method set_font_name = FontSelectionDialog.set_font_name obj + method preview_text = FontSelectionDialog.get_preview_text obj + method set_preview_text = FontSelectionDialog.set_preview_text obj + method set_filter = FontSelectionDialog.set_filter obj +*) + method selection = + new GMisc.font_selection (FontSelectionDialog.font_selection obj) + method ok_button = new GButton.button (FontSelectionDialog.ok_button obj) + method apply_button = + new GButton.button (FontSelectionDialog.apply_button obj) + method cancel_button = + new GButton.button (FontSelectionDialog.cancel_button obj) +end + +let font_selection_dialog ?title ?wm_name ?wm_class ?position + ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y + ?border_width ?width ?height ?(show=false) () = + let w = FontSelectionDialog.create ?title () in + Window.set w ?wm_name ?wm_class ?position + ?allow_shrink ?allow_grow ?auto_shrink ?modal ?x ?y; + Container.set w ?border_width ?width ?height; + if show then Widget.show w; + new font_selection_dialog w + +class plug (obj : Gtk.plug obj) = window obj + +let plug ~window:xid ?border_width ?width ?height ?(show=false) () = + let w = Plug.create xid in + Container.set w ?border_width ?width ?height; + if show then Widget.show w; + new plug w diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gWindow.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gWindow.mli new file mode 100644 index 000000000..4c89a76b6 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gWindow.mli @@ -0,0 +1,156 @@ +(* $Id$ *) + +open Gtk +open GObj + +class ['a] window_skel : 'b obj -> + object + inherit GContainer.container + constraint 'a = 'a #window_skel + constraint 'b = [>`widget|`container|`window] + val obj : 'b obj + method activate_default : unit -> unit + method activate_focus : unit -> unit + method add_accel_group : accel_group -> unit + method event : event_ops + method as_window : Gtk.window obj + method set_allow_grow : bool -> unit + method set_allow_shrink : bool -> unit + method set_auto_shrink : bool -> unit + method set_default_size : width:int -> height:int -> unit + method set_modal : bool -> unit + method set_position : Tags.window_position -> unit + method set_resize_mode : Tags.resize_mode -> unit + method set_title : string -> unit + method set_transient_for : 'a -> unit + method set_wm_class : string -> unit + method set_wm_name : string -> unit + method show : unit -> unit + end + +class window : [>`window] obj -> + object + inherit [window] window_skel + val obj : Gtk.window obj + method connect : GContainer.container_signals + end +val window : + ?kind:Tags.window_type -> + ?title:string -> + ?wm_name:string -> + ?wm_class:string -> + ?position:Tags.window_position -> + ?allow_shrink:bool -> + ?allow_grow:bool -> + ?auto_shrink:bool -> + ?modal:bool -> + ?x:int -> + ?y:int -> + ?border_width:int -> + ?width:int -> ?height:int -> ?show:bool -> unit -> window + +class dialog : [>`dialog] obj -> + object + inherit [window] window_skel + val obj : Gtk.dialog obj + method action_area : GPack.box + method connect : GContainer.container_signals + method event : event_ops + method vbox : GPack.box + end +val dialog : + ?title:string -> + ?wm_name:string -> + ?wm_class:string -> + ?position:Tags.window_position -> + ?allow_shrink:bool -> + ?allow_grow:bool -> + ?auto_shrink:bool -> + ?modal:bool -> + ?x:int -> + ?y:int -> + ?border_width:int -> + ?width:int -> ?height:int -> ?show:bool -> unit -> dialog + +class color_selection_dialog : Gtk.color_selection_dialog obj -> + object + inherit [window] window_skel + val obj : Gtk.color_selection_dialog obj + method cancel_button : GButton.button + method colorsel : GMisc.color_selection + method connect : GContainer.container_signals + method help_button : GButton.button + method ok_button : GButton.button + end +val color_selection_dialog : + ?title:string -> + ?wm_name:string -> + ?wm_class:string -> + ?position:Tags.window_position -> + ?allow_shrink:bool -> + ?allow_grow:bool -> + ?auto_shrink:bool -> + ?modal:bool -> + ?x:int -> + ?y:int -> + ?border_width:int -> + ?width:int -> ?height:int -> ?show:bool -> unit -> color_selection_dialog + +class file_selection : Gtk.file_selection obj -> + object + inherit [window] window_skel + val obj : Gtk.file_selection obj + method cancel_button : GButton.button + method connect : GContainer.container_signals + method get_filename : string + method help_button : GButton.button + method ok_button : GButton.button + method set_filename : string -> unit + method set_fileop_buttons : bool -> unit + end +val file_selection : + ?title:string -> + ?filename:string -> + ?fileop_buttons:bool -> + ?wm_name:string -> + ?wm_class:string -> + ?position:Tags.window_position -> + ?allow_shrink:bool -> + ?allow_grow:bool -> + ?auto_shrink:bool -> + ?modal:bool -> + ?x:int -> + ?y:int -> + ?border_width:int -> + ?width:int -> ?height:int -> ?show:bool -> unit -> file_selection + +class font_selection_dialog : Gtk.font_selection_dialog obj -> + object + inherit [window] window_skel + val obj : Gtk.font_selection_dialog obj + method apply_button : GButton.button + method cancel_button : GButton.button + method connect : GContainer.container_signals + method selection : GMisc.font_selection + method ok_button : GButton.button + end +val font_selection_dialog : + ?title:string -> + ?wm_name:string -> + ?wm_class:string -> + ?position:Tags.window_position -> + ?allow_shrink:bool -> + ?allow_grow:bool -> + ?auto_shrink:bool -> + ?modal:bool -> + ?x:int -> + ?y:int -> + ?border_width:int -> + ?width:int -> ?height:int -> ?show:bool -> unit -> font_selection_dialog + +class plug : Gtk.plug obj -> window + +val plug : + window:Gdk.xid -> + ?border_width:int -> + ?width:int -> ?height:int -> ?show:bool -> unit -> plug diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gaux.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gaux.ml new file mode 100644 index 000000000..a1172915b --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gaux.ml @@ -0,0 +1,17 @@ +(* $Id$ *) + +(* Option handling *) + +let may ~f x = + match x with None -> () + | Some x -> let _ = f x in () + +let may_map ~f x = + match x with None -> None + | Some x -> Some (f x) + +let default x ~opt = + match opt with None -> x | Some y -> y + +let may_default f x ~opt = + match opt with None -> f x | Some y -> y diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdk.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdk.ml new file mode 100644 index 000000000..c22c4b55c --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdk.ml @@ -0,0 +1,535 @@ +(* $Id$ *) + +open Gaux + +type colormap +type visual +type region +type gc +type 'a drawable +type window = [`window] drawable +type pixmap = [`pixmap] drawable +type bitmap = [`bitmap] drawable +type font +type image +type atom = int +type keysym = int +type 'a event +type drag_context +type cursor +type xid = int32 + +exception Error of string +let _ = Callback.register_exception "gdkerror" (Error"") + +module Tags = struct + type event_type = + [ `NOTHING|`DELETE|`DESTROY|`EXPOSE|`MOTION_NOTIFY|`BUTTON_PRESS + |`TWO_BUTTON_PRESS|`THREE_BUTTON_PRESS + |`BUTTON_RELEASE|`KEY_PRESS + |`KEY_RELEASE|`ENTER_NOTIFY|`LEAVE_NOTIFY|`FOCUS_CHANGE + |`CONFIGURE|`MAP|`UNMAP|`PROPERTY_NOTIFY|`SELECTION_CLEAR + |`SELECTION_REQUEST|`SELECTION_NOTIFY|`PROXIMITY_IN + |`PROXIMITY_OUT|`DRAG_ENTER|`DRAG_LEAVE|`DRAG_MOTION|`DRAG_STATUS + |`DROP_START|`DROP_FINISHED|`CLIENT_EVENT|`VISIBILITY_NOTIFY + |`NO_EXPOSE ] + + type event_mask = + [ `EXPOSURE + |`POINTER_MOTION|`POINTER_MOTION_HINT + |`BUTTON_MOTION|`BUTTON1_MOTION|`BUTTON2_MOTION|`BUTTON3_MOTION + |`BUTTON_PRESS|`BUTTON_RELEASE + |`KEY_PRESS|`KEY_RELEASE + |`ENTER_NOTIFY|`LEAVE_NOTIFY|`FOCUS_CHANGE + |`STRUCTURE|`PROPERTY_CHANGE|`VISIBILITY_NOTIFY + |`PROXIMITY_IN|`PROXIMITY_OUT|`SUBSTRUCTURE + |`ALL_EVENTS ] + + type extension_events = + [ `NONE|`ALL|`CURSOR ] + + type visibility_state = + [ `UNOBSCURED|`PARTIAL|`FULLY_OBSCURED ] + + type input_source = + [ `MOUSE|`PEN|`ERASER|`CURSOR ] + + type notify_type = + [ `ANCESTOR|`VIRTUAL|`INFERIOR|`NONLINEAR|`NONLINEAR_VIRTUAL|`UNKNOWN ] + + type crossing_mode = + [ `NORMAL|`GRAB|`UNGRAB ] + + type modifier = + [ `SHIFT|`LOCK|`CONTROL|`MOD1|`MOD2|`MOD3|`MOD4|`MOD5|`BUTTON1 + |`BUTTON2|`BUTTON3|`BUTTON4|`BUTTON5 ] + + type drag_action = + [ `DEFAULT|`COPY|`MOVE|`LINK|`PRIVATE|`ASK ] + +end +open Tags + +module Convert = struct + external test_modifier : modifier -> int -> bool + = "ml_test_GdkModifier_val" + let modifier i = + List.filter [`SHIFT;`LOCK;`CONTROL;`MOD1;`MOD2;`MOD3;`MOD4;`MOD5; + `BUTTON1;`BUTTON2;`BUTTON3;`BUTTON4;`BUTTON5] + ~f:(fun m -> test_modifier m i) +end + +module Screen = struct + external width : unit -> int = "ml_gdk_screen_width" + external height : unit -> int = "ml_gdk_screen_height" +end + +module Visual = struct + type visual_type = + [ `STATIC_GRAY|`GRAYSCALE|`STATIC_COLOR + |`PSEUDO_COLOR|`TRUE_COLOR|`DIRECT_COLOR ] + + external get_best : ?depth:int -> ?kind:visual_type -> unit -> visual + = "ml_gdk_visual_get_best" + external get_type : visual -> visual_type = "ml_GdkVisual_type" + external depth : visual -> int = "ml_GdkVisual_depth" + external red_mask : visual -> int = "ml_GdkVisual_red_mask" + external red_shift : visual -> int = "ml_GdkVisual_red_shift" + external red_prec : visual -> int = "ml_GdkVisual_red_prec" + external green_mask : visual -> int = "ml_GdkVisual_green_mask" + external green_shift : visual -> int = "ml_GdkVisual_green_shift" + external green_prec : visual -> int = "ml_GdkVisual_green_prec" + external blue_mask : visual -> int = "ml_GdkVisual_blue_mask" + external blue_shift : visual -> int = "ml_GdkVisual_blue_shift" + external blue_prec : visual -> int = "ml_GdkVisual_blue_prec" +end + +module Image = struct + type image_type = + [ `NORMAL|`SHARED|`FASTEST ] + + external create_bitmap : visual: visual -> data: string -> + width: int -> height: int -> image + = "ml_gdk_image_new_bitmap" + external create : kind: image_type -> visual: visual -> + width: int -> height: int -> image + = "ml_gdk_image_new" + external get : + 'a drawable -> x: int -> y: int -> width: int -> height: int -> image + = "ml_gdk_image_get" + external put_pixel : image -> x: int -> y: int -> pixel: int -> unit + = "ml_gdk_image_put_pixel" + external get_pixel : image -> x: int -> y: int -> int + = "ml_gdk_image_get_pixel" + external destroy : image -> unit + = "ml_gdk_image_destroy" +end + +module Color = struct + type t + + external color_white : colormap -> t = "ml_gdk_color_white" + external color_black : colormap -> t = "ml_gdk_color_black" + external color_parse : string -> t = "ml_gdk_color_parse" + external color_alloc : colormap -> t -> bool = "ml_gdk_color_alloc" + external color_create : red:int -> green:int -> blue:int -> t + = "ml_GdkColor" + + external get_system_colormap : unit -> colormap + = "ml_gdk_colormap_get_system" + external colormap_new : visual -> privat:bool -> colormap + = "ml_gdk_colormap_new" + let get_colormap ?(privat=false) vis = colormap_new vis ~privat + + type spec = [ `BLACK | `NAME of string | `RGB of int * int * int | `WHITE] + let color_alloc ~colormap color = + if not (color_alloc colormap color) then raise (Error"Color.alloc"); + color + let alloc ~colormap color = + match color with + `WHITE -> color_white colormap + | `BLACK -> color_black colormap + | `NAME s -> color_alloc ~colormap (color_parse s) + | `RGB (red,green,blue) -> + color_alloc ~colormap (color_create ~red ~green ~blue) + + external red : t -> int = "ml_GdkColor_red" + external blue : t -> int = "ml_GdkColor_blue" + external green : t -> int = "ml_GdkColor_green" + external pixel : t -> int = "ml_GdkColor_pixel" +end + +module Rectangle = struct + type t + external create : x:int -> y:int -> width:int -> height:int -> t + = "ml_GdkRectangle" + external x : t -> int = "ml_GdkRectangle_x" + external y : t -> int = "ml_GdkRectangle_y" + external width : t -> int = "ml_GdkRectangle_width" + external height : t -> int = "ml_GdkRectangle_height" +end + +module Window = struct + type background_pixmap = [ `NONE | `PARENT_RELATIVE | `PIXMAP of pixmap] + external visual_depth : visual -> int = "ml_gdk_visual_get_depth" + external get_visual : window -> visual = "ml_gdk_window_get_visual" + external get_parent : window -> window = "ml_gdk_window_get_parent" + external get_size : window -> int * int = "ml_gdk_window_get_size" + external get_position : window -> int * int = + "ml_gdk_window_get_position" + external root_parent : unit -> window = "ml_GDK_ROOT_PARENT" + external set_back_pixmap : window -> pixmap -> int -> unit = + "ml_gdk_window_set_back_pixmap" + external clear : window -> unit = "ml_gdk_window_clear" + external get_xwindow : window -> xid = "ml_GDK_WINDOW_XWINDOW" + + let set_back_pixmap w pix = + let null_pixmap = (Obj.magic Gpointer.boxed_null : pixmap) in + match pix with + `NONE -> set_back_pixmap w null_pixmap 0 + | `PARENT_RELATIVE -> set_back_pixmap w null_pixmap 1 + | `PIXMAP(pixmap) -> set_back_pixmap w pixmap 0 + (* anything OK, Maybe... *) +end + +module PointArray = struct + type t = { len: int} + external create : len:int -> t = "ml_point_array_new" + external set : t -> pos:int -> x:int -> y:int -> unit = "ml_point_array_set" + let set arr ~pos = + if pos < 0 || pos >= arr.len then invalid_arg "PointArray.set"; + set arr ~pos +end + +module Region = struct + type gdkFillRule = [ `EVEN_ODD_RULE|`WINDING_RULE ] + type gdkOverlapType = [ `IN|`OUT|`PART ] + external create : unit -> region = "ml_gdk_region_new" + external destroy : region -> unit = "ml_gdk_region_destroy" + external polygon : PointArray.t -> gdkFillRule -> region + = "ml_gdk_region_polygon" + let polygon l = + let len = List.length l in + let arr = PointArray.create ~len in + List.fold_left l ~init:0 + ~f:(fun pos (x,y) -> PointArray.set arr ~pos ~x ~y; pos+1); + polygon arr + external intersect : region -> region -> region + = "ml_gdk_regions_intersect" + external union : region -> region -> region + = "ml_gdk_regions_union" + external subtract : region -> region -> region + = "ml_gdk_regions_subtract" + external xor : region -> region -> region + = "ml_gdk_regions_xor" + external union_with_rect : region -> Rectangle.t -> region + = "ml_gdk_region_union_with_rect" + external offset : region -> x:int -> y:int -> unit = "ml_gdk_region_offset" + external shrink : region -> x:int -> y:int -> unit = "ml_gdk_region_shrink" + external empty : region -> bool = "ml_gdk_region_empty" + external equal : region -> region -> bool = "ml_gdk_region_equal" + external point_in : region -> x:int -> y:int -> bool + = "ml_gdk_region_point_in" + external rect_in : region -> Rectangle.t -> gdkOverlapType + = "ml_gdk_region_rect_in" + external get_clipbox : region -> Rectangle.t -> unit + = "ml_gdk_region_get_clipbox" +end + + +module GC = struct + type gdkFunction = [ `COPY|`INVERT|`XOR ] + type gdkFill = [ `SOLID|`TILED|`STIPPLED|`OPAQUE_STIPPLED ] + type gdkSubwindowMode = [ `CLIP_BY_CHILDREN|`INCLUDE_INFERIORS ] + type gdkLineStyle = [ `SOLID|`ON_OFF_DASH|`DOUBLE_DASH ] + type gdkCapStyle = [ `NOT_LAST|`BUTT|`ROUND|`PROJECTING ] + type gdkJoinStyle = [ `MITER|`ROUND|`BEVEL ] + external create : 'a drawable -> gc = "ml_gdk_gc_new" + external set_foreground : gc -> Color.t -> unit = "ml_gdk_gc_set_foreground" + external set_background : gc -> Color.t -> unit = "ml_gdk_gc_set_background" + external set_font : gc -> font -> unit = "ml_gdk_gc_set_font" + external set_function : gc -> gdkFunction -> unit = "ml_gdk_gc_set_function" + external set_fill : gc -> gdkFill -> unit = "ml_gdk_gc_set_fill" + external set_tile : gc -> pixmap -> unit = "ml_gdk_gc_set_tile" + external set_stipple : gc -> pixmap -> unit = "ml_gdk_gc_set_stipple" + external set_ts_origin : gc -> x:int -> y:int -> unit + = "ml_gdk_gc_set_ts_origin" + external set_clip_origin : gc -> x:int -> y:int -> unit + = "ml_gdk_gc_set_clip_origin" + external set_clip_mask : gc -> bitmap -> unit = "ml_gdk_gc_set_clip_mask" + external set_clip_rectangle : gc -> Rectangle.t -> unit + = "ml_gdk_gc_set_clip_rectangle" + external set_clip_region : gc -> region -> unit = "ml_gdk_gc_set_clip_region" + external set_subwindow : gc -> gdkSubwindowMode -> unit + = "ml_gdk_gc_set_subwindow" + external set_exposures : gc -> bool -> unit = "ml_gdk_gc_set_exposures" + external set_line_attributes : + gc -> width:int -> style:gdkLineStyle -> cap:gdkCapStyle -> + join:gdkJoinStyle -> unit + = "ml_gdk_gc_set_line_attributes" + external copy : dst:gc -> gc -> unit = "ml_gdk_gc_copy" + type values = { + foreground : Color.t; + background : Color.t; + font : font option; + fonction : gdkFunction; + fill : gdkFill; + tile : pixmap option; + stipple : pixmap option; + clip_mask : bitmap option; + subwindow_mode : gdkSubwindowMode; + ts_x_origin : int; + ts_y_origin : int; + clip_x_origin : int; + clip_y_origin : int; + graphics_exposures : bool; + line_width : int; + line_style : gdkLineStyle; + cap_style : gdkCapStyle; + join_style : gdkJoinStyle; + } + external get_values : gc -> values = "ml_gdk_gc_get_values" +end + +module Pixmap = struct + external create : window -> width:int -> height:int -> depth:int -> pixmap + = "ml_gdk_pixmap_new" + external create_from_data : + window -> string -> width:int -> height:int -> depth:int -> + fg:Color.t -> bg:Color.t -> pixmap + = "ml_gdk_pixmap_create_from_data_bc" "ml_gk_pixmap_create_from_data" + external create_from_xpm : + window -> ?colormap:colormap -> ?transparent:Color.t -> + file:string -> pixmap * bitmap + = "ml_gdk_pixmap_colormap_create_from_xpm" + external create_from_xpm_d : + window -> ?colormap:colormap -> ?transparent:Color.t -> + data:string array -> pixmap * bitmap + = "ml_gdk_pixmap_colormap_create_from_xpm_d" +end + +module Bitmap = struct + let create : window -> width:int -> height:int -> bitmap = + Obj.magic (Pixmap.create ~depth:1) + external create_from_data : + window -> string -> width:int -> height:int -> bitmap + = "ml_gdk_bitmap_create_from_data" +end + +module Font = struct + external load : string -> font = "ml_gdk_font_load" + external load_fontset : string -> font = "ml_gdk_fontset_load" + external string_width : font -> string -> int = "ml_gdk_string_width" + external char_width : font -> char -> int = "ml_gdk_char_width" + external string_height : font -> string -> int = "ml_gdk_string_height" + external char_height : font -> char -> int = "ml_gdk_char_height" + external string_measure : font -> string -> int = "ml_gdk_string_measure" + external char_measure : font -> char -> int = "ml_gdk_char_measure" + external get_type : font -> [`FONT | `FONTSET] = "ml_GdkFont_type" + external ascent : font -> int = "ml_GdkFont_ascent" + external descent : font -> int = "ml_GdkFont_descent" +end + +module Draw = struct + external point : 'a drawable -> gc -> x:int -> y:int -> unit + = "ml_gdk_draw_point" + external line : 'a drawable -> gc -> x:int -> y:int -> x:int -> y:int -> unit + = "ml_gdk_draw_line_bc" "ml_gdk_draw_line" + external rectangle : + 'a drawable -> gc -> + filled:bool -> x:int -> y:int -> width:int -> height:int -> unit + = "ml_gdk_draw_rectangle_bc" "ml_gdk_draw_rectangle" + let rectangle w gc ~x ~y ~width ~height ?(filled=false) () = + rectangle w gc ~x ~y ~width ~height ~filled + external arc : + 'a drawable -> gc -> filled:bool -> x:int -> y:int -> + width:int -> height:int -> start:int -> angle:int -> unit + = "ml_gdk_draw_arc_bc" "ml_gdk_draw_arc" + let arc w gc ~x ~y ~width ~height ?(filled=false) ?(start=0.) + ?(angle=360.) () = + arc w gc ~x ~y ~width ~height ~filled + ~start:(truncate(start *. 64.)) + ~angle:(truncate(angle *. 64.)) + external polygon : 'a drawable -> gc -> filled:bool -> PointArray.t -> unit + = "ml_gdk_draw_polygon" + let polygon w gc ?(filled=false) l = + let len = List.length l in + let arr = PointArray.create ~len in + List.fold_left l ~init:0 + ~f:(fun pos (x,y) -> PointArray.set arr ~pos ~x ~y; pos+1); + polygon w gc ~filled arr + external string : 'a drawable -> font: font -> gc -> x: int -> y: int -> + string: string -> unit + = "ml_gdk_draw_string_bc" "ml_gdk_draw_string" + external image : 'a drawable -> gc -> image: image -> + xsrc: int -> ysrc: int -> xdest: int -> ydest: int -> + width: int -> height: int -> unit + = "ml_gdk_draw_image_bc" "ml_gdk_draw_image" +end + +module Rgb = struct + external init : unit -> unit = "ml_gdk_rgb_init" + external get_visual : unit -> visual = "ml_gdk_rgb_get_visual" + external get_cmap : unit -> colormap = "ml_gdk_rgb_get_cmap" +end + +module DnD = struct + external drag_status : drag_context -> drag_action list -> time:int -> unit + = "ml_gdk_drag_status" + external drag_context_suggested_action : drag_context -> drag_action + = "ml_GdkDragContext_suggested_action" + external drag_context_targets : drag_context -> atom list + = "ml_GdkDragContext_targets" +end + +module Truecolor = struct + (* Truecolor quick color query *) + + type visual_shift_prec = { + red_shift : int; + red_prec : int; + green_shift : int; + green_prec : int; + blue_shift : int; + blue_prec : int + } + + let shift_prec visual = { + red_shift = Visual.red_shift visual; + red_prec = Visual.red_prec visual; + green_shift = Visual.green_shift visual; + green_prec = Visual.green_prec visual; + blue_shift = Visual.blue_shift visual; + blue_prec = Visual.blue_prec visual; + } + + let color_creator visual = + match Visual.get_type visual with + `TRUE_COLOR | `DIRECT_COLOR -> + let shift_prec = shift_prec visual in + Format.eprintf "red : %d %d, " + shift_prec.red_shift shift_prec.red_prec; + Format.eprintf "green : %d %d, " + shift_prec.green_shift shift_prec.green_prec; + Format.eprintf "blue : %d %d" + shift_prec.blue_shift shift_prec.blue_prec; + Format.pp_print_newline Format.err_formatter (); + let red_lsr = 16 - shift_prec.red_prec + and green_lsr = 16 - shift_prec.green_prec + and blue_lsr = 16 - shift_prec.blue_prec in + fun ~red: red ~green: green ~blue: blue -> + (((red lsr red_lsr) lsl shift_prec.red_shift) lor + ((green lsr green_lsr) lsl shift_prec.green_shift) lor + ((blue lsr blue_lsr) lsl shift_prec.blue_shift)) + | _ -> raise (Invalid_argument "Gdk.Truecolor.color_creator") + + let color_parser visual = + match Visual.get_type visual with + `TRUE_COLOR | `DIRECT_COLOR -> + let shift_prec = shift_prec visual in + let red_lsr = 16 - shift_prec.red_prec + and green_lsr = 16 - shift_prec.green_prec + and blue_lsr = 16 - shift_prec.blue_prec in + let mask = 1 lsl 16 - 1 in + fun pixel -> + ((pixel lsr shift_prec.red_shift) lsl red_lsr) land mask, + ((pixel lsr shift_prec.green_shift) lsl green_lsr) land mask, + ((pixel lsr shift_prec.blue_shift) lsl blue_lsr) land mask + | _ -> raise (Invalid_argument "Gdk.Truecolor.color_parser") +end + +module X = struct + (* X related functions *) + external flush : unit -> unit + = "ml_gdk_flush" + external beep : unit -> unit + = "ml_gdk_beep" +end + +module Cursor = struct + type cursor_type = [ + | `X_CURSOR + | `ARROW + | `BASED_ARROW_DOWN + | `BASED_ARROW_UP + | `BOAT + | `BOGOSITY + | `BOTTOM_LEFT_CORNER + | `BOTTOM_RIGHT_CORNER + | `BOTTOM_SIDE + | `BOTTOM_TEE + | `BOX_SPIRAL + | `CENTER_PTR + | `CIRCLE + | `CLOCK + | `COFFEE_MUG + | `CROSS + | `CROSS_REVERSE + | `CROSSHAIR + | `DIAMOND_CROSS + | `DOT + | `DOTBOX + | `DOUBLE_ARROW + | `DRAFT_LARGE + | `DRAFT_SMALL + | `DRAPED_BOX + | `EXCHANGE + | `FLEUR + | `GOBBLER + | `GUMBY + | `HAND1 + | `HAND2 + | `HEART + | `ICON + | `IRON_CROSS + | `LEFT_PTR + | `LEFT_SIDE + | `LEFT_TEE + | `LEFTBUTTON + | `LL_ANGLE + | `LR_ANGLE + | `MAN + | `MIDDLEBUTTON + | `MOUSE + | `PENCIL + | `PIRATE + | `PLUS + | `QUESTION_ARROW + | `RIGHT_PTR + | `RIGHT_SIDE + | `RIGHT_TEE + | `RIGHTBUTTON + | `RTL_LOGO + | `SAILBOAT + | `SB_DOWN_ARROW + | `SB_H_DOUBLE_ARROW + | `SB_LEFT_ARROW + | `SB_RIGHT_ARROW + | `SB_UP_ARROW + | `SB_V_DOUBLE_ARROW + | `SHUTTLE + | `SIZING + | `SPIDER + | `SPRAYCAN + | `STAR + | `TARGET + | `TCROSS + | `TOP_LEFT_ARROW + | `TOP_LEFT_CORNER + | `TOP_RIGHT_CORNER + | `TOP_SIDE + | `TOP_TEE + | `TREK + | `UL_ANGLE + | `UMBRELLA + | `UR_ANGLE + | `WATCH + | `XTERM + ] + external create : cursor_type -> cursor = "ml_gdk_cursor_new" + external create_from_pixmap : + pixmap -> mask:bitmap -> + fg:Color.t -> bg:Color.t -> x:int -> y:int -> cursor + = "ml_gdk_cursor_new_from_pixmap_bc" "ml_gdk_cursor_new_from_pixmap" + external destroy : cursor -> unit = "ml_gdk_cursor_destroy" +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdk.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdk.mli new file mode 100644 index 000000000..2914b60ce --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdk.mli @@ -0,0 +1,447 @@ +(* $Id$ *) + +type colormap +type visual +type region +type gc +type 'a drawable +type window = [`window] drawable +type pixmap = [`pixmap] drawable +type bitmap = [`bitmap] drawable +type font +type image +type atom = int +type keysym = int +type 'a event +type drag_context +type cursor +type xid = int32 + +exception Error of string + +module Tags : sig + type event_type = + [ `NOTHING|`DELETE|`DESTROY|`EXPOSE|`MOTION_NOTIFY|`BUTTON_PRESS + |`TWO_BUTTON_PRESS|`THREE_BUTTON_PRESS + |`BUTTON_RELEASE|`KEY_PRESS + |`KEY_RELEASE|`ENTER_NOTIFY|`LEAVE_NOTIFY|`FOCUS_CHANGE + |`CONFIGURE|`MAP|`UNMAP|`PROPERTY_NOTIFY|`SELECTION_CLEAR + |`SELECTION_REQUEST|`SELECTION_NOTIFY|`PROXIMITY_IN + |`PROXIMITY_OUT|`DRAG_ENTER|`DRAG_LEAVE|`DRAG_MOTION|`DRAG_STATUS + |`DROP_START|`DROP_FINISHED|`CLIENT_EVENT|`VISIBILITY_NOTIFY + |`NO_EXPOSE ] + type event_mask = + [ `EXPOSURE + |`POINTER_MOTION|`POINTER_MOTION_HINT + |`BUTTON_MOTION|`BUTTON1_MOTION|`BUTTON2_MOTION|`BUTTON3_MOTION + |`BUTTON_PRESS|`BUTTON_RELEASE + |`KEY_PRESS|`KEY_RELEASE + |`ENTER_NOTIFY|`LEAVE_NOTIFY|`FOCUS_CHANGE + |`STRUCTURE|`PROPERTY_CHANGE|`VISIBILITY_NOTIFY + |`PROXIMITY_IN|`PROXIMITY_OUT|`SUBSTRUCTURE + |`ALL_EVENTS ] + type extension_events = [ `NONE|`ALL|`CURSOR ] + type visibility_state = [ `UNOBSCURED|`PARTIAL|`FULLY_OBSCURED ] + type input_source = [ `MOUSE|`PEN|`ERASER|`CURSOR ] + type notify_type = + [ `ANCESTOR|`VIRTUAL|`INFERIOR|`NONLINEAR|`NONLINEAR_VIRTUAL|`UNKNOWN ] + type crossing_mode = [ `NORMAL|`GRAB|`UNGRAB ] + type modifier = + [ `SHIFT|`LOCK|`CONTROL|`MOD1|`MOD2|`MOD3|`MOD4|`MOD5|`BUTTON1 + |`BUTTON2|`BUTTON3|`BUTTON4|`BUTTON5 ] + type drag_action = [ `DEFAULT|`COPY|`MOVE|`LINK|`PRIVATE|`ASK ] +end + +module Convert : + sig + val modifier : int -> Tags.modifier list + end + +module Screen : + sig + external width : unit -> int = "ml_gdk_screen_width" + external height : unit -> int = "ml_gdk_screen_height" + end + +module Visual : + sig + type visual_type = + [ `STATIC_GRAY|`GRAYSCALE|`STATIC_COLOR + |`PSEUDO_COLOR|`TRUE_COLOR|`DIRECT_COLOR ] + external get_best : ?depth:int -> ?kind:visual_type -> unit -> visual + = "ml_gdk_visual_get_best" + external get_type : visual -> visual_type = "ml_GdkVisual_type" + external depth : visual -> int = "ml_GdkVisual_depth" + external red_mask : visual -> int = "ml_GdkVisual_red_mask" + external red_shift : visual -> int = "ml_GdkVisual_red_shift" + external red_prec : visual -> int = "ml_GdkVisual_red_prec" + external green_mask : visual -> int = "ml_GdkVisual_green_mask" + external green_shift : visual -> int = "ml_GdkVisual_green_shift" + external green_prec : visual -> int = "ml_GdkVisual_green_prec" + external blue_mask : visual -> int = "ml_GdkVisual_blue_mask" + external blue_shift : visual -> int = "ml_GdkVisual_blue_shift" + external blue_prec : visual -> int = "ml_GdkVisual_blue_prec" + end + +module Image : + sig + type image_type = [ `FASTEST|`NORMAL|`SHARED ] + external create_bitmap : + visual:visual -> data:string -> width:int -> height:int -> image + = "ml_gdk_image_new_bitmap" + external create : + kind:image_type -> + visual:visual -> width:int -> height:int -> image = "ml_gdk_image_new" + external get : + 'a drawable -> x:int -> y:int -> width:int -> height:int -> image + = "ml_gdk_image_get" + external put_pixel : image -> x:int -> y:int -> pixel:int -> unit + = "ml_gdk_image_put_pixel" + external get_pixel : image -> x:int -> y:int -> int + = "ml_gdk_image_get_pixel" + external destroy : image -> unit = "ml_gdk_image_destroy" + end + +module Color : + sig + external get_system_colormap : unit -> colormap + = "ml_gdk_colormap_get_system" + val get_colormap : ?privat:bool -> visual -> colormap + + type t + type spec = [ + | `BLACK + | `NAME of string + | `RGB of int * int * int + | `WHITE + ] + val alloc : colormap:colormap -> spec -> t + external red : t -> int = "ml_GdkColor_red" + external blue : t -> int = "ml_GdkColor_blue" + external green : t -> int = "ml_GdkColor_green" + external pixel : t -> int = "ml_GdkColor_pixel" + end + +module Rectangle : + sig + type t + external create : x:int -> y:int -> width:int -> height:int -> t + = "ml_GdkRectangle" + external x : t -> int = "ml_GdkRectangle_x" + external y : t -> int = "ml_GdkRectangle_y" + external width : t -> int = "ml_GdkRectangle_width" + external height : t -> int = "ml_GdkRectangle_height" + end + +module Window : + sig + type background_pixmap = [ `NONE|`PARENT_RELATIVE|`PIXMAP of pixmap ] + external visual_depth : visual -> int = "ml_gdk_visual_get_depth" + external get_visual : window -> visual = "ml_gdk_window_get_visual" + external get_parent : window -> window = "ml_gdk_window_get_parent" + external get_size : window -> int * int = "ml_gdk_window_get_size" + external get_position : window -> int * int + = "ml_gdk_window_get_position" + external root_parent : unit -> window = "ml_GDK_ROOT_PARENT" + external clear : window -> unit = "ml_gdk_window_clear" + external get_xwindow : window -> xid = "ml_GDK_WINDOW_XWINDOW" + val set_back_pixmap : window -> background_pixmap -> unit + end + +module PointArray : + sig + type t = { len: int } + external create : len:int -> t = "ml_point_array_new" + val set : t -> pos:int -> x:int -> y:int -> unit + end + +module Region : + sig + type gdkFillRule = [ `EVEN_ODD_RULE|`WINDING_RULE ] + type gdkOverlapType = [ `IN|`OUT|`PART ] + external create : unit -> region = "ml_gdk_region_new" + external destroy : region -> unit = "ml_gdk_region_destroy" + val polygon : (int * int) list -> gdkFillRule -> region + external intersect : region -> region -> region + = "ml_gdk_regions_intersect" + external union : region -> region -> region + = "ml_gdk_regions_union" + external subtract : region -> region -> region + = "ml_gdk_regions_subtract" + external xor : region -> region -> region + = "ml_gdk_regions_xor" + external union_with_rect : region -> Rectangle.t -> region + = "ml_gdk_region_union_with_rect" + external offset : region -> x:int -> y:int -> unit = "ml_gdk_region_offset" + external shrink : region -> x:int -> y:int -> unit = "ml_gdk_region_shrink" + external empty : region -> bool = "ml_gdk_region_empty" + external equal : region -> region -> bool = "ml_gdk_region_equal" + external point_in : region -> x:int -> y:int -> bool + = "ml_gdk_region_point_in" + external rect_in : region -> Rectangle.t -> gdkOverlapType + = "ml_gdk_region_rect_in" + external get_clipbox : region -> Rectangle.t -> unit + = "ml_gdk_region_get_clipbox" + end + +module GC : + sig + type gdkFunction = [ `COPY|`INVERT|`XOR ] + type gdkFill = [ `SOLID|`TILED|`STIPPLED|`OPAQUE_STIPPLED ] + type gdkSubwindowMode = [ `CLIP_BY_CHILDREN|`INCLUDE_INFERIORS ] + type gdkLineStyle = [ `SOLID|`ON_OFF_DASH|`DOUBLE_DASH ] + type gdkCapStyle = [ `NOT_LAST|`BUTT|`ROUND|`PROJECTING ] + type gdkJoinStyle = [ `MITER|`ROUND|`BEVEL ] + external create : 'a drawable -> gc = "ml_gdk_gc_new" + external set_foreground : gc -> Color.t -> unit + = "ml_gdk_gc_set_foreground" + external set_background : gc -> Color.t -> unit + = "ml_gdk_gc_set_background" + external set_font : gc -> font -> unit = "ml_gdk_gc_set_font" + external set_function : gc -> gdkFunction -> unit + = "ml_gdk_gc_set_function" + external set_fill : gc -> gdkFill -> unit = "ml_gdk_gc_set_fill" + external set_tile : gc -> pixmap -> unit = "ml_gdk_gc_set_tile" + external set_stipple : gc -> pixmap -> unit = "ml_gdk_gc_set_stipple" + external set_ts_origin : gc -> x:int -> y:int -> unit + = "ml_gdk_gc_set_ts_origin" + external set_clip_origin : gc -> x:int -> y:int -> unit + = "ml_gdk_gc_set_clip_origin" + external set_clip_mask : gc -> bitmap -> unit = "ml_gdk_gc_set_clip_mask" + external set_clip_rectangle : gc -> Rectangle.t -> unit + = "ml_gdk_gc_set_clip_rectangle" + external set_clip_region : gc -> region -> unit + = "ml_gdk_gc_set_clip_region" + external set_subwindow : gc -> gdkSubwindowMode -> unit + = "ml_gdk_gc_set_subwindow" + external set_exposures : gc -> bool -> unit = "ml_gdk_gc_set_exposures" + external set_line_attributes : + gc -> + width:int -> + style:gdkLineStyle -> cap:gdkCapStyle -> join:gdkJoinStyle -> unit + = "ml_gdk_gc_set_line_attributes" + external copy : dst:gc -> gc -> unit = "ml_gdk_gc_copy" + type values = { + foreground : Color.t; + background : Color.t; + font : font option; + fonction : gdkFunction; + fill : gdkFill; + tile : pixmap option; + stipple : pixmap option; + clip_mask : bitmap option; + subwindow_mode : gdkSubwindowMode; + ts_x_origin : int; + ts_y_origin : int; + clip_x_origin : int; + clip_y_origin : int; + graphics_exposures : bool; + line_width : int; + line_style : gdkLineStyle; + cap_style : gdkCapStyle; + join_style : gdkJoinStyle; + } + external get_values : gc -> values = "ml_gdk_gc_get_values" + end + +module Pixmap : + sig + external create : + window -> width:int -> height:int -> depth:int -> pixmap + = "ml_gdk_pixmap_new" + external create_from_data : + window -> + string -> + width:int -> + height:int -> depth:int -> fg:Color.t -> bg:Color.t -> pixmap + = "ml_gdk_pixmap_create_from_data_bc" "ml_gk_pixmap_create_from_data" + external create_from_xpm : + window -> + ?colormap:colormap -> + ?transparent:Color.t -> file:string -> pixmap * bitmap + = "ml_gdk_pixmap_colormap_create_from_xpm" + external create_from_xpm_d : + window -> + ?colormap:colormap -> + ?transparent:Color.t -> data:string array -> pixmap * bitmap + = "ml_gdk_pixmap_colormap_create_from_xpm_d" + end + +module Bitmap : + sig + val create : window -> width:int -> height:int -> bitmap + external create_from_data : + window -> string -> width:int -> height:int -> bitmap + = "ml_gdk_bitmap_create_from_data" + end + +module Font : + sig + external load : string -> font = "ml_gdk_font_load" + external load_fontset : string -> font = "ml_gdk_fontset_load" + external string_width : font -> string -> int = "ml_gdk_string_width" + external char_width : font -> char -> int = "ml_gdk_char_width" + external string_height : font -> string -> int = "ml_gdk_string_height" + external char_height : font -> char -> int = "ml_gdk_char_height" + external string_measure : font -> string -> int = "ml_gdk_string_measure" + external char_measure : font -> char -> int = "ml_gdk_char_measure" + external get_type : font -> [`FONT | `FONTSET] = "ml_GdkFont_type" + external ascent : font -> int = "ml_GdkFont_ascent" + external descent : font -> int = "ml_GdkFont_descent" + end + +module Draw : + sig + external point : 'a drawable -> gc -> x:int -> y:int -> unit + = "ml_gdk_draw_point" + external line : + 'a drawable -> gc -> x:int -> y:int -> x:int -> y:int -> unit + = "ml_gdk_draw_line_bc" "ml_gdk_draw_line" + val rectangle : + 'a drawable -> gc -> + x:int -> y:int -> width:int -> height:int -> ?filled:bool -> unit -> unit + val arc : + 'a drawable -> gc -> + x:int -> y:int -> width:int -> height:int -> + ?filled:bool -> ?start:float -> ?angle:float -> unit -> unit + val polygon : + 'a drawable -> gc -> ?filled:bool ->(int * int) list -> unit + external string : + 'a drawable -> + font:font -> gc -> x:int -> y:int -> string:string -> unit + = "ml_gdk_draw_string_bc" "ml_gdk_draw_string" + external image : + 'a drawable -> + gc -> + image:image -> + xsrc:int -> + ysrc:int -> xdest:int -> ydest:int -> width:int -> height:int -> unit + = "ml_gdk_draw_image_bc" "ml_gdk_draw_image" + end + +module Rgb : + sig + external init : unit -> unit = "ml_gdk_rgb_init" + external get_visual : unit -> visual = "ml_gdk_rgb_get_visual" + external get_cmap : unit -> colormap = "ml_gdk_rgb_get_cmap" + end + +module DnD : + sig + external drag_status : + drag_context -> Tags.drag_action list -> time:int -> unit + = "ml_gdk_drag_status" + external drag_context_suggested_action : drag_context -> Tags.drag_action + = "ml_GdkDragContext_suggested_action" + external drag_context_targets : drag_context -> atom list + = "ml_GdkDragContext_targets" + end + +module Truecolor : + sig + val color_creator : visual -> (red: int -> green: int -> blue: int -> int) + (* [color_creator visual] creates a function to calculate + the pixel color id for given red, green and blue component + value ([0..65535]) at the client side. [visual] must have + `TRUE_COLOR or `DIRECT_COLOR type. This function improves + the speed of the color query of true color visual greatly. *) + (* WARN: this approach is not theoretically correct for true color + visual, because we need gamma correction. *) + + val color_parser : visual -> int -> int * int * int + end + +module X : + (* X related functions *) + sig + val flush : unit -> unit (* also in GtkMain *) + val beep : unit -> unit + end + +module Cursor : sig + type cursor_type = [ + | `X_CURSOR + | `ARROW + | `BASED_ARROW_DOWN + | `BASED_ARROW_UP + | `BOAT + | `BOGOSITY + | `BOTTOM_LEFT_CORNER + | `BOTTOM_RIGHT_CORNER + | `BOTTOM_SIDE + | `BOTTOM_TEE + | `BOX_SPIRAL + | `CENTER_PTR + | `CIRCLE + | `CLOCK + | `COFFEE_MUG + | `CROSS + | `CROSS_REVERSE + | `CROSSHAIR + | `DIAMOND_CROSS + | `DOT + | `DOTBOX + | `DOUBLE_ARROW + | `DRAFT_LARGE + | `DRAFT_SMALL + | `DRAPED_BOX + | `EXCHANGE + | `FLEUR + | `GOBBLER + | `GUMBY + | `HAND1 + | `HAND2 + | `HEART + | `ICON + | `IRON_CROSS + | `LEFT_PTR + | `LEFT_SIDE + | `LEFT_TEE + | `LEFTBUTTON + | `LL_ANGLE + | `LR_ANGLE + | `MAN + | `MIDDLEBUTTON + | `MOUSE + | `PENCIL + | `PIRATE + | `PLUS + | `QUESTION_ARROW + | `RIGHT_PTR + | `RIGHT_SIDE + | `RIGHT_TEE + | `RIGHTBUTTON + | `RTL_LOGO + | `SAILBOAT + | `SB_DOWN_ARROW + | `SB_H_DOUBLE_ARROW + | `SB_LEFT_ARROW + | `SB_RIGHT_ARROW + | `SB_UP_ARROW + | `SB_V_DOUBLE_ARROW + | `SHUTTLE + | `SIZING + | `SPIDER + | `SPRAYCAN + | `STAR + | `TARGET + | `TCROSS + | `TOP_LEFT_ARROW + | `TOP_LEFT_CORNER + | `TOP_RIGHT_CORNER + | `TOP_SIDE + | `TOP_TEE + | `TREK + | `UL_ANGLE + | `UMBRELLA + | `UR_ANGLE + | `WATCH + | `XTERM + ] + external create : cursor_type -> cursor = "ml_gdk_cursor_new" + external create_from_pixmap : + pixmap -> mask:bitmap -> + fg:Color.t -> bg:Color.t -> x:int -> y:int -> cursor + = "ml_gdk_cursor_new_from_pixmap_bc" "ml_gdk_cursor_new_from_pixmap" + external destroy : cursor -> unit = "ml_gdk_cursor_destroy" +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdkEvent.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdkEvent.ml new file mode 100644 index 000000000..87c0e888f --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdkEvent.ml @@ -0,0 +1,159 @@ +(* $Id$ *) + +open Gaux +open Gdk +open Tags + +external coerce : 'a event -> event_type event = "%identity" +external unsafe_copy : Gpointer.boxed -> #event_type event + = "ml_gdk_event_copy" +external copy : (#event_type as 'a) event -> 'a event + = "ml_gdk_event_copy" +external get_type : 'a event -> 'a = "ml_GdkEventAny_type" +external get_window : 'a event -> window = "ml_GdkEventAny_window" +external get_send_event : 'a event -> bool = "ml_GdkEventAny_send_event" + +external create : (#event_type as 'a) -> 'a event + = "ml_gdk_event_new" +external set_window : 'a event -> window -> unit + = "ml_gdk_event_set_window" + +module Expose = struct + type t = [ `EXPOSE ] event + let cast (ev : event_type event) : t = + match get_type ev with `EXPOSE -> Obj.magic ev + | _ -> invalid_arg "GdkEvent.Expose.cast" + external area : t -> Rectangle.t = "ml_GdkEventExpose_area" + external count : t -> int = "ml_GdkEventExpose_count" +end + +module Visibility = struct + type t = [ `VISIBILITY_NOTIFY ] event + let cast (ev : event_type event) : t = + match get_type ev with `VISIBILITY_NOTIFY -> Obj.magic ev + | _ -> invalid_arg "GdkEvent.Visibility.cast" + external visibility : t -> visibility_state + = "ml_GdkEventVisibility_state" +end + +module Motion = struct + type t = [ `MOTION_NOTIFY ] event + let cast (ev : event_type event) : t = + match get_type ev with `MOTION_NOTIFY -> Obj.magic ev + | _ -> invalid_arg "GdkEvent.Motion.cast" + external time : t -> int = "ml_GdkEventMotion_time" + external x : t -> float = "ml_GdkEventMotion_x" + external y : t -> float = "ml_GdkEventMotion_y" + external pressure : t -> float = "ml_GdkEventMotion_pressure" + external xtilt : t -> float = "ml_GdkEventMotion_xtilt" + external ytilt : t -> float = "ml_GdkEventMotion_ytilt" + external state : t -> int = "ml_GdkEventMotion_state" + external is_hint : t -> bool = "ml_GdkEventMotion_is_hint" + external source : t -> input_source = "ml_GdkEventMotion_source" + external deviceid : t -> int = "ml_GdkEventMotion_deviceid" + external x_root : t -> float = "ml_GdkEventMotion_x_root" + external y_root : t -> float = "ml_GdkEventMotion_y_root" +end + +module Button = struct + type types = + [ `BUTTON_PRESS|`TWO_BUTTON_PRESS|`THREE_BUTTON_PRESS|`BUTTON_RELEASE ] + type t = types event + let cast (ev : event_type event) : t = + match get_type ev with + `BUTTON_PRESS|`TWO_BUTTON_PRESS|`THREE_BUTTON_PRESS|`BUTTON_RELEASE + -> Obj.magic ev + | _ -> invalid_arg "GdkEvent.Button.cast" + external time : t -> int = "ml_GdkEventButton_time" + external x : t -> float = "ml_GdkEventButton_x" + external y : t -> float = "ml_GdkEventButton_y" + external pressure : t -> float = "ml_GdkEventButton_pressure" + external xtilt : t -> float = "ml_GdkEventButton_xtilt" + external ytilt : t -> float = "ml_GdkEventButton_ytilt" + external state : t -> int = "ml_GdkEventButton_state" + external button : t -> int = "ml_GdkEventButton_button" + external source : t -> input_source = "ml_GdkEventButton_source" + external deviceid : t -> int = "ml_GdkEventButton_deviceid" + external x_root : t -> float = "ml_GdkEventButton_x_root" + external y_root : t -> float = "ml_GdkEventButton_y_root" + external set_type : t -> #types -> unit + = "ml_gdk_event_set_type" + external set_button : t -> int -> unit + = "ml_gdk_event_button_set_button" +end + +module Key = struct + type t = [ `KEY_PRESS|`KEY_RELEASE ] event + let cast (ev : event_type event) : t = + match get_type ev with + `KEY_PRESS|`KEY_RELEASE -> Obj.magic ev + | _ -> invalid_arg "GdkEvent.Key.cast" + external time : t -> int = "ml_GdkEventKey_time" + external state : t -> int = "ml_GdkEventKey_state" + external keyval : t -> keysym = "ml_GdkEventKey_keyval" + external string : t -> string = "ml_GdkEventKey_string" + let state ev = Convert.modifier (state ev) +end + +module Crossing = struct + type t = [ `ENTER_NOTIFY|`LEAVE_NOTIFY ] event + let cast (ev : event_type event) : t = + match get_type ev with + `ENTER_NOTIFY|`LEAVE_NOTIFY -> Obj.magic ev + | _ -> invalid_arg "GdkEvent.Crossing.cast" + external subwindow : t -> window = "ml_GdkEventCrossing_subwindow" + external detail : t -> notify_type = "ml_GdkEventCrossing_detail" +end + +module Focus = struct + type t = [ `FOCUS_CHANGE ] event + let cast (ev : event_type event) : t = + match get_type ev with `FOCUS_CHANGE -> Obj.magic ev + | _ -> invalid_arg "GdkEvent.Focus.cast" + external focus_in : t -> bool = "ml_GdkEventFocus_in" +end + +module Configure = struct + type t = [ `CONFIGURE ] event + let cast (ev : event_type event) : t = + match get_type ev with `CONFIGURE -> Obj.magic ev + | _ -> invalid_arg "GdkEvent.Configure.cast" + external x : t -> int = "ml_GdkEventConfigure_x" + external y : t -> int = "ml_GdkEventConfigure_y" + external width : t -> int = "ml_GdkEventConfigure_width" + external height : t -> int = "ml_GdkEventConfigure_height" +end + +module Property = struct + type t = [ `PROPERTY_NOTIFY ] event + let cast (ev : event_type event) : t = + match get_type ev with `PROPERTY_NOTIFY -> Obj.magic ev + | _ -> invalid_arg "GdkEvent.Property.cast" + external atom : t -> atom = "ml_GdkEventProperty_atom" + external time : t -> int = "ml_GdkEventProperty_time" + external state : t -> int = "ml_GdkEventProperty_state" +end + +module Selection = struct + type t = [ `SELECTION_CLEAR|`SELECTION_REQUEST|`SELECTION_NOTIFY ] event + let cast (ev : event_type event) : t = + match get_type ev with + `SELECTION_CLEAR|`SELECTION_REQUEST|`SELECTION_NOTIFY -> Obj.magic ev + | _ -> invalid_arg "GdkEvent.Selection.cast" + external selection : t -> atom = "ml_GdkEventSelection_selection" + external target : t -> atom = "ml_GdkEventSelection_target" + external property : t -> atom = "ml_GdkEventSelection_property" + external requestor : t -> int = "ml_GdkEventSelection_requestor" + external time : t -> int = "ml_GdkEventSelection_time" +end + +module Proximity = struct + type t = [ `PROXIMITY_IN|`PROXIMITY_OUT ] event + let cast (ev : event_type event) : t = + match get_type ev with + `PROXIMITY_IN|`PROXIMITY_OUT -> Obj.magic ev + | _ -> invalid_arg "GdkEvent.Proximity.cast" + external time : t -> int = "ml_GdkEventProximity_time" + external source : t -> input_source = "ml_GdkEventProximity_source" + external deviceid : t -> int = "ml_GdkEventProximity_deviceid" +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdkKeysyms.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdkKeysyms.ml new file mode 100644 index 000000000..b0257b439 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdkKeysyms.ml @@ -0,0 +1,1320 @@ +(* $Id$ *) + +open Gdk +let _VoidSymbol : keysym = 0xFFFFFF +let _BackSpace : keysym = 0xFF08 +let _Tab : keysym = 0xFF09 +let _Linefeed : keysym = 0xFF0A +let _Clear : keysym = 0xFF0B +let _Return : keysym = 0xFF0D +let _Pause : keysym = 0xFF13 +let _Scroll_Lock : keysym = 0xFF14 +let _Sys_Req : keysym = 0xFF15 +let _Escape : keysym = 0xFF1B +let _Delete : keysym = 0xFFFF +let _Multi_key : keysym = 0xFF20 +let _SingleCandidate : keysym = 0xFF3C +let _MultipleCandidate : keysym = 0xFF3D +let _PreviousCandidate : keysym = 0xFF3E +let _Kanji : keysym = 0xFF21 +let _Muhenkan : keysym = 0xFF22 +let _Henkan_Mode : keysym = 0xFF23 +let _Henkan : keysym = 0xFF23 +let _Romaji : keysym = 0xFF24 +let _Hiragana : keysym = 0xFF25 +let _Katakana : keysym = 0xFF26 +let _Hiragana_Katakana : keysym = 0xFF27 +let _Zenkaku : keysym = 0xFF28 +let _Hankaku : keysym = 0xFF29 +let _Zenkaku_Hankaku : keysym = 0xFF2A +let _Touroku : keysym = 0xFF2B +let _Massyo : keysym = 0xFF2C +let _Kana_Lock : keysym = 0xFF2D +let _Kana_Shift : keysym = 0xFF2E +let _Eisu_Shift : keysym = 0xFF2F +let _Eisu_toggle : keysym = 0xFF30 +let _Zen_Koho : keysym = 0xFF3D +let _Mae_Koho : keysym = 0xFF3E +let _Home : keysym = 0xFF50 +let _Left : keysym = 0xFF51 +let _Up : keysym = 0xFF52 +let _Right : keysym = 0xFF53 +let _Down : keysym = 0xFF54 +let _Prior : keysym = 0xFF55 +let _Page_Up : keysym = 0xFF55 +let _Next : keysym = 0xFF56 +let _Page_Down : keysym = 0xFF56 +let _End : keysym = 0xFF57 +let _Begin : keysym = 0xFF58 +let _Select : keysym = 0xFF60 +let _Print : keysym = 0xFF61 +let _Execute : keysym = 0xFF62 +let _Insert : keysym = 0xFF63 +let _Undo : keysym = 0xFF65 +let _Redo : keysym = 0xFF66 +let _Menu : keysym = 0xFF67 +let _Find : keysym = 0xFF68 +let _Cancel : keysym = 0xFF69 +let _Help : keysym = 0xFF6A +let _Break : keysym = 0xFF6B +let _Mode_switch : keysym = 0xFF7E +let _script_switch : keysym = 0xFF7E +let _Num_Lock : keysym = 0xFF7F +let _KP_Space : keysym = 0xFF80 +let _KP_Tab : keysym = 0xFF89 +let _KP_Enter : keysym = 0xFF8D +let _KP_F1 : keysym = 0xFF91 +let _KP_F2 : keysym = 0xFF92 +let _KP_F3 : keysym = 0xFF93 +let _KP_F4 : keysym = 0xFF94 +let _KP_Home : keysym = 0xFF95 +let _KP_Left : keysym = 0xFF96 +let _KP_Up : keysym = 0xFF97 +let _KP_Right : keysym = 0xFF98 +let _KP_Down : keysym = 0xFF99 +let _KP_Prior : keysym = 0xFF9A +let _KP_Page_Up : keysym = 0xFF9A +let _KP_Next : keysym = 0xFF9B +let _KP_Page_Down : keysym = 0xFF9B +let _KP_End : keysym = 0xFF9C +let _KP_Begin : keysym = 0xFF9D +let _KP_Insert : keysym = 0xFF9E +let _KP_Delete : keysym = 0xFF9F +let _KP_Equal : keysym = 0xFFBD +let _KP_Multiply : keysym = 0xFFAA +let _KP_Add : keysym = 0xFFAB +let _KP_Separator : keysym = 0xFFAC +let _KP_Subtract : keysym = 0xFFAD +let _KP_Decimal : keysym = 0xFFAE +let _KP_Divide : keysym = 0xFFAF +let _KP_0 : keysym = 0xFFB0 +let _KP_1 : keysym = 0xFFB1 +let _KP_2 : keysym = 0xFFB2 +let _KP_3 : keysym = 0xFFB3 +let _KP_4 : keysym = 0xFFB4 +let _KP_5 : keysym = 0xFFB5 +let _KP_6 : keysym = 0xFFB6 +let _KP_7 : keysym = 0xFFB7 +let _KP_8 : keysym = 0xFFB8 +let _KP_9 : keysym = 0xFFB9 +let _F1 : keysym = 0xFFBE +let _F2 : keysym = 0xFFBF +let _F3 : keysym = 0xFFC0 +let _F4 : keysym = 0xFFC1 +let _F5 : keysym = 0xFFC2 +let _F6 : keysym = 0xFFC3 +let _F7 : keysym = 0xFFC4 +let _F8 : keysym = 0xFFC5 +let _F9 : keysym = 0xFFC6 +let _F10 : keysym = 0xFFC7 +let _F11 : keysym = 0xFFC8 +let _L1 : keysym = 0xFFC8 +let _F12 : keysym = 0xFFC9 +let _L2 : keysym = 0xFFC9 +let _F13 : keysym = 0xFFCA +let _L3 : keysym = 0xFFCA +let _F14 : keysym = 0xFFCB +let _L4 : keysym = 0xFFCB +let _F15 : keysym = 0xFFCC +let _L5 : keysym = 0xFFCC +let _F16 : keysym = 0xFFCD +let _L6 : keysym = 0xFFCD +let _F17 : keysym = 0xFFCE +let _L7 : keysym = 0xFFCE +let _F18 : keysym = 0xFFCF +let _L8 : keysym = 0xFFCF +let _F19 : keysym = 0xFFD0 +let _L9 : keysym = 0xFFD0 +let _F20 : keysym = 0xFFD1 +let _L10 : keysym = 0xFFD1 +let _F21 : keysym = 0xFFD2 +let _R1 : keysym = 0xFFD2 +let _F22 : keysym = 0xFFD3 +let _R2 : keysym = 0xFFD3 +let _F23 : keysym = 0xFFD4 +let _R3 : keysym = 0xFFD4 +let _F24 : keysym = 0xFFD5 +let _R4 : keysym = 0xFFD5 +let _F25 : keysym = 0xFFD6 +let _R5 : keysym = 0xFFD6 +let _F26 : keysym = 0xFFD7 +let _R6 : keysym = 0xFFD7 +let _F27 : keysym = 0xFFD8 +let _R7 : keysym = 0xFFD8 +let _F28 : keysym = 0xFFD9 +let _R8 : keysym = 0xFFD9 +let _F29 : keysym = 0xFFDA +let _R9 : keysym = 0xFFDA +let _F30 : keysym = 0xFFDB +let _R10 : keysym = 0xFFDB +let _F31 : keysym = 0xFFDC +let _R11 : keysym = 0xFFDC +let _F32 : keysym = 0xFFDD +let _R12 : keysym = 0xFFDD +let _F33 : keysym = 0xFFDE +let _R13 : keysym = 0xFFDE +let _F34 : keysym = 0xFFDF +let _R14 : keysym = 0xFFDF +let _F35 : keysym = 0xFFE0 +let _R15 : keysym = 0xFFE0 +let _Shift_L : keysym = 0xFFE1 +let _Shift_R : keysym = 0xFFE2 +let _Control_L : keysym = 0xFFE3 +let _Control_R : keysym = 0xFFE4 +let _Caps_Lock : keysym = 0xFFE5 +let _Shift_Lock : keysym = 0xFFE6 +let _Meta_L : keysym = 0xFFE7 +let _Meta_R : keysym = 0xFFE8 +let _Alt_L : keysym = 0xFFE9 +let _Alt_R : keysym = 0xFFEA +let _Super_L : keysym = 0xFFEB +let _Super_R : keysym = 0xFFEC +let _Hyper_L : keysym = 0xFFED +let _Hyper_R : keysym = 0xFFEE +let _ISO_Lock : keysym = 0xFE01 +let _ISO_Level2_Latch : keysym = 0xFE02 +let _ISO_Level3_Shift : keysym = 0xFE03 +let _ISO_Level3_Latch : keysym = 0xFE04 +let _ISO_Level3_Lock : keysym = 0xFE05 +let _ISO_Group_Shift : keysym = 0xFF7E +let _ISO_Group_Latch : keysym = 0xFE06 +let _ISO_Group_Lock : keysym = 0xFE07 +let _ISO_Next_Group : keysym = 0xFE08 +let _ISO_Next_Group_Lock : keysym = 0xFE09 +let _ISO_Prev_Group : keysym = 0xFE0A +let _ISO_Prev_Group_Lock : keysym = 0xFE0B +let _ISO_First_Group : keysym = 0xFE0C +let _ISO_First_Group_Lock : keysym = 0xFE0D +let _ISO_Last_Group : keysym = 0xFE0E +let _ISO_Last_Group_Lock : keysym = 0xFE0F +let _ISO_Left_Tab : keysym = 0xFE20 +let _ISO_Move_Line_Up : keysym = 0xFE21 +let _ISO_Move_Line_Down : keysym = 0xFE22 +let _ISO_Partial_Line_Up : keysym = 0xFE23 +let _ISO_Partial_Line_Down : keysym = 0xFE24 +let _ISO_Partial_Space_Left : keysym = 0xFE25 +let _ISO_Partial_Space_Right : keysym = 0xFE26 +let _ISO_Set_Margin_Left : keysym = 0xFE27 +let _ISO_Set_Margin_Right : keysym = 0xFE28 +let _ISO_Release_Margin_Left : keysym = 0xFE29 +let _ISO_Release_Margin_Right : keysym = 0xFE2A +let _ISO_Release_Both_Margins : keysym = 0xFE2B +let _ISO_Fast_Cursor_Left : keysym = 0xFE2C +let _ISO_Fast_Cursor_Right : keysym = 0xFE2D +let _ISO_Fast_Cursor_Up : keysym = 0xFE2E +let _ISO_Fast_Cursor_Down : keysym = 0xFE2F +let _ISO_Continuous_Underline : keysym = 0xFE30 +let _ISO_Discontinuous_Underline : keysym = 0xFE31 +let _ISO_Emphasize : keysym = 0xFE32 +let _ISO_Center_Object : keysym = 0xFE33 +let _ISO_Enter : keysym = 0xFE34 +let _dead_grave : keysym = 0xFE50 +let _dead_acute : keysym = 0xFE51 +let _dead_circumflex : keysym = 0xFE52 +let _dead_tilde : keysym = 0xFE53 +let _dead_macron : keysym = 0xFE54 +let _dead_breve : keysym = 0xFE55 +let _dead_abovedot : keysym = 0xFE56 +let _dead_diaeresis : keysym = 0xFE57 +let _dead_abovering : keysym = 0xFE58 +let _dead_doubleacute : keysym = 0xFE59 +let _dead_caron : keysym = 0xFE5A +let _dead_cedilla : keysym = 0xFE5B +let _dead_ogonek : keysym = 0xFE5C +let _dead_iota : keysym = 0xFE5D +let _dead_voiced_sound : keysym = 0xFE5E +let _dead_semivoiced_sound : keysym = 0xFE5F +let _dead_belowdot : keysym = 0xFE60 +let _First_Virtual_Screen : keysym = 0xFED0 +let _Prev_Virtual_Screen : keysym = 0xFED1 +let _Next_Virtual_Screen : keysym = 0xFED2 +let _Last_Virtual_Screen : keysym = 0xFED4 +let _Terminate_Server : keysym = 0xFED5 +let _AccessX_Enable : keysym = 0xFE70 +let _AccessX_Feedback_Enable : keysym = 0xFE71 +let _RepeatKeys_Enable : keysym = 0xFE72 +let _SlowKeys_Enable : keysym = 0xFE73 +let _BounceKeys_Enable : keysym = 0xFE74 +let _StickyKeys_Enable : keysym = 0xFE75 +let _MouseKeys_Enable : keysym = 0xFE76 +let _MouseKeys_Accel_Enable : keysym = 0xFE77 +let _Overlay1_Enable : keysym = 0xFE78 +let _Overlay2_Enable : keysym = 0xFE79 +let _AudibleBell_Enable : keysym = 0xFE7A +let _Pointer_Left : keysym = 0xFEE0 +let _Pointer_Right : keysym = 0xFEE1 +let _Pointer_Up : keysym = 0xFEE2 +let _Pointer_Down : keysym = 0xFEE3 +let _Pointer_UpLeft : keysym = 0xFEE4 +let _Pointer_UpRight : keysym = 0xFEE5 +let _Pointer_DownLeft : keysym = 0xFEE6 +let _Pointer_DownRight : keysym = 0xFEE7 +let _Pointer_Button_Dflt : keysym = 0xFEE8 +let _Pointer_Button1 : keysym = 0xFEE9 +let _Pointer_Button2 : keysym = 0xFEEA +let _Pointer_Button3 : keysym = 0xFEEB +let _Pointer_Button4 : keysym = 0xFEEC +let _Pointer_Button5 : keysym = 0xFEED +let _Pointer_DblClick_Dflt : keysym = 0xFEEE +let _Pointer_DblClick1 : keysym = 0xFEEF +let _Pointer_DblClick2 : keysym = 0xFEF0 +let _Pointer_DblClick3 : keysym = 0xFEF1 +let _Pointer_DblClick4 : keysym = 0xFEF2 +let _Pointer_DblClick5 : keysym = 0xFEF3 +let _Pointer_Drag_Dflt : keysym = 0xFEF4 +let _Pointer_Drag1 : keysym = 0xFEF5 +let _Pointer_Drag2 : keysym = 0xFEF6 +let _Pointer_Drag3 : keysym = 0xFEF7 +let _Pointer_Drag4 : keysym = 0xFEF8 +let _Pointer_Drag5 : keysym = 0xFEFD +let _Pointer_EnableKeys : keysym = 0xFEF9 +let _Pointer_Accelerate : keysym = 0xFEFA +let _Pointer_DfltBtnNext : keysym = 0xFEFB +let _Pointer_DfltBtnPrev : keysym = 0xFEFC +let _3270_Duplicate : keysym = 0xFD01 +let _3270_FieldMark : keysym = 0xFD02 +let _3270_Right2 : keysym = 0xFD03 +let _3270_Left2 : keysym = 0xFD04 +let _3270_BackTab : keysym = 0xFD05 +let _3270_EraseEOF : keysym = 0xFD06 +let _3270_EraseInput : keysym = 0xFD07 +let _3270_Reset : keysym = 0xFD08 +let _3270_Quit : keysym = 0xFD09 +let _3270_PA1 : keysym = 0xFD0A +let _3270_PA2 : keysym = 0xFD0B +let _3270_PA3 : keysym = 0xFD0C +let _3270_Test : keysym = 0xFD0D +let _3270_Attn : keysym = 0xFD0E +let _3270_CursorBlink : keysym = 0xFD0F +let _3270_AltCursor : keysym = 0xFD10 +let _3270_KeyClick : keysym = 0xFD11 +let _3270_Jump : keysym = 0xFD12 +let _3270_Ident : keysym = 0xFD13 +let _3270_Rule : keysym = 0xFD14 +let _3270_Copy : keysym = 0xFD15 +let _3270_Play : keysym = 0xFD16 +let _3270_Setup : keysym = 0xFD17 +let _3270_Record : keysym = 0xFD18 +let _3270_ChangeScreen : keysym = 0xFD19 +let _3270_DeleteWord : keysym = 0xFD1A +let _3270_ExSelect : keysym = 0xFD1B +let _3270_CursorSelect : keysym = 0xFD1C +let _3270_PrintScreen : keysym = 0xFD1D +let _3270_Enter : keysym = 0xFD1E +let _space : keysym = 0x020 +let _exclam : keysym = 0x021 +let _quotedbl : keysym = 0x022 +let _numbersign : keysym = 0x023 +let _dollar : keysym = 0x024 +let _percent : keysym = 0x025 +let _ampersand : keysym = 0x026 +let _apostrophe : keysym = 0x027 +let _quoteright : keysym = 0x027 +let _parenleft : keysym = 0x028 +let _parenright : keysym = 0x029 +let _asterisk : keysym = 0x02a +let _plus : keysym = 0x02b +let _comma : keysym = 0x02c +let _minus : keysym = 0x02d +let _period : keysym = 0x02e +let _slash : keysym = 0x02f +let _0 : keysym = 0x030 +let _1 : keysym = 0x031 +let _2 : keysym = 0x032 +let _3 : keysym = 0x033 +let _4 : keysym = 0x034 +let _5 : keysym = 0x035 +let _6 : keysym = 0x036 +let _7 : keysym = 0x037 +let _8 : keysym = 0x038 +let _9 : keysym = 0x039 +let _colon : keysym = 0x03a +let _semicolon : keysym = 0x03b +let _less : keysym = 0x03c +let _equal : keysym = 0x03d +let _greater : keysym = 0x03e +let _question : keysym = 0x03f +let _at : keysym = 0x040 +let _A : keysym = 0x041 +let _B : keysym = 0x042 +let _C : keysym = 0x043 +let _D : keysym = 0x044 +let _E : keysym = 0x045 +let _F : keysym = 0x046 +let _G : keysym = 0x047 +let _H : keysym = 0x048 +let _I : keysym = 0x049 +let _J : keysym = 0x04a +let _K : keysym = 0x04b +let _L : keysym = 0x04c +let _M : keysym = 0x04d +let _N : keysym = 0x04e +let _O : keysym = 0x04f +let _P : keysym = 0x050 +let _Q : keysym = 0x051 +let _R : keysym = 0x052 +let _S : keysym = 0x053 +let _T : keysym = 0x054 +let _U : keysym = 0x055 +let _V : keysym = 0x056 +let _W : keysym = 0x057 +let _X : keysym = 0x058 +let _Y : keysym = 0x059 +let _Z : keysym = 0x05a +let _bracketleft : keysym = 0x05b +let _backslash : keysym = 0x05c +let _bracketright : keysym = 0x05d +let _asciicircum : keysym = 0x05e +let _underscore : keysym = 0x05f +let _grave : keysym = 0x060 +let _quoteleft : keysym = 0x060 +let _a : keysym = 0x061 +let _b : keysym = 0x062 +let _c : keysym = 0x063 +let _d : keysym = 0x064 +let _e : keysym = 0x065 +let _f : keysym = 0x066 +let _g : keysym = 0x067 +let _h : keysym = 0x068 +let _i : keysym = 0x069 +let _j : keysym = 0x06a +let _k : keysym = 0x06b +let _l : keysym = 0x06c +let _m : keysym = 0x06d +let _n : keysym = 0x06e +let _o : keysym = 0x06f +let _p : keysym = 0x070 +let _q : keysym = 0x071 +let _r : keysym = 0x072 +let _s : keysym = 0x073 +let _t : keysym = 0x074 +let _u : keysym = 0x075 +let _v : keysym = 0x076 +let _w : keysym = 0x077 +let _x : keysym = 0x078 +let _y : keysym = 0x079 +let _z : keysym = 0x07a +let _braceleft : keysym = 0x07b +let _bar : keysym = 0x07c +let _braceright : keysym = 0x07d +let _asciitilde : keysym = 0x07e +let _nobreakspace : keysym = 0x0a0 +let _exclamdown : keysym = 0x0a1 +let _cent : keysym = 0x0a2 +let _sterling : keysym = 0x0a3 +let _currency : keysym = 0x0a4 +let _yen : keysym = 0x0a5 +let _brokenbar : keysym = 0x0a6 +let _section : keysym = 0x0a7 +let _diaeresis : keysym = 0x0a8 +let _copyright : keysym = 0x0a9 +let _ordfeminine : keysym = 0x0aa +let _guillemotleft : keysym = 0x0ab +let _notsign : keysym = 0x0ac +let _hyphen : keysym = 0x0ad +let _registered : keysym = 0x0ae +let _macron : keysym = 0x0af +let _degree : keysym = 0x0b0 +let _plusminus : keysym = 0x0b1 +let _twosuperior : keysym = 0x0b2 +let _threesuperior : keysym = 0x0b3 +let _acute : keysym = 0x0b4 +let _mu : keysym = 0x0b5 +let _paragraph : keysym = 0x0b6 +let _periodcentered : keysym = 0x0b7 +let _cedilla : keysym = 0x0b8 +let _onesuperior : keysym = 0x0b9 +let _masculine : keysym = 0x0ba +let _guillemotright : keysym = 0x0bb +let _onequarter : keysym = 0x0bc +let _onehalf : keysym = 0x0bd +let _threequarters : keysym = 0x0be +let _questiondown : keysym = 0x0bf +let _Agrave : keysym = 0x0c0 +let _Aacute : keysym = 0x0c1 +let _Acircumflex : keysym = 0x0c2 +let _Atilde : keysym = 0x0c3 +let _Adiaeresis : keysym = 0x0c4 +let _Aring : keysym = 0x0c5 +let _AE : keysym = 0x0c6 +let _Ccedilla : keysym = 0x0c7 +let _Egrave : keysym = 0x0c8 +let _Eacute : keysym = 0x0c9 +let _Ecircumflex : keysym = 0x0ca +let _Ediaeresis : keysym = 0x0cb +let _Igrave : keysym = 0x0cc +let _Iacute : keysym = 0x0cd +let _Icircumflex : keysym = 0x0ce +let _Idiaeresis : keysym = 0x0cf +let _ETH : keysym = 0x0d0 +let _Eth : keysym = 0x0d0 +let _Ntilde : keysym = 0x0d1 +let _Ograve : keysym = 0x0d2 +let _Oacute : keysym = 0x0d3 +let _Ocircumflex : keysym = 0x0d4 +let _Otilde : keysym = 0x0d5 +let _Odiaeresis : keysym = 0x0d6 +let _multiply : keysym = 0x0d7 +let _Ooblique : keysym = 0x0d8 +let _Ugrave : keysym = 0x0d9 +let _Uacute : keysym = 0x0da +let _Ucircumflex : keysym = 0x0db +let _Udiaeresis : keysym = 0x0dc +let _Yacute : keysym = 0x0dd +let _THORN : keysym = 0x0de +let _Thorn : keysym = 0x0de +let _ssharp : keysym = 0x0df +let _agrave : keysym = 0x0e0 +let _aacute : keysym = 0x0e1 +let _acircumflex : keysym = 0x0e2 +let _atilde : keysym = 0x0e3 +let _adiaeresis : keysym = 0x0e4 +let _aring : keysym = 0x0e5 +let _ae : keysym = 0x0e6 +let _ccedilla : keysym = 0x0e7 +let _egrave : keysym = 0x0e8 +let _eacute : keysym = 0x0e9 +let _ecircumflex : keysym = 0x0ea +let _ediaeresis : keysym = 0x0eb +let _igrave : keysym = 0x0ec +let _iacute : keysym = 0x0ed +let _icircumflex : keysym = 0x0ee +let _idiaeresis : keysym = 0x0ef +let _eth : keysym = 0x0f0 +let _ntilde : keysym = 0x0f1 +let _ograve : keysym = 0x0f2 +let _oacute : keysym = 0x0f3 +let _ocircumflex : keysym = 0x0f4 +let _otilde : keysym = 0x0f5 +let _odiaeresis : keysym = 0x0f6 +let _division : keysym = 0x0f7 +let _oslash : keysym = 0x0f8 +let _ugrave : keysym = 0x0f9 +let _uacute : keysym = 0x0fa +let _ucircumflex : keysym = 0x0fb +let _udiaeresis : keysym = 0x0fc +let _yacute : keysym = 0x0fd +let _thorn : keysym = 0x0fe +let _ydiaeresis : keysym = 0x0ff +let _Aogonek : keysym = 0x1a1 +let _breve : keysym = 0x1a2 +let _Lstroke : keysym = 0x1a3 +let _Lcaron : keysym = 0x1a5 +let _Sacute : keysym = 0x1a6 +let _Scaron : keysym = 0x1a9 +let _Scedilla : keysym = 0x1aa +let _Tcaron : keysym = 0x1ab +let _Zacute : keysym = 0x1ac +let _Zcaron : keysym = 0x1ae +let _Zabovedot : keysym = 0x1af +let _aogonek : keysym = 0x1b1 +let _ogonek : keysym = 0x1b2 +let _lstroke : keysym = 0x1b3 +let _lcaron : keysym = 0x1b5 +let _sacute : keysym = 0x1b6 +let _caron : keysym = 0x1b7 +let _scaron : keysym = 0x1b9 +let _scedilla : keysym = 0x1ba +let _tcaron : keysym = 0x1bb +let _zacute : keysym = 0x1bc +let _doubleacute : keysym = 0x1bd +let _zcaron : keysym = 0x1be +let _zabovedot : keysym = 0x1bf +let _Racute : keysym = 0x1c0 +let _Abreve : keysym = 0x1c3 +let _Lacute : keysym = 0x1c5 +let _Cacute : keysym = 0x1c6 +let _Ccaron : keysym = 0x1c8 +let _Eogonek : keysym = 0x1ca +let _Ecaron : keysym = 0x1cc +let _Dcaron : keysym = 0x1cf +let _Dstroke : keysym = 0x1d0 +let _Nacute : keysym = 0x1d1 +let _Ncaron : keysym = 0x1d2 +let _Odoubleacute : keysym = 0x1d5 +let _Rcaron : keysym = 0x1d8 +let _Uring : keysym = 0x1d9 +let _Udoubleacute : keysym = 0x1db +let _Tcedilla : keysym = 0x1de +let _racute : keysym = 0x1e0 +let _abreve : keysym = 0x1e3 +let _lacute : keysym = 0x1e5 +let _cacute : keysym = 0x1e6 +let _ccaron : keysym = 0x1e8 +let _eogonek : keysym = 0x1ea +let _ecaron : keysym = 0x1ec +let _dcaron : keysym = 0x1ef +let _dstroke : keysym = 0x1f0 +let _nacute : keysym = 0x1f1 +let _ncaron : keysym = 0x1f2 +let _odoubleacute : keysym = 0x1f5 +let _udoubleacute : keysym = 0x1fb +let _rcaron : keysym = 0x1f8 +let _uring : keysym = 0x1f9 +let _tcedilla : keysym = 0x1fe +let _abovedot : keysym = 0x1ff +let _Hstroke : keysym = 0x2a1 +let _Hcircumflex : keysym = 0x2a6 +let _Iabovedot : keysym = 0x2a9 +let _Gbreve : keysym = 0x2ab +let _Jcircumflex : keysym = 0x2ac +let _hstroke : keysym = 0x2b1 +let _hcircumflex : keysym = 0x2b6 +let _idotless : keysym = 0x2b9 +let _gbreve : keysym = 0x2bb +let _jcircumflex : keysym = 0x2bc +let _Cabovedot : keysym = 0x2c5 +let _Ccircumflex : keysym = 0x2c6 +let _Gabovedot : keysym = 0x2d5 +let _Gcircumflex : keysym = 0x2d8 +let _Ubreve : keysym = 0x2dd +let _Scircumflex : keysym = 0x2de +let _cabovedot : keysym = 0x2e5 +let _ccircumflex : keysym = 0x2e6 +let _gabovedot : keysym = 0x2f5 +let _gcircumflex : keysym = 0x2f8 +let _ubreve : keysym = 0x2fd +let _scircumflex : keysym = 0x2fe +let _kra : keysym = 0x3a2 +let _kappa : keysym = 0x3a2 +let _Rcedilla : keysym = 0x3a3 +let _Itilde : keysym = 0x3a5 +let _Lcedilla : keysym = 0x3a6 +let _Emacron : keysym = 0x3aa +let _Gcedilla : keysym = 0x3ab +let _Tslash : keysym = 0x3ac +let _rcedilla : keysym = 0x3b3 +let _itilde : keysym = 0x3b5 +let _lcedilla : keysym = 0x3b6 +let _emacron : keysym = 0x3ba +let _gcedilla : keysym = 0x3bb +let _tslash : keysym = 0x3bc +let _ENG : keysym = 0x3bd +let _eng : keysym = 0x3bf +let _Amacron : keysym = 0x3c0 +let _Iogonek : keysym = 0x3c7 +let _Eabovedot : keysym = 0x3cc +let _Imacron : keysym = 0x3cf +let _Ncedilla : keysym = 0x3d1 +let _Omacron : keysym = 0x3d2 +let _Kcedilla : keysym = 0x3d3 +let _Uogonek : keysym = 0x3d9 +let _Utilde : keysym = 0x3dd +let _Umacron : keysym = 0x3de +let _amacron : keysym = 0x3e0 +let _iogonek : keysym = 0x3e7 +let _eabovedot : keysym = 0x3ec +let _imacron : keysym = 0x3ef +let _ncedilla : keysym = 0x3f1 +let _omacron : keysym = 0x3f2 +let _kcedilla : keysym = 0x3f3 +let _uogonek : keysym = 0x3f9 +let _utilde : keysym = 0x3fd +let _umacron : keysym = 0x3fe +let _overline : keysym = 0x47e +let _kana_fullstop : keysym = 0x4a1 +let _kana_openingbracket : keysym = 0x4a2 +let _kana_closingbracket : keysym = 0x4a3 +let _kana_comma : keysym = 0x4a4 +let _kana_conjunctive : keysym = 0x4a5 +let _kana_middledot : keysym = 0x4a5 +let _kana_WO : keysym = 0x4a6 +let _kana_a : keysym = 0x4a7 +let _kana_i : keysym = 0x4a8 +let _kana_u : keysym = 0x4a9 +let _kana_e : keysym = 0x4aa +let _kana_o : keysym = 0x4ab +let _kana_ya : keysym = 0x4ac +let _kana_yu : keysym = 0x4ad +let _kana_yo : keysym = 0x4ae +let _kana_tsu : keysym = 0x4af +let _kana_tu : keysym = 0x4af +let _prolongedsound : keysym = 0x4b0 +let _kana_A : keysym = 0x4b1 +let _kana_I : keysym = 0x4b2 +let _kana_U : keysym = 0x4b3 +let _kana_E : keysym = 0x4b4 +let _kana_O : keysym = 0x4b5 +let _kana_KA : keysym = 0x4b6 +let _kana_KI : keysym = 0x4b7 +let _kana_KU : keysym = 0x4b8 +let _kana_KE : keysym = 0x4b9 +let _kana_KO : keysym = 0x4ba +let _kana_SA : keysym = 0x4bb +let _kana_SHI : keysym = 0x4bc +let _kana_SU : keysym = 0x4bd +let _kana_SE : keysym = 0x4be +let _kana_SO : keysym = 0x4bf +let _kana_TA : keysym = 0x4c0 +let _kana_CHI : keysym = 0x4c1 +let _kana_TI : keysym = 0x4c1 +let _kana_TSU : keysym = 0x4c2 +let _kana_TU : keysym = 0x4c2 +let _kana_TE : keysym = 0x4c3 +let _kana_TO : keysym = 0x4c4 +let _kana_NA : keysym = 0x4c5 +let _kana_NI : keysym = 0x4c6 +let _kana_NU : keysym = 0x4c7 +let _kana_NE : keysym = 0x4c8 +let _kana_NO : keysym = 0x4c9 +let _kana_HA : keysym = 0x4ca +let _kana_HI : keysym = 0x4cb +let _kana_FU : keysym = 0x4cc +let _kana_HU : keysym = 0x4cc +let _kana_HE : keysym = 0x4cd +let _kana_HO : keysym = 0x4ce +let _kana_MA : keysym = 0x4cf +let _kana_MI : keysym = 0x4d0 +let _kana_MU : keysym = 0x4d1 +let _kana_ME : keysym = 0x4d2 +let _kana_MO : keysym = 0x4d3 +let _kana_YA : keysym = 0x4d4 +let _kana_YU : keysym = 0x4d5 +let _kana_YO : keysym = 0x4d6 +let _kana_RA : keysym = 0x4d7 +let _kana_RI : keysym = 0x4d8 +let _kana_RU : keysym = 0x4d9 +let _kana_RE : keysym = 0x4da +let _kana_RO : keysym = 0x4db +let _kana_WA : keysym = 0x4dc +let _kana_N : keysym = 0x4dd +let _voicedsound : keysym = 0x4de +let _semivoicedsound : keysym = 0x4df +let _kana_switch : keysym = 0xFF7E +let _Arabic_comma : keysym = 0x5ac +let _Arabic_semicolon : keysym = 0x5bb +let _Arabic_question_mark : keysym = 0x5bf +let _Arabic_hamza : keysym = 0x5c1 +let _Arabic_maddaonalef : keysym = 0x5c2 +let _Arabic_hamzaonalef : keysym = 0x5c3 +let _Arabic_hamzaonwaw : keysym = 0x5c4 +let _Arabic_hamzaunderalef : keysym = 0x5c5 +let _Arabic_hamzaonyeh : keysym = 0x5c6 +let _Arabic_alef : keysym = 0x5c7 +let _Arabic_beh : keysym = 0x5c8 +let _Arabic_tehmarbuta : keysym = 0x5c9 +let _Arabic_teh : keysym = 0x5ca +let _Arabic_theh : keysym = 0x5cb +let _Arabic_jeem : keysym = 0x5cc +let _Arabic_hah : keysym = 0x5cd +let _Arabic_khah : keysym = 0x5ce +let _Arabic_dal : keysym = 0x5cf +let _Arabic_thal : keysym = 0x5d0 +let _Arabic_ra : keysym = 0x5d1 +let _Arabic_zain : keysym = 0x5d2 +let _Arabic_seen : keysym = 0x5d3 +let _Arabic_sheen : keysym = 0x5d4 +let _Arabic_sad : keysym = 0x5d5 +let _Arabic_dad : keysym = 0x5d6 +let _Arabic_tah : keysym = 0x5d7 +let _Arabic_zah : keysym = 0x5d8 +let _Arabic_ain : keysym = 0x5d9 +let _Arabic_ghain : keysym = 0x5da +let _Arabic_tatweel : keysym = 0x5e0 +let _Arabic_feh : keysym = 0x5e1 +let _Arabic_qaf : keysym = 0x5e2 +let _Arabic_kaf : keysym = 0x5e3 +let _Arabic_lam : keysym = 0x5e4 +let _Arabic_meem : keysym = 0x5e5 +let _Arabic_noon : keysym = 0x5e6 +let _Arabic_ha : keysym = 0x5e7 +let _Arabic_heh : keysym = 0x5e7 +let _Arabic_waw : keysym = 0x5e8 +let _Arabic_alefmaksura : keysym = 0x5e9 +let _Arabic_yeh : keysym = 0x5ea +let _Arabic_fathatan : keysym = 0x5eb +let _Arabic_dammatan : keysym = 0x5ec +let _Arabic_kasratan : keysym = 0x5ed +let _Arabic_fatha : keysym = 0x5ee +let _Arabic_damma : keysym = 0x5ef +let _Arabic_kasra : keysym = 0x5f0 +let _Arabic_shadda : keysym = 0x5f1 +let _Arabic_sukun : keysym = 0x5f2 +let _Arabic_switch : keysym = 0xFF7E +let _Serbian_dje : keysym = 0x6a1 +let _Macedonia_gje : keysym = 0x6a2 +let _Cyrillic_io : keysym = 0x6a3 +let _Ukrainian_ie : keysym = 0x6a4 +let _Ukranian_je : keysym = 0x6a4 +let _Macedonia_dse : keysym = 0x6a5 +let _Ukrainian_i : keysym = 0x6a6 +let _Ukranian_i : keysym = 0x6a6 +let _Ukrainian_yi : keysym = 0x6a7 +let _Ukranian_yi : keysym = 0x6a7 +let _Cyrillic_je : keysym = 0x6a8 +let _Serbian_je : keysym = 0x6a8 +let _Cyrillic_lje : keysym = 0x6a9 +let _Serbian_lje : keysym = 0x6a9 +let _Cyrillic_nje : keysym = 0x6aa +let _Serbian_nje : keysym = 0x6aa +let _Serbian_tshe : keysym = 0x6ab +let _Macedonia_kje : keysym = 0x6ac +let _Byelorussian_shortu : keysym = 0x6ae +let _Cyrillic_dzhe : keysym = 0x6af +let _Serbian_dze : keysym = 0x6af +let _numerosign : keysym = 0x6b0 +let _Serbian_DJE : keysym = 0x6b1 +let _Macedonia_GJE : keysym = 0x6b2 +let _Cyrillic_IO : keysym = 0x6b3 +let _Ukrainian_IE : keysym = 0x6b4 +let _Ukranian_JE : keysym = 0x6b4 +let _Macedonia_DSE : keysym = 0x6b5 +let _Ukrainian_I : keysym = 0x6b6 +let _Ukranian_I : keysym = 0x6b6 +let _Ukrainian_YI : keysym = 0x6b7 +let _Ukranian_YI : keysym = 0x6b7 +let _Cyrillic_JE : keysym = 0x6b8 +let _Serbian_JE : keysym = 0x6b8 +let _Cyrillic_LJE : keysym = 0x6b9 +let _Serbian_LJE : keysym = 0x6b9 +let _Cyrillic_NJE : keysym = 0x6ba +let _Serbian_NJE : keysym = 0x6ba +let _Serbian_TSHE : keysym = 0x6bb +let _Macedonia_KJE : keysym = 0x6bc +let _Byelorussian_SHORTU : keysym = 0x6be +let _Cyrillic_DZHE : keysym = 0x6bf +let _Serbian_DZE : keysym = 0x6bf +let _Cyrillic_yu : keysym = 0x6c0 +let _Cyrillic_a : keysym = 0x6c1 +let _Cyrillic_be : keysym = 0x6c2 +let _Cyrillic_tse : keysym = 0x6c3 +let _Cyrillic_de : keysym = 0x6c4 +let _Cyrillic_ie : keysym = 0x6c5 +let _Cyrillic_ef : keysym = 0x6c6 +let _Cyrillic_ghe : keysym = 0x6c7 +let _Cyrillic_ha : keysym = 0x6c8 +let _Cyrillic_i : keysym = 0x6c9 +let _Cyrillic_shorti : keysym = 0x6ca +let _Cyrillic_ka : keysym = 0x6cb +let _Cyrillic_el : keysym = 0x6cc +let _Cyrillic_em : keysym = 0x6cd +let _Cyrillic_en : keysym = 0x6ce +let _Cyrillic_o : keysym = 0x6cf +let _Cyrillic_pe : keysym = 0x6d0 +let _Cyrillic_ya : keysym = 0x6d1 +let _Cyrillic_er : keysym = 0x6d2 +let _Cyrillic_es : keysym = 0x6d3 +let _Cyrillic_te : keysym = 0x6d4 +let _Cyrillic_u : keysym = 0x6d5 +let _Cyrillic_zhe : keysym = 0x6d6 +let _Cyrillic_ve : keysym = 0x6d7 +let _Cyrillic_softsign : keysym = 0x6d8 +let _Cyrillic_yeru : keysym = 0x6d9 +let _Cyrillic_ze : keysym = 0x6da +let _Cyrillic_sha : keysym = 0x6db +let _Cyrillic_e : keysym = 0x6dc +let _Cyrillic_shcha : keysym = 0x6dd +let _Cyrillic_che : keysym = 0x6de +let _Cyrillic_hardsign : keysym = 0x6df +let _Cyrillic_YU : keysym = 0x6e0 +let _Cyrillic_A : keysym = 0x6e1 +let _Cyrillic_BE : keysym = 0x6e2 +let _Cyrillic_TSE : keysym = 0x6e3 +let _Cyrillic_DE : keysym = 0x6e4 +let _Cyrillic_IE : keysym = 0x6e5 +let _Cyrillic_EF : keysym = 0x6e6 +let _Cyrillic_GHE : keysym = 0x6e7 +let _Cyrillic_HA : keysym = 0x6e8 +let _Cyrillic_I : keysym = 0x6e9 +let _Cyrillic_SHORTI : keysym = 0x6ea +let _Cyrillic_KA : keysym = 0x6eb +let _Cyrillic_EL : keysym = 0x6ec +let _Cyrillic_EM : keysym = 0x6ed +let _Cyrillic_EN : keysym = 0x6ee +let _Cyrillic_O : keysym = 0x6ef +let _Cyrillic_PE : keysym = 0x6f0 +let _Cyrillic_YA : keysym = 0x6f1 +let _Cyrillic_ER : keysym = 0x6f2 +let _Cyrillic_ES : keysym = 0x6f3 +let _Cyrillic_TE : keysym = 0x6f4 +let _Cyrillic_U : keysym = 0x6f5 +let _Cyrillic_ZHE : keysym = 0x6f6 +let _Cyrillic_VE : keysym = 0x6f7 +let _Cyrillic_SOFTSIGN : keysym = 0x6f8 +let _Cyrillic_YERU : keysym = 0x6f9 +let _Cyrillic_ZE : keysym = 0x6fa +let _Cyrillic_SHA : keysym = 0x6fb +let _Cyrillic_E : keysym = 0x6fc +let _Cyrillic_SHCHA : keysym = 0x6fd +let _Cyrillic_CHE : keysym = 0x6fe +let _Cyrillic_HARDSIGN : keysym = 0x6ff +let _Greek_ALPHAaccent : keysym = 0x7a1 +let _Greek_EPSILONaccent : keysym = 0x7a2 +let _Greek_ETAaccent : keysym = 0x7a3 +let _Greek_IOTAaccent : keysym = 0x7a4 +let _Greek_IOTAdiaeresis : keysym = 0x7a5 +let _Greek_OMICRONaccent : keysym = 0x7a7 +let _Greek_UPSILONaccent : keysym = 0x7a8 +let _Greek_UPSILONdieresis : keysym = 0x7a9 +let _Greek_OMEGAaccent : keysym = 0x7ab +let _Greek_accentdieresis : keysym = 0x7ae +let _Greek_horizbar : keysym = 0x7af +let _Greek_alphaaccent : keysym = 0x7b1 +let _Greek_epsilonaccent : keysym = 0x7b2 +let _Greek_etaaccent : keysym = 0x7b3 +let _Greek_iotaaccent : keysym = 0x7b4 +let _Greek_iotadieresis : keysym = 0x7b5 +let _Greek_iotaaccentdieresis : keysym = 0x7b6 +let _Greek_omicronaccent : keysym = 0x7b7 +let _Greek_upsilonaccent : keysym = 0x7b8 +let _Greek_upsilondieresis : keysym = 0x7b9 +let _Greek_upsilonaccentdieresis : keysym = 0x7ba +let _Greek_omegaaccent : keysym = 0x7bb +let _Greek_ALPHA : keysym = 0x7c1 +let _Greek_BETA : keysym = 0x7c2 +let _Greek_GAMMA : keysym = 0x7c3 +let _Greek_DELTA : keysym = 0x7c4 +let _Greek_EPSILON : keysym = 0x7c5 +let _Greek_ZETA : keysym = 0x7c6 +let _Greek_ETA : keysym = 0x7c7 +let _Greek_THETA : keysym = 0x7c8 +let _Greek_IOTA : keysym = 0x7c9 +let _Greek_KAPPA : keysym = 0x7ca +let _Greek_LAMDA : keysym = 0x7cb +let _Greek_LAMBDA : keysym = 0x7cb +let _Greek_MU : keysym = 0x7cc +let _Greek_NU : keysym = 0x7cd +let _Greek_XI : keysym = 0x7ce +let _Greek_OMICRON : keysym = 0x7cf +let _Greek_PI : keysym = 0x7d0 +let _Greek_RHO : keysym = 0x7d1 +let _Greek_SIGMA : keysym = 0x7d2 +let _Greek_TAU : keysym = 0x7d4 +let _Greek_UPSILON : keysym = 0x7d5 +let _Greek_PHI : keysym = 0x7d6 +let _Greek_CHI : keysym = 0x7d7 +let _Greek_PSI : keysym = 0x7d8 +let _Greek_OMEGA : keysym = 0x7d9 +let _Greek_alpha : keysym = 0x7e1 +let _Greek_beta : keysym = 0x7e2 +let _Greek_gamma : keysym = 0x7e3 +let _Greek_delta : keysym = 0x7e4 +let _Greek_epsilon : keysym = 0x7e5 +let _Greek_zeta : keysym = 0x7e6 +let _Greek_eta : keysym = 0x7e7 +let _Greek_theta : keysym = 0x7e8 +let _Greek_iota : keysym = 0x7e9 +let _Greek_kappa : keysym = 0x7ea +let _Greek_lamda : keysym = 0x7eb +let _Greek_lambda : keysym = 0x7eb +let _Greek_mu : keysym = 0x7ec +let _Greek_nu : keysym = 0x7ed +let _Greek_xi : keysym = 0x7ee +let _Greek_omicron : keysym = 0x7ef +let _Greek_pi : keysym = 0x7f0 +let _Greek_rho : keysym = 0x7f1 +let _Greek_sigma : keysym = 0x7f2 +let _Greek_finalsmallsigma : keysym = 0x7f3 +let _Greek_tau : keysym = 0x7f4 +let _Greek_upsilon : keysym = 0x7f5 +let _Greek_phi : keysym = 0x7f6 +let _Greek_chi : keysym = 0x7f7 +let _Greek_psi : keysym = 0x7f8 +let _Greek_omega : keysym = 0x7f9 +let _Greek_switch : keysym = 0xFF7E +let _leftradical : keysym = 0x8a1 +let _topleftradical : keysym = 0x8a2 +let _horizconnector : keysym = 0x8a3 +let _topintegral : keysym = 0x8a4 +let _botintegral : keysym = 0x8a5 +let _vertconnector : keysym = 0x8a6 +let _topleftsqbracket : keysym = 0x8a7 +let _botleftsqbracket : keysym = 0x8a8 +let _toprightsqbracket : keysym = 0x8a9 +let _botrightsqbracket : keysym = 0x8aa +let _topleftparens : keysym = 0x8ab +let _botleftparens : keysym = 0x8ac +let _toprightparens : keysym = 0x8ad +let _botrightparens : keysym = 0x8ae +let _leftmiddlecurlybrace : keysym = 0x8af +let _rightmiddlecurlybrace : keysym = 0x8b0 +let _topleftsummation : keysym = 0x8b1 +let _botleftsummation : keysym = 0x8b2 +let _topvertsummationconnector : keysym = 0x8b3 +let _botvertsummationconnector : keysym = 0x8b4 +let _toprightsummation : keysym = 0x8b5 +let _botrightsummation : keysym = 0x8b6 +let _rightmiddlesummation : keysym = 0x8b7 +let _lessthanequal : keysym = 0x8bc +let _notequal : keysym = 0x8bd +let _greaterthanequal : keysym = 0x8be +let _integral : keysym = 0x8bf +let _therefore : keysym = 0x8c0 +let _variation : keysym = 0x8c1 +let _infinity : keysym = 0x8c2 +let _nabla : keysym = 0x8c5 +let _approximate : keysym = 0x8c8 +let _similarequal : keysym = 0x8c9 +let _ifonlyif : keysym = 0x8cd +let _implies : keysym = 0x8ce +let _identical : keysym = 0x8cf +let _radical : keysym = 0x8d6 +let _includedin : keysym = 0x8da +let _includes : keysym = 0x8db +let _intersection : keysym = 0x8dc +let _union : keysym = 0x8dd +let _logicaland : keysym = 0x8de +let _logicalor : keysym = 0x8df +let _partialderivative : keysym = 0x8ef +let _function : keysym = 0x8f6 +let _leftarrow : keysym = 0x8fb +let _uparrow : keysym = 0x8fc +let _rightarrow : keysym = 0x8fd +let _downarrow : keysym = 0x8fe +let _blank : keysym = 0x9df +let _soliddiamond : keysym = 0x9e0 +let _checkerboard : keysym = 0x9e1 +let _ht : keysym = 0x9e2 +let _ff : keysym = 0x9e3 +let _cr : keysym = 0x9e4 +let _lf : keysym = 0x9e5 +let _nl : keysym = 0x9e8 +let _vt : keysym = 0x9e9 +let _lowrightcorner : keysym = 0x9ea +let _uprightcorner : keysym = 0x9eb +let _upleftcorner : keysym = 0x9ec +let _lowleftcorner : keysym = 0x9ed +let _crossinglines : keysym = 0x9ee +let _horizlinescan1 : keysym = 0x9ef +let _horizlinescan3 : keysym = 0x9f0 +let _horizlinescan5 : keysym = 0x9f1 +let _horizlinescan7 : keysym = 0x9f2 +let _horizlinescan9 : keysym = 0x9f3 +let _leftt : keysym = 0x9f4 +let _rightt : keysym = 0x9f5 +let _bott : keysym = 0x9f6 +let _topt : keysym = 0x9f7 +let _vertbar : keysym = 0x9f8 +let _emspace : keysym = 0xaa1 +let _enspace : keysym = 0xaa2 +let _em3space : keysym = 0xaa3 +let _em4space : keysym = 0xaa4 +let _digitspace : keysym = 0xaa5 +let _punctspace : keysym = 0xaa6 +let _thinspace : keysym = 0xaa7 +let _hairspace : keysym = 0xaa8 +let _emdash : keysym = 0xaa9 +let _endash : keysym = 0xaaa +let _signifblank : keysym = 0xaac +let _ellipsis : keysym = 0xaae +let _doubbaselinedot : keysym = 0xaaf +let _onethird : keysym = 0xab0 +let _twothirds : keysym = 0xab1 +let _onefifth : keysym = 0xab2 +let _twofifths : keysym = 0xab3 +let _threefifths : keysym = 0xab4 +let _fourfifths : keysym = 0xab5 +let _onesixth : keysym = 0xab6 +let _fivesixths : keysym = 0xab7 +let _careof : keysym = 0xab8 +let _figdash : keysym = 0xabb +let _leftanglebracket : keysym = 0xabc +let _decimalpoint : keysym = 0xabd +let _rightanglebracket : keysym = 0xabe +let _marker : keysym = 0xabf +let _oneeighth : keysym = 0xac3 +let _threeeighths : keysym = 0xac4 +let _fiveeighths : keysym = 0xac5 +let _seveneighths : keysym = 0xac6 +let _trademark : keysym = 0xac9 +let _signaturemark : keysym = 0xaca +let _trademarkincircle : keysym = 0xacb +let _leftopentriangle : keysym = 0xacc +let _rightopentriangle : keysym = 0xacd +let _emopencircle : keysym = 0xace +let _emopenrectangle : keysym = 0xacf +let _leftsinglequotemark : keysym = 0xad0 +let _rightsinglequotemark : keysym = 0xad1 +let _leftdoublequotemark : keysym = 0xad2 +let _rightdoublequotemark : keysym = 0xad3 +let _prescription : keysym = 0xad4 +let _minutes : keysym = 0xad6 +let _seconds : keysym = 0xad7 +let _latincross : keysym = 0xad9 +let _hexagram : keysym = 0xada +let _filledrectbullet : keysym = 0xadb +let _filledlefttribullet : keysym = 0xadc +let _filledrighttribullet : keysym = 0xadd +let _emfilledcircle : keysym = 0xade +let _emfilledrect : keysym = 0xadf +let _enopencircbullet : keysym = 0xae0 +let _enopensquarebullet : keysym = 0xae1 +let _openrectbullet : keysym = 0xae2 +let _opentribulletup : keysym = 0xae3 +let _opentribulletdown : keysym = 0xae4 +let _openstar : keysym = 0xae5 +let _enfilledcircbullet : keysym = 0xae6 +let _enfilledsqbullet : keysym = 0xae7 +let _filledtribulletup : keysym = 0xae8 +let _filledtribulletdown : keysym = 0xae9 +let _leftpointer : keysym = 0xaea +let _rightpointer : keysym = 0xaeb +let _club : keysym = 0xaec +let _diamond : keysym = 0xaed +let _heart : keysym = 0xaee +let _maltesecross : keysym = 0xaf0 +let _dagger : keysym = 0xaf1 +let _doubledagger : keysym = 0xaf2 +let _checkmark : keysym = 0xaf3 +let _ballotcross : keysym = 0xaf4 +let _musicalsharp : keysym = 0xaf5 +let _musicalflat : keysym = 0xaf6 +let _malesymbol : keysym = 0xaf7 +let _femalesymbol : keysym = 0xaf8 +let _telephone : keysym = 0xaf9 +let _telephonerecorder : keysym = 0xafa +let _phonographcopyright : keysym = 0xafb +let _caret : keysym = 0xafc +let _singlelowquotemark : keysym = 0xafd +let _doublelowquotemark : keysym = 0xafe +let _cursor : keysym = 0xaff +let _leftcaret : keysym = 0xba3 +let _rightcaret : keysym = 0xba6 +let _downcaret : keysym = 0xba8 +let _upcaret : keysym = 0xba9 +let _overbar : keysym = 0xbc0 +let _downtack : keysym = 0xbc2 +let _upshoe : keysym = 0xbc3 +let _downstile : keysym = 0xbc4 +let _underbar : keysym = 0xbc6 +let _jot : keysym = 0xbca +let _quad : keysym = 0xbcc +let _uptack : keysym = 0xbce +let _circle : keysym = 0xbcf +let _upstile : keysym = 0xbd3 +let _downshoe : keysym = 0xbd6 +let _rightshoe : keysym = 0xbd8 +let _leftshoe : keysym = 0xbda +let _lefttack : keysym = 0xbdc +let _righttack : keysym = 0xbfc +let _hebrew_doublelowline : keysym = 0xcdf +let _hebrew_aleph : keysym = 0xce0 +let _hebrew_bet : keysym = 0xce1 +let _hebrew_beth : keysym = 0xce1 +let _hebrew_gimel : keysym = 0xce2 +let _hebrew_gimmel : keysym = 0xce2 +let _hebrew_dalet : keysym = 0xce3 +let _hebrew_daleth : keysym = 0xce3 +let _hebrew_he : keysym = 0xce4 +let _hebrew_waw : keysym = 0xce5 +let _hebrew_zain : keysym = 0xce6 +let _hebrew_zayin : keysym = 0xce6 +let _hebrew_chet : keysym = 0xce7 +let _hebrew_het : keysym = 0xce7 +let _hebrew_tet : keysym = 0xce8 +let _hebrew_teth : keysym = 0xce8 +let _hebrew_yod : keysym = 0xce9 +let _hebrew_finalkaph : keysym = 0xcea +let _hebrew_kaph : keysym = 0xceb +let _hebrew_lamed : keysym = 0xcec +let _hebrew_finalmem : keysym = 0xced +let _hebrew_mem : keysym = 0xcee +let _hebrew_finalnun : keysym = 0xcef +let _hebrew_nun : keysym = 0xcf0 +let _hebrew_samech : keysym = 0xcf1 +let _hebrew_samekh : keysym = 0xcf1 +let _hebrew_ayin : keysym = 0xcf2 +let _hebrew_finalpe : keysym = 0xcf3 +let _hebrew_pe : keysym = 0xcf4 +let _hebrew_finalzade : keysym = 0xcf5 +let _hebrew_finalzadi : keysym = 0xcf5 +let _hebrew_zade : keysym = 0xcf6 +let _hebrew_zadi : keysym = 0xcf6 +let _hebrew_qoph : keysym = 0xcf7 +let _hebrew_kuf : keysym = 0xcf7 +let _hebrew_resh : keysym = 0xcf8 +let _hebrew_shin : keysym = 0xcf9 +let _hebrew_taw : keysym = 0xcfa +let _hebrew_taf : keysym = 0xcfa +let _Hebrew_switch : keysym = 0xFF7E +let _Thai_kokai : keysym = 0xda1 +let _Thai_khokhai : keysym = 0xda2 +let _Thai_khokhuat : keysym = 0xda3 +let _Thai_khokhwai : keysym = 0xda4 +let _Thai_khokhon : keysym = 0xda5 +let _Thai_khorakhang : keysym = 0xda6 +let _Thai_ngongu : keysym = 0xda7 +let _Thai_chochan : keysym = 0xda8 +let _Thai_choching : keysym = 0xda9 +let _Thai_chochang : keysym = 0xdaa +let _Thai_soso : keysym = 0xdab +let _Thai_chochoe : keysym = 0xdac +let _Thai_yoying : keysym = 0xdad +let _Thai_dochada : keysym = 0xdae +let _Thai_topatak : keysym = 0xdaf +let _Thai_thothan : keysym = 0xdb0 +let _Thai_thonangmontho : keysym = 0xdb1 +let _Thai_thophuthao : keysym = 0xdb2 +let _Thai_nonen : keysym = 0xdb3 +let _Thai_dodek : keysym = 0xdb4 +let _Thai_totao : keysym = 0xdb5 +let _Thai_thothung : keysym = 0xdb6 +let _Thai_thothahan : keysym = 0xdb7 +let _Thai_thothong : keysym = 0xdb8 +let _Thai_nonu : keysym = 0xdb9 +let _Thai_bobaimai : keysym = 0xdba +let _Thai_popla : keysym = 0xdbb +let _Thai_phophung : keysym = 0xdbc +let _Thai_fofa : keysym = 0xdbd +let _Thai_phophan : keysym = 0xdbe +let _Thai_fofan : keysym = 0xdbf +let _Thai_phosamphao : keysym = 0xdc0 +let _Thai_moma : keysym = 0xdc1 +let _Thai_yoyak : keysym = 0xdc2 +let _Thai_rorua : keysym = 0xdc3 +let _Thai_ru : keysym = 0xdc4 +let _Thai_loling : keysym = 0xdc5 +let _Thai_lu : keysym = 0xdc6 +let _Thai_wowaen : keysym = 0xdc7 +let _Thai_sosala : keysym = 0xdc8 +let _Thai_sorusi : keysym = 0xdc9 +let _Thai_sosua : keysym = 0xdca +let _Thai_hohip : keysym = 0xdcb +let _Thai_lochula : keysym = 0xdcc +let _Thai_oang : keysym = 0xdcd +let _Thai_honokhuk : keysym = 0xdce +let _Thai_paiyannoi : keysym = 0xdcf +let _Thai_saraa : keysym = 0xdd0 +let _Thai_maihanakat : keysym = 0xdd1 +let _Thai_saraaa : keysym = 0xdd2 +let _Thai_saraam : keysym = 0xdd3 +let _Thai_sarai : keysym = 0xdd4 +let _Thai_saraii : keysym = 0xdd5 +let _Thai_saraue : keysym = 0xdd6 +let _Thai_sarauee : keysym = 0xdd7 +let _Thai_sarau : keysym = 0xdd8 +let _Thai_sarauu : keysym = 0xdd9 +let _Thai_phinthu : keysym = 0xdda +let _Thai_maihanakat_maitho : keysym = 0xdde +let _Thai_baht : keysym = 0xddf +let _Thai_sarae : keysym = 0xde0 +let _Thai_saraae : keysym = 0xde1 +let _Thai_sarao : keysym = 0xde2 +let _Thai_saraaimaimuan : keysym = 0xde3 +let _Thai_saraaimaimalai : keysym = 0xde4 +let _Thai_lakkhangyao : keysym = 0xde5 +let _Thai_maiyamok : keysym = 0xde6 +let _Thai_maitaikhu : keysym = 0xde7 +let _Thai_maiek : keysym = 0xde8 +let _Thai_maitho : keysym = 0xde9 +let _Thai_maitri : keysym = 0xdea +let _Thai_maichattawa : keysym = 0xdeb +let _Thai_thanthakhat : keysym = 0xdec +let _Thai_nikhahit : keysym = 0xded +let _Thai_leksun : keysym = 0xdf0 +let _Thai_leknung : keysym = 0xdf1 +let _Thai_leksong : keysym = 0xdf2 +let _Thai_leksam : keysym = 0xdf3 +let _Thai_leksi : keysym = 0xdf4 +let _Thai_lekha : keysym = 0xdf5 +let _Thai_lekhok : keysym = 0xdf6 +let _Thai_lekchet : keysym = 0xdf7 +let _Thai_lekpaet : keysym = 0xdf8 +let _Thai_lekkao : keysym = 0xdf9 +let _Hangul : keysym = 0xff31 +let _Hangul_Start : keysym = 0xff32 +let _Hangul_End : keysym = 0xff33 +let _Hangul_Hanja : keysym = 0xff34 +let _Hangul_Jamo : keysym = 0xff35 +let _Hangul_Romaja : keysym = 0xff36 +let _Hangul_Codeinput : keysym = 0xff37 +let _Hangul_Jeonja : keysym = 0xff38 +let _Hangul_Banja : keysym = 0xff39 +let _Hangul_PreHanja : keysym = 0xff3a +let _Hangul_PostHanja : keysym = 0xff3b +let _Hangul_SingleCandidate : keysym = 0xff3c +let _Hangul_MultipleCandidate : keysym = 0xff3d +let _Hangul_PreviousCandidate : keysym = 0xff3e +let _Hangul_Special : keysym = 0xff3f +let _Hangul_switch : keysym = 0xFF7E +let _Hangul_Kiyeog : keysym = 0xea1 +let _Hangul_SsangKiyeog : keysym = 0xea2 +let _Hangul_KiyeogSios : keysym = 0xea3 +let _Hangul_Nieun : keysym = 0xea4 +let _Hangul_NieunJieuj : keysym = 0xea5 +let _Hangul_NieunHieuh : keysym = 0xea6 +let _Hangul_Dikeud : keysym = 0xea7 +let _Hangul_SsangDikeud : keysym = 0xea8 +let _Hangul_Rieul : keysym = 0xea9 +let _Hangul_RieulKiyeog : keysym = 0xeaa +let _Hangul_RieulMieum : keysym = 0xeab +let _Hangul_RieulPieub : keysym = 0xeac +let _Hangul_RieulSios : keysym = 0xead +let _Hangul_RieulTieut : keysym = 0xeae +let _Hangul_RieulPhieuf : keysym = 0xeaf +let _Hangul_RieulHieuh : keysym = 0xeb0 +let _Hangul_Mieum : keysym = 0xeb1 +let _Hangul_Pieub : keysym = 0xeb2 +let _Hangul_SsangPieub : keysym = 0xeb3 +let _Hangul_PieubSios : keysym = 0xeb4 +let _Hangul_Sios : keysym = 0xeb5 +let _Hangul_SsangSios : keysym = 0xeb6 +let _Hangul_Ieung : keysym = 0xeb7 +let _Hangul_Jieuj : keysym = 0xeb8 +let _Hangul_SsangJieuj : keysym = 0xeb9 +let _Hangul_Cieuc : keysym = 0xeba +let _Hangul_Khieuq : keysym = 0xebb +let _Hangul_Tieut : keysym = 0xebc +let _Hangul_Phieuf : keysym = 0xebd +let _Hangul_Hieuh : keysym = 0xebe +let _Hangul_A : keysym = 0xebf +let _Hangul_AE : keysym = 0xec0 +let _Hangul_YA : keysym = 0xec1 +let _Hangul_YAE : keysym = 0xec2 +let _Hangul_EO : keysym = 0xec3 +let _Hangul_E : keysym = 0xec4 +let _Hangul_YEO : keysym = 0xec5 +let _Hangul_YE : keysym = 0xec6 +let _Hangul_O : keysym = 0xec7 +let _Hangul_WA : keysym = 0xec8 +let _Hangul_WAE : keysym = 0xec9 +let _Hangul_OE : keysym = 0xeca +let _Hangul_YO : keysym = 0xecb +let _Hangul_U : keysym = 0xecc +let _Hangul_WEO : keysym = 0xecd +let _Hangul_WE : keysym = 0xece +let _Hangul_WI : keysym = 0xecf +let _Hangul_YU : keysym = 0xed0 +let _Hangul_EU : keysym = 0xed1 +let _Hangul_YI : keysym = 0xed2 +let _Hangul_I : keysym = 0xed3 +let _Hangul_J_Kiyeog : keysym = 0xed4 +let _Hangul_J_SsangKiyeog : keysym = 0xed5 +let _Hangul_J_KiyeogSios : keysym = 0xed6 +let _Hangul_J_Nieun : keysym = 0xed7 +let _Hangul_J_NieunJieuj : keysym = 0xed8 +let _Hangul_J_NieunHieuh : keysym = 0xed9 +let _Hangul_J_Dikeud : keysym = 0xeda +let _Hangul_J_Rieul : keysym = 0xedb +let _Hangul_J_RieulKiyeog : keysym = 0xedc +let _Hangul_J_RieulMieum : keysym = 0xedd +let _Hangul_J_RieulPieub : keysym = 0xede +let _Hangul_J_RieulSios : keysym = 0xedf +let _Hangul_J_RieulTieut : keysym = 0xee0 +let _Hangul_J_RieulPhieuf : keysym = 0xee1 +let _Hangul_J_RieulHieuh : keysym = 0xee2 +let _Hangul_J_Mieum : keysym = 0xee3 +let _Hangul_J_Pieub : keysym = 0xee4 +let _Hangul_J_PieubSios : keysym = 0xee5 +let _Hangul_J_Sios : keysym = 0xee6 +let _Hangul_J_SsangSios : keysym = 0xee7 +let _Hangul_J_Ieung : keysym = 0xee8 +let _Hangul_J_Jieuj : keysym = 0xee9 +let _Hangul_J_Cieuc : keysym = 0xeea +let _Hangul_J_Khieuq : keysym = 0xeeb +let _Hangul_J_Tieut : keysym = 0xeec +let _Hangul_J_Phieuf : keysym = 0xeed +let _Hangul_J_Hieuh : keysym = 0xeee +let _Hangul_RieulYeorinHieuh : keysym = 0xeef +let _Hangul_SunkyeongeumMieum : keysym = 0xef0 +let _Hangul_SunkyeongeumPieub : keysym = 0xef1 +let _Hangul_PanSios : keysym = 0xef2 +let _Hangul_KkogjiDalrinIeung : keysym = 0xef3 +let _Hangul_SunkyeongeumPhieuf : keysym = 0xef4 +let _Hangul_YeorinHieuh : keysym = 0xef5 +let _Hangul_AraeA : keysym = 0xef6 +let _Hangul_AraeAE : keysym = 0xef7 +let _Hangul_J_PanSios : keysym = 0xef8 +let _Hangul_J_KkogjiDalrinIeung : keysym = 0xef9 +let _Hangul_J_YeorinHieuh : keysym = 0xefa +let _Korean_Won : keysym = 0xeff diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdk_tags.var b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdk_tags.var new file mode 100644 index 000000000..2c244a79c --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gdk_tags.var @@ -0,0 +1,163 @@ +(* $Id$ *) + +type gdkEventType = "GDK_" + [ `NOTHING | `DELETE | `DESTROY | `EXPOSE | `MOTION_NOTIFY | `BUTTON_PRESS + | `TWO_BUTTON_PRESS "GDK_2BUTTON_PRESS" + | `THREE_BUTTON_PRESS "GDK_3BUTTON_PRESS" + | `BUTTON_RELEASE | `KEY_PRESS + | `KEY_RELEASE | `ENTER_NOTIFY | `LEAVE_NOTIFY | `FOCUS_CHANGE + | `CONFIGURE | `MAP | `UNMAP | `PROPERTY_NOTIFY | `SELECTION_CLEAR + | `SELECTION_REQUEST | `SELECTION_NOTIFY | `PROXIMITY_IN + | `PROXIMITY_OUT + | `DRAG_ENTER | `DRAG_LEAVE | `DRAG_MOTION | `DRAG_STATUS + | `DROP_START | `DROP_FINISHED | `CLIENT_EVENT | `VISIBILITY_NOTIFY + | `NO_EXPOSE ] + +type event_mask = "GDK_" + [ `EXPOSURE + | `POINTER_MOTION | `POINTER_MOTION_HINT + | `BUTTON_MOTION | `BUTTON1_MOTION | `BUTTON2_MOTION | `BUTTON3_MOTION + | `BUTTON_PRESS | `BUTTON_RELEASE + | `KEY_PRESS | `KEY_RELEASE + | `ENTER_NOTIFY | `LEAVE_NOTIFY | `FOCUS_CHANGE + | `STRUCTURE | `PROPERTY_CHANGE | `VISIBILITY_NOTIFY + | `PROXIMITY_IN | `PROXIMITY_OUT | `SUBSTRUCTURE + | `ALL_EVENTS ] "_MASK" + +type extension_events = "GDK_EXTENSION_EVENTS_" + [ `NONE | `ALL | `CURSOR ] + +type gdkVisibilityState = "GDK_VISIBILITY_" + [ `UNOBSCURED | `PARTIAL | `FULLY_OBSCURED ] + +type gdkInputSource = "GDK_SOURCE_" + [ `MOUSE | `PEN | `ERASER | `CURSOR ] + +type gdkCrossingMode = "GDK_CROSSING_" + [ `NORMAL | `GRAB | `UNGRAB ] + +type gdkNotifyType = "GDK_NOTIFY_" + [ `ANCESTOR | `VIRTUAL | `INFERIOR | `NONLINEAR | `NONLINEAR_VIRTUAL + | `UNKNOWN ] + +type gdkFillRule = "GDK_" + [ `EVEN_ODD_RULE | `WINDING_RULE ] + +type gdkOverlapType = "GDK_OVERLAP_RECTANGLE_" + [ `IN | `OUT | `PART ] + +type gdkFunction = "GDK_" + [ `COPY | `INVERT | `XOR ] + +type gdkFill = "GDK_" + [ `SOLID | `TILED | `STIPPLED | `OPAQUE_STIPPLED ] + +type gdkSubwindowMode = "GDK_" + [ `CLIP_BY_CHILDREN | `INCLUDE_INFERIORS ] + +type gdkLineStyle = "GDK_LINE_" + [ `SOLID | `ON_OFF_DASH | `DOUBLE_DASH ] + +type gdkCapStyle = "GDK_CAP_" + [ `NOT_LAST | `BUTT | `ROUND | `PROJECTING ] + +type gdkJoinStyle = "GDK_JOIN_" + [ `MITER | `ROUND | `BEVEL ] + +type gdkModifier = "GDK_" + [ `SHIFT | `LOCK | `CONTROL | `MOD1 | `MOD2 | `MOD3 | `MOD4 | `MOD5 + | `BUTTON1 | `BUTTON2 | `BUTTON3 | `BUTTON4 | `BUTTON5 ] "_MASK" + +type gdkImageType = "GDK_IMAGE_" + [ `NORMAL | `SHARED | `FASTEST ] + +type gdkVisualType = "GDK_VISUAL_" + [ `STATIC_GRAY | `GRAYSCALE | `STATIC_COLOR | `PSEUDO_COLOR + | `TRUE_COLOR | `DIRECT_COLOR ] + +type gdkFontType = "GDK_FONT_" + [ `FONT | `FONTSET ] + +type gdkDragAction = "GDK_ACTION_" + [ `DEFAULT | `COPY | `MOVE | `LINK | `PRIVATE | `ASK ] + +type gdkCursorType = "GDK_" [ + | `NUM_GLYPHS + | `X_CURSOR + | `ARROW + | `BASED_ARROW_DOWN + | `BASED_ARROW_UP + | `BOAT + | `BOGOSITY + | `BOTTOM_LEFT_CORNER + | `BOTTOM_RIGHT_CORNER + | `BOTTOM_SIDE + | `BOTTOM_TEE + | `BOX_SPIRAL + | `CENTER_PTR + | `CIRCLE + | `CLOCK + | `COFFEE_MUG + | `CROSS + | `CROSS_REVERSE + | `CROSSHAIR + | `DIAMOND_CROSS + | `DOT + | `DOTBOX + | `DOUBLE_ARROW + | `DRAFT_LARGE + | `DRAFT_SMALL + | `DRAPED_BOX + | `EXCHANGE + | `FLEUR + | `GOBBLER + | `GUMBY + | `HAND1 + | `HAND2 + | `HEART + | `ICON + | `IRON_CROSS + | `LEFT_PTR + | `LEFT_SIDE + | `LEFT_TEE + | `LEFTBUTTON + | `LL_ANGLE + | `LR_ANGLE + | `MAN + | `MIDDLEBUTTON + | `MOUSE + | `PENCIL + | `PIRATE + | `PLUS + | `QUESTION_ARROW + | `RIGHT_PTR + | `RIGHT_SIDE + | `RIGHT_TEE + | `RIGHTBUTTON + | `RTL_LOGO + | `SAILBOAT + | `SB_DOWN_ARROW + | `SB_H_DOUBLE_ARROW + | `SB_LEFT_ARROW + | `SB_RIGHT_ARROW + | `SB_UP_ARROW + | `SB_V_DOUBLE_ARROW + | `SHUTTLE + | `SIZING + | `SPIDER + | `SPRAYCAN + | `STAR + | `TARGET + | `TCROSS + | `TOP_LEFT_ARROW + | `TOP_LEFT_CORNER + | `TOP_RIGHT_CORNER + | `TOP_SIDE + | `TOP_TEE + | `TREK + | `UL_ANGLE + | `UMBRELLA + | `UR_ANGLE + | `WATCH + | `XTERM + ] diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/glGtk.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/glGtk.ml new file mode 100644 index 000000000..c7020a4fd --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/glGtk.ml @@ -0,0 +1,86 @@ +(* $Id$ *) + +open Gaux +open Gtk + +type visual_options = [ + | `USE_GL + | `BUFFER_SIZE of int + | `LEVEL of int + | `RGBA + | `DOUBLEBUFFER + | `STEREO + | `AUX_BUFFERS of int + | `RED_SIZE of int + | `GREEN_SIZE of int + | `BLUE_SIZE of int + | `ALPHA_SIZE of int + | `DEPTH_SIZE of int + | `STENCIL_SIZE of int + | `ACCUM_GREEN_SIZE of int + | `ACCUM_ALPHA_SIZE of int +] + +type gl_area = [`widget|`drawing|`glarea] + +module Raw = struct + external create : + visual_options list -> share:[>`glarea] optobj -> gl_area obj + = "ml_gtk_gl_area_new" + + external swap_buffers : [>`glarea] obj -> unit + = "ml_gtk_gl_area_swapbuffers" + + external make_current : [>`glarea] obj -> bool + = "ml_gtk_gl_area_make_current" +end + +class area_signals obj = +object (connect) + inherit GObj.widget_signals obj + method display ~callback = + (new GObj.event_signals ~after obj)#expose ~callback: + begin fun ev -> + if GdkEvent.Expose.count ev = 0 then + if Raw.make_current obj then callback () + else prerr_endline "GlGtk-WARNING **: could not make current"; + true + end + method reshape ~callback = + (new GObj.event_signals ~after obj)#configure ~callback: + begin fun ev -> + if Raw.make_current obj then begin + callback ~width:(GdkEvent.Configure.width ev) + ~height:(GdkEvent.Configure.height ev) + end + else prerr_endline "GlGtk-WARNING **: could not make current"; + true + end + method realize ~callback = + let connect = new GObj.misc_signals ~after (GtkBase.Widget.coerce obj) in + connect#realize ~callback: + begin fun ev -> + if Raw.make_current obj then callback () + else prerr_endline "GlGtk-WARNING **: could not make current" + end +end + +class area obj = object (self) + inherit GObj.widget (obj : gl_area obj) + method as_area = obj + method event = new GObj.event_ops obj + method connect = new area_signals obj + method set_size = GtkMisc.DrawingArea.size obj + method swap_buffers () = Raw.swap_buffers obj + method make_current () = + if not (Raw.make_current obj) then + raise (Gl.GLerror "make_current") +end + +let area options ?share ?(width=0) ?(height=0) ?packing ?show () = + let share = + match share with Some (x : area) -> Some x#as_area | None -> None in + let w = Raw.create options ~share:(Gpointer.optboxed share) in + if width <> 0 || height <> 0 then GtkMisc.DrawingArea.size w ~width ~height; + GtkBase.Widget.add_events w [`EXPOSURE]; + GObj.pack_return (new area w) ~packing ~show diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/glGtk.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/glGtk.mli new file mode 100644 index 000000000..599f24a09 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/glGtk.mli @@ -0,0 +1,63 @@ +(* $Id$ *) + +open Gtk +open GObj + +type visual_options = [ + `USE_GL + | `BUFFER_SIZE of int + | `LEVEL of int + | `RGBA + | `DOUBLEBUFFER + | `STEREO + | `AUX_BUFFERS of int + | `RED_SIZE of int + | `GREEN_SIZE of int + | `BLUE_SIZE of int + | `ALPHA_SIZE of int + | `DEPTH_SIZE of int + | `STENCIL_SIZE of int + | `ACCUM_GREEN_SIZE of int + | `ACCUM_ALPHA_SIZE of int +] +type gl_area = [`widget|`drawing|`glarea] + +module Raw : + sig + external create : + visual_options list -> share:[>`glarea] optobj -> gl_area obj + = "ml_gtk_gl_area_new" + external swap_buffers : [>`glarea] obj -> unit + = "ml_gtk_gl_area_swapbuffers" + external make_current : [>`glarea] obj -> bool + = "ml_gtk_gl_area_make_current" + end + +class area_signals : 'a obj -> + object + inherit widget_signals + constraint 'a = [>`glarea|`widget] + val obj : 'a obj + method display : callback:(unit -> unit) -> GtkSignal.id + method realize : callback:(unit -> unit) -> GtkSignal.id + method reshape : + callback:(width:int -> height:int -> unit) -> GtkSignal.id + end + +class area : gl_area obj -> + object + inherit widget + val obj : gl_area obj + method event : event_ops + method as_area : gl_area obj + method connect : area_signals + method make_current : unit -> unit + method set_size : width:int -> height:int -> unit + method swap_buffers : unit -> unit + end + +val area : + visual_options list -> + ?share:area -> + ?width:int -> + ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> area diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/glib.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/glib.ml new file mode 100644 index 000000000..2fd014099 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/glib.ml @@ -0,0 +1,21 @@ +(* $Id$ *) + +type warning_func = string -> unit + +external set_warning_handler : (string -> unit) -> warning_func + = "ml_g_set_warning_handler" + +type print_func = string -> unit + +external set_print_handler : (string -> unit) -> print_func + = "ml_g_set_print_handler" + +module Main = struct + type t + external create : bool -> t = "ml_g_main_new" + external iteration : bool -> bool = "ml_g_main_iteration" + external pending : unit -> bool = "ml_g_main_pending" + external is_running : t -> bool = "ml_g_main_is_running" + external quit : t -> unit = "ml_g_main_quit" + external destroy : t -> unit = "ml_g_main_destroy" +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gpointer.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gpointer.ml new file mode 100644 index 000000000..7d28a1f9d --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gpointer.ml @@ -0,0 +1,41 @@ +(* $Id$ *) + +(* marked pointers *) +type 'a optaddr + +let optaddr : 'a option -> 'a optaddr = + function + None -> Obj.magic 0 + | Some x -> Obj.magic x + +(* naked pointers *) +type optstring + +external get_null : unit -> optstring = "ml_get_null" +let raw_null = get_null () + +let optstring : string option -> optstring = + function + None -> raw_null + | Some x -> Obj.magic x + +(* boxed pointers *) +type boxed +let boxed_null : boxed = Obj.magic (0, raw_null) + +type 'a optboxed + +let optboxed : 'a option -> 'a optboxed = + function + None -> Obj.magic boxed_null + | Some obj -> Obj.magic obj + +let may_box ~f obj : 'a optboxed = + match obj with + None -> Obj.magic boxed_null + | Some obj -> Obj.magic (f obj : 'a) + +(* Exceptions *) + +exception Null +let _ = Callback.register_exception "null_pointer" Null diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtk.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtk.ml new file mode 100644 index 000000000..0c7892e6f --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtk.ml @@ -0,0 +1,158 @@ +(* $Id$ *) + +exception Error of string +exception Warning of string +exception Cannot_cast of string * string +type 'a obj +type 'a optobj = 'a obj Gpointer.optboxed +type clampf = float + +module Tags = struct + type arrow_type = [ `UP|`DOWN|`LEFT|`RIGHT ] + type attach_options = [ `EXPAND|`SHRINK|`FILL ] + type direction_type = [ `TAB_FORWARD|`TAB_BACKWARD|`UP|`DOWN|`LEFT|`RIGHT ] + type justification = [ `LEFT|`RIGHT|`CENTER|`FILL ] + type match_type = [ `ALL|`ALL_TAIL|`HEAD|`TAIL|`EXACT|`LAST ] + type metric_type = [ `PIXELS|`INCHES|`CENTIMETERS ] + type orientation = [ `HORIZONTAL|`VERTICAL ] + type corner_type = [ `TOP_LEFT|`BOTTOM_LEFT|`TOP_RIGHT|`BOTTOM_RIGHT ] + type pack_type = [ `START|`END ] + type path_type = [ `WIDGET|`WIDGET_CLASS|`CLASS ] + type policy_type = [ `ALWAYS|`AUTOMATIC|`NEVER ] + type position = [ `LEFT|`RIGHT|`TOP|`BOTTOM ] + type preview_type = [ `COLOR|`GRAYSCALE ] + type relief_style = [ `NORMAL|`HALF|`NONE ] + type resize_mode = [ `PARENT|`QUEUE|`IMMEDIATE ] + type signal_run_type = [ `FIRST|`LAST|`BOTH|`NO_RECURSE|`ACTION|`NO_HOOKS ] + type scroll_type = + [ `NONE|`STEP_FORWARD|`STEP_BACKWARD|`PAGE_BACKWARD|`PAGE_FORWARD|`JUMP ] + type selection_mode = [ `SINGLE|`BROWSE|`MULTIPLE|`EXTENDED ] + type shadow_type = [ `NONE|`IN|`OUT|`ETCHED_IN|`ETCHED_OUT ] + type state_type = [ `NORMAL|`ACTIVE|`PRELIGHT|`SELECTED|`INSENSITIVE ] + type submenu_direction = [ `LEFT|`RIGHT ] + type submenu_placement = [ `TOP_BOTTOM|`LEFT_RIGHT ] + type toolbar_style = [ `ICONS|`TEXT|`BOTH ] + type trough_type = [ `NONE|`START|`END|`JUMP ] + type update_type = [ `CONTINUOUS|`DISCONTINUOUS|`DELAYED ] + type visibility = [ `NONE|`PARTIAL|`FULL ] + type window_position = [ `NONE|`CENTER|`MOUSE|`CENTER_ALWAYS ] + type window_type = [ `TOPLEVEL|`DIALOG|`POPUP ] + type sort_type = [ `ASCENDING|`DESCENDING ] + type fundamental_type = + [ `INVALID|`NONE|`CHAR|`BOOL|`INT|`UINT|`LONG|`ULONG|`FLOAT|`DOUBLE + |`STRING|`ENUM|`FLAGS|`BOXED|`FOREIGN|`CALLBACK|`ARGS|`POINTER + |`SIGNAL|`C_CALLBACK|`OBJECT ] + + type accel_flag = [ `VISIBLE|`SIGNAL_VISIBLE|`LOCKED ] + type button_box_style = [ `DEFAULT_STYLE|`SPREAD|`EDGE|`START|`END ] + type expand_type = [ `X|`Y|`BOTH|`NONE ] + type packer_options = [ `PACK_EXPAND|`FILL_X|`FILL_Y ] + type side_type = [ `TOP|`BOTTOM|`LEFT|`RIGHT ] + type anchor_type = [ `CENTER|`NORTH|`NW|`NE|`SOUTH|`SW|`SE|`WEST|`EAST ] + type update_policy = [ `ALWAYS|`IF_VALID|`SNAP_TO_TICKS ] + type cell_type = [ `EMPTY|`TEXT|`PIXMAP|`PIXTEXT|`WIDGET ] + type button_action = [ `SELECTS|`DRAGS|`EXPANDS ] + type calendar_display_options = + [ `SHOW_HEADING|`SHOW_DAY_NAMES|`NO_MONTH_CHANGE|`SHOW_WEEK_NUMBERS + |`WEEK_START_MONDAY ] + type spin_button_update_policy = [ `ALWAYS|`IF_VALID ] + type spin_type = + [ `STEP_FORWARD|`STEP_BACKWARD|`PAGE_FORWARD|`PAGE_BACKWARD + |`HOME|`END|`USER_DEFINED of float ] + type progress_bar_style = [ `CONTINUOUS|`DISCRETE ] + type progress_bar_orientation = + [ `LEFT_TO_RIGHT|`RIGHT_TO_LEFT|`BOTTOM_TO_TOP|`TOP_TO_BOTTOM ] + type dest_defaults = [ `MOTION|`HIGHLIGHT|`DROP|`ALL ] + type target_flags = [ `SAME_APP|`SAME_WIDGET ] + type font_metric_type = [ `PIXELS|`POINTS ] + type font_type = [ `BITMAP|`SCALABLE|`SCALABLE_BITMAP|`ALL ] + type font_filter_type = [ `BASE|`USER ] +end +open Tags + +type gtk_type +type gtk_class + +type accel_group + +type style +type 'a group = 'a obj option + +type statusbar_message +type statusbar_context + +type color = { red: float; green: float; blue: float; opacity: float } +type rectangle = { x: int; y: int; width: int; height: int } +type target_entry = { target: string; flags: target_flags list; info: int } + +type data = [`data] +type adjustment = [`data|`adjustment] +type tooltips = [`data|`tooltips] +type widget = [`widget] +type container = [`widget|`container] +type alignment = [`widget|`container|`bin|`alignment] +type event_box = [`widget|`container|`bin|`eventbox] +type frame = [`widget|`container|`bin|`frame] +type aspect_frame = [`widget|`container|`bin|`frame|`aspect] +type handle_box = [`widget|`container|`bin|`handlebox] +type invisible = [`widget|`container|`bin|`invisible] +type item = [`widget|`container|`bin|`item] +type list_item = [`widget|`container|`bin|`item|`listitem] +type menu_item = [`widget|`container|`bin|`item|`menuitem] +type check_menu_item = [`widget|`container|`bin|`item|`menuitem|`checkmenuitem] +type radio_menu_item = + [`widget|`container|`bin|`item|`menuitem|`checkmenuitem|`radiomenuitem] +type tree_item = [`widget|`container|`bin|`item|`treeitem] +type viewport = [`widget|`container|`bin|`viewport] +type window = [`widget|`container|`bin|`window] +type color_selection_dialog = [`widget|`container|`window|`colorseldialog] +type dialog = [`widget|`container|`bin|`window|`dialog] +type input_dialog = [`widget|`container|`bin|`window|`dialog|`inputdialog] +type file_selection = [`widget|`container|`bin|`window|`filesel] +type font_selection_dialog = [`widget|`container|`bin|`window|`fontseldialog] +type plug = [`widget|`container|`bin|`window|`plug] +type box = [`widget|`container|`box] +type button_box = [`widget|`container|`box|`bbox] +type gamma_curve = [`widget|`container|`bbox|`gamma] +type color_selection = [`widget|`container|`box|`colorsel] +type combo = [`widget|`container|`box|`combo] +type statusbar = [`widget|`container|`box|`statusbar] +type button = [`widget|`container|`button] +type toggle_button = [`widget|`container|`button|`toggle] +type radio_button = [`widget|`container|`button|`toggle|`radio] +type option_menu = [`widget|`container|`button|`optionmenu] +type clist = [`widget|`container|`clist] +type fixed = [`widget|`container|`fixed] +type layout = [`widget|`container|`layout] +type liste = [`widget|`container|`list] +type menu_shell = [`widget|`container|`menushell] +type menu = [`widget|`container|`menushell|`menu] +type menu_bar = [`widget|`container|`menushell|`menubar] +type notebook = [`widget|`container|`notebook] +type font_selection = [`widget|`container|`notebook|`fontsel] +type packer = [`widget|`container|`packer] +type paned = [`widget|`container|`paned] +type scrolled_window = [`widget|`container|`scrolled] +type socket = [`widget|`container|`socket] +type table = [`widget|`container|`table] +type toolbar = [`widget|`container|`toolbar] +type tree = [`widget|`container|`tree] +type calendar = [`widget|`calendar] +type drawing_area = [`widget|`drawing] +type editable = [`widget|`editable] +type entry = [`widget|`editable|`entry] +type spin_button = [`widget|`editable|`entry|`spinbutton] +type text = [`widget|`editable|`text] +type misc = [`widget|`misc] +type arrow = [`widget|`misc|`arrow] +type image = [`widget|`misc|`image] +type label = [`widget|`misc|`label] +type tips_query = [`widget|`misc|`label|`tipsquery] +type pixmap = [`widget|`misc|`pixmap] +type progress = [`widget|`progress] +type progress_bar = [`widget|`progress|`progressbar] +type range = [`widget|`range] +type scale = [`widget|`range|`scale] +type scrollbar = [`widget|`range|`scrollbar] +type ruler = [`widget|`ruler] +type separator = [`widget|`separator] diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkArgv.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkArgv.ml new file mode 100644 index 000000000..5e60c8d5e --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkArgv.ml @@ -0,0 +1,106 @@ +(* $Id$ *) + +open Gaux +open Gtk + +type data = + | NONE + | CHAR of char + | BOOL of bool + | INT of int + | FLOAT of float + | STRING of string option + | OBJECT of unit obj option + | POINTER of Gpointer.boxed option + +type 'a result = + [ `NONE + | `CHAR of char | `BOOL of bool | `INT of int + | `UINT of int32 | `LONG of nativeint | `ULONG of nativeint + | `FLOAT of float | `DOUBLE of float + | `STRING of string option | `ENUM of int | `FLAGS of int32 + | `BOXED of Gpointer.boxed option + | `POINTER of Gpointer.boxed option + | `OBJECT of 'a obj option ] + +module Arg = struct + type t + external shift : t -> pos:int -> t = "ml_gtk_arg_shift" + external get_type : t -> gtk_type = "ml_gtk_arg_get_type" + external get : t -> data = "ml_gtk_arg_get" + external set_retloc : t -> 'a result -> unit = "ml_gtk_arg_set_retloc" + external get_pointer : t -> Gpointer.boxed = "ml_gtk_arg_get_pointer" + external get_nativeint : t -> nativeint = "ml_gtk_arg_get_nativeint" + + (* Safely get an argument *) + (* + external get_char : t -> char = "ml_gtk_arg_get_char" + external get_bool : t -> bool = "ml_gtk_arg_get_bool" + external get_int : t -> int = "ml_gtk_arg_get_int" + external get_float : t -> float = "ml_gtk_arg_get_float" + external get_string : t -> string option = "ml_gtk_arg_get_string" + external get_object : t -> unit obj option = "ml_gtk_arg_get_object" + *) + (* Safely set a result + Beware: this is not the opposite of get, arguments and results + are two different ways to use GtkArg. *) + (* + external set_char : t -> char -> unit = "ml_gtk_arg_set_char" + external set_bool : t -> bool -> unit = "ml_gtk_arg_set_bool" + external set_int : t -> int -> unit = "ml_gtk_arg_set_int" + external set_nativeint : t -> nativeint -> unit = "ml_gtk_arg_set_nativeint" + external set_float : t -> float -> unit = "ml_gtk_arg_set_float" + external set_string : t -> string -> unit = "ml_gtk_arg_set_string" + external set_pointer : t -> Gpointer.boxed -> unit = "ml_gtk_arg_set_pointer" + external set_object : t -> 'a obj -> unit = "ml_gtk_arg_set_object" + *) +end + +open Arg +type raw_obj +type t = { referent: raw_obj; nargs: int; args: Arg.t } +let nth arg ~pos = + if pos < 0 || pos >= arg.nargs then invalid_arg "GtkArg.Vect.nth"; + shift arg.args ~pos +let result arg = + if arg.nargs < 0 then invalid_arg "GtkArgv.result"; + shift arg.args ~pos:arg.nargs +external wrap_object : raw_obj -> unit obj = "Val_GtkObject" +let referent arg = + if arg.referent == Obj.magic (-1) then invalid_arg "GtkArgv.referent"; + wrap_object arg.referent +let get_result_type arg = get_type (result arg) +let get_type arg ~pos = get_type (nth arg ~pos) +let get arg ~pos = get (nth arg ~pos) +let set_result arg = set_retloc (result arg) + +let get_args arg = + let rec loop args ~pos = + if pos < 0 then args + else loop (get arg ~pos :: args) ~pos:(pos-1) + in loop [] ~pos:(arg.nargs - 1) + +let get_pointer arg ~pos = get_pointer (nth arg ~pos) +let get_nativeint arg ~pos = get_nativeint (nth arg ~pos) + +(* +let get_char arg ~pos = get_char (nth arg ~pos) +let get_bool arg ~pos = get_bool (nth arg ~pos) +let get_int arg ~pos = get_int (nth arg ~pos) +let get_float arg ~pos = get_float (nth arg ~pos) +let get_string arg ~pos = get_string (nth arg ~pos) +let get_object arg ~pos = get_object (nth arg ~pos) +let set_result_char arg = set_char (result arg) +let set_result_bool arg = set_bool (result arg) +let set_result_int arg = set_int (result arg) +let set_result_nativeint arg = set_nativeint (result arg) +let set_result_float arg = set_float (result arg) +let set_result_string arg = set_string (result arg) +let set_result_pointer arg = set_pointer (result arg) +let set_result_object arg = set_object (result arg) +*) + +external string_at_pointer : ?pos:int -> ?len:int -> Gpointer.boxed -> string + = "ml_string_at_pointer" +external int_at_pointer : Gpointer.boxed -> int + = "ml_int_at_pointer" diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkBase.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkBase.ml new file mode 100644 index 000000000..3b1a00fdf --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkBase.ml @@ -0,0 +1,414 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags + +module Type = struct + external name : gtk_type -> string = "ml_gtk_type_name" + external from_name : string -> gtk_type = "ml_gtk_type_from_name" + external parent : gtk_type -> gtk_type = "ml_gtk_type_parent" + external get_class : gtk_type -> gtk_class = "ml_gtk_type_class" + external parent_class : gtk_type -> gtk_class = "ml_gtk_type_parent_class" + external is_a : gtk_type -> gtk_type -> bool = "ml_gtk_type_is_a" + external fundamental : gtk_type -> fundamental_type + = "ml_gtk_type_fundamental" +end + +module Object = struct + external get_type : 'a obj -> gtk_type = "ml_gtk_object_type" + let is_a obj name = + Type.is_a (get_type obj) (Type.from_name name) + external destroy : 'a obj -> unit = "ml_gtk_object_destroy" + external coerce : 'a obj -> unit obj = "%identity" + external unsafe_cast : 'a obj -> 'b obj = "%identity" + let try_cast w name = + if is_a w name then unsafe_cast w + else raise (Cannot_cast(Type.name(get_type w), name)) + let get_id (obj : 'a obj) : int = (snd (Obj.magic obj) lor 0) + module Signals = struct + open GtkSignal + let destroy : (_,_) t = + { name = "destroy"; marshaller = marshal_unit } + end +end + +module Widget = struct + let cast w : widget obj = Object.try_cast w "GtkWidget" + external coerce : [>`widget] obj -> widget obj = "%identity" + external unparent : [>`widget] obj -> unit = "ml_gtk_widget_unparent" + external show : [>`widget] obj -> unit = "ml_gtk_widget_show" + external show_now : [>`widget] obj -> unit = "ml_gtk_widget_show_now" + external show_all : [>`widget] obj -> unit = "ml_gtk_widget_show_all" + external hide : [>`widget] obj -> unit = "ml_gtk_widget_hide" + external hide_all : [>`widget] obj -> unit = "ml_gtk_widget_hide_all" + external map : [>`widget] obj -> unit = "ml_gtk_widget_map" + external unmap : [>`widget] obj -> unit = "ml_gtk_widget_unmap" + external realize : [>`widget] obj -> unit = "ml_gtk_widget_realize" + external unrealize : [>`widget] obj -> unit = "ml_gtk_widget_unrealize" + external queue_draw : [>`widget] obj -> unit = "ml_gtk_widget_queue_draw" + external queue_resize : [>`widget] obj -> unit = "ml_gtk_widget_queue_resize" + external draw : [>`widget] obj -> Gdk.Rectangle.t option -> unit + = "ml_gtk_widget_draw" + external draw_focus : [>`widget] obj -> unit + = "ml_gtk_widget_draw_focus" + external draw_default : [>`widget] obj -> unit + = "ml_gtk_widget_draw_default" + external event : [>`widget] obj -> 'a Gdk.event -> bool + = "ml_gtk_widget_event" + external activate : [>`widget] obj -> bool + = "ml_gtk_widget_activate" + external reparent : [>`widget] obj -> [>`widget] obj -> unit + = "ml_gtk_widget_reparent" + external popup : [>`widget] obj -> x:int -> y:int -> unit + = "ml_gtk_widget_popup" + external intersect : + [>`widget] obj -> Gdk.Rectangle.t -> Gdk.Rectangle.t option + = "ml_gtk_widget_intersect" + external set_can_default : [>`widget] obj -> bool -> unit + = "ml_gtk_widget_set_can_default" + external set_can_focus : [>`widget] obj -> bool -> unit + = "ml_gtk_widget_set_can_focus" + external grab_focus : [>`widget] obj -> unit + = "ml_gtk_widget_grab_focus" + external grab_default : [>`widget] obj -> unit + = "ml_gtk_widget_grab_default" + external set_name : [>`widget] obj -> string -> unit + = "ml_gtk_widget_set_name" + external get_name : [>`widget] obj -> string + = "ml_gtk_widget_get_name" + external set_state : [>`widget] obj -> state_type -> unit + = "ml_gtk_widget_set_state" + external set_sensitive : [>`widget] obj -> bool -> unit + = "ml_gtk_widget_set_sensitive" + external set_uposition : [>`widget] obj -> x:int -> y:int -> unit + = "ml_gtk_widget_set_uposition" + external set_usize : [>`widget] obj -> width:int -> height:int -> unit + = "ml_gtk_widget_set_usize" + external add_events : [>`widget] obj -> Gdk.Tags.event_mask list -> unit + = "ml_gtk_widget_add_events" + external set_events : [>`widget] obj -> Gdk.Tags.event_mask list -> unit + = "ml_gtk_widget_set_events" + external set_extension_events : + [>`widget] obj -> Gdk.Tags.extension_events -> unit + = "ml_gtk_widget_set_extension_events" + external get_toplevel : [>`widget] obj -> widget obj + = "ml_gtk_widget_get_toplevel" + external get_ancestor : [>`widget] obj -> gtk_type -> widget obj + = "ml_gtk_widget_get_ancestor" + external get_colormap : [>`widget] obj -> Gdk.colormap + = "ml_gtk_widget_get_colormap" + external get_visual : [>`widget] obj -> Gdk.visual + = "ml_gtk_widget_get_visual" + external get_pointer : [>`widget] obj -> int * int + = "ml_gtk_widget_get_pointer" + external is_ancestor : [>`widget] obj -> [>`widget] obj -> bool + = "ml_gtk_widget_is_ancestor" + external set_style : [>`widget] obj -> style -> unit + = "ml_gtk_widget_set_style" + external set_rc_style : [>`widget] obj -> unit + = "ml_gtk_widget_set_rc_style" + external ensure_style : [>`widget] obj -> unit + = "ml_gtk_widget_ensure_style" + external get_style : [>`widget] obj -> style + = "ml_gtk_widget_get_style" + external restore_default_style : [>`widget] obj -> unit + = "ml_gtk_widget_restore_default_style" + external add_accelerator : + ([>`widget] as 'a) obj -> sgn:('a,unit->unit) GtkSignal.t -> + accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> + ?flags:accel_flag list -> unit + = "ml_gtk_widget_add_accelerator_bc" "ml_gtk_widget_add_accelerator" + external remove_accelerator : + [>`widget] obj -> accel_group -> + key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> unit + = "ml_gtk_widget_remove_accelerator" + external lock_accelerators : [>`widget] obj -> unit + = "ml_gtk_widget_lock_accelerators" + external unlock_accelerators : [>`widget] obj -> unit + = "ml_gtk_widget_unlock_accelerators" + external accelerators_locked : [>`widget] obj -> bool + = "ml_gtk_widget_accelerators_locked" + external window : [>`widget] obj -> Gdk.window + = "ml_GtkWidget_window" + external visible : [>`widget] obj -> bool + = "ml_GTK_WIDGET_VISIBLE" + external has_focus : [>`widget] obj -> bool + = "ml_GTK_WIDGET_HAS_FOCUS" + external parent : [>`widget] obj -> widget obj + = "ml_gtk_widget_parent" + external set_app_paintable : [>`widget] obj -> bool -> unit + = "ml_gtk_widget_set_app_paintable" + external allocation : [>`widget] obj -> rectangle + = "ml_gtk_widget_allocation" + external set_colormap : [>`widget] obj -> Gdk.colormap -> unit + = "ml_gtk_widget_set_colormap" + external set_visual : [>`widget] obj -> Gdk.visual -> unit + = "ml_gtk_widget_set_visual" + external set_default_colormap : Gdk.colormap -> unit + = "ml_gtk_widget_set_default_colormap" + external set_default_visual : Gdk.visual -> unit + = "ml_gtk_widget_set_default_visual" + external get_default_colormap : unit -> Gdk.colormap + = "ml_gtk_widget_get_default_colormap" + external get_default_visual : unit -> Gdk.visual + = "ml_gtk_widget_get_default_visual" + external push_colormap : Gdk.colormap -> unit + = "ml_gtk_widget_push_colormap" + external push_visual : Gdk.visual -> unit + = "ml_gtk_widget_push_visual" + external pop_colormap : unit -> unit + = "ml_gtk_widget_pop_colormap" + external pop_visual : unit -> unit + = "ml_gtk_widget_pop_visual" + module Signals = struct + open GtkArgv + open GtkSignal + let marshal f _ = function + | OBJECT(Some p) :: _ -> f (cast p) + | _ -> invalid_arg "GtkBase.Widget.Signals.marshal" + let marshal_opt f _ = function + | OBJECT(Some obj) :: _ -> f (Some (cast obj)) + | OBJECT None :: _ -> f None + | _ -> invalid_arg "GtkBase.Widget.Signals.marshal_opt" + let marshal_style f _ = function + | POINTER p :: _ -> f (Obj.magic p : Gtk.style option) + | _ -> invalid_arg "GtkBase.Widget.Signals.marshal_opt" + let marshal_drag1 f _ = function + | POINTER(Some p) :: _ -> f (Obj.magic p : Gdk.drag_context) + | _ -> invalid_arg "GtkBase.Widget.Signals.marshal_drag1" + let marshal_drag2 f _ = function + | POINTER(Some p) :: INT time :: _ -> + f (Obj.magic p : Gdk.drag_context) ~time + | _ -> invalid_arg "GtkBase.Widget.Signals.marshal_drag2" + let marshal_drag3 f argv = function + | POINTER(Some p) :: INT x :: INT y :: INT time :: _ -> + let res = f (Obj.magic p : Gdk.drag_context) ~x ~y ~time + in GtkArgv.set_result argv (`BOOL res) + | _ -> invalid_arg "GtkBase.Widget.Signals.marshal_drag3" + let show : ([>`widget],_) t = + { name = "show"; marshaller = marshal_unit } + let hide : ([>`widget],_) t = + { name = "hide"; marshaller = marshal_unit } + let map : ([>`widget],_) t = + { name = "map"; marshaller = marshal_unit } + let unmap : ([>`widget],_) t = + { name = "unmap"; marshaller = marshal_unit } + let realize : ([>`widget],_) t = + { name = "realize"; marshaller = marshal_unit } + let draw : ([>`widget],_) t = + let marshal f _ = function + | POINTER(Some p) :: _ -> f (Obj.magic p : Gdk.Rectangle.t) + | _ -> invalid_arg "GtkBase.Widget.Signals.marshal_draw" + in { name = "draw"; marshaller = marshal } + let draw_focus : ([>`widget],_) t = + { name = "draw_focus"; marshaller = marshal_unit } + let draw_default : ([>`widget],_) t = + { name = "draw_default"; marshaller = marshal_unit } + external val_state : int -> state_type = "ml_Val_state_type" + let state_changed : ([>`widget],_) t = + let marshal f = marshal_int (fun x -> f (val_state x)) in + { name = "state_changed"; marshaller = marshal } + let parent_set : ([>`widget],_) t = + { name = "parent_set"; marshaller = marshal_opt } + let style_set : ([>`widget],_) t = + { name = "style_set"; marshaller = marshal_style } + let drag_begin : ([>`widget],_) t = + { name = "drag_begin"; marshaller = marshal_drag1 } + let drag_end : ([>`widget],_) t = + { name = "drag_end"; marshaller = marshal_drag1 } + let drag_data_delete : ([>`widget],_) t = + { name = "drag_data_delete"; marshaller = marshal_drag1 } + let drag_leave : ([>`widget],_) t = + { name = "drag_leave"; marshaller = marshal_drag2 } + let drag_motion : ([>`widget],_) t = + { name = "drag_motion"; marshaller = marshal_drag3 } + let drag_drop : ([>`widget],_) t = + { name = "drag_drop"; marshaller = marshal_drag3 } + let drag_data_get : ([>`widget],_) t = + let marshal f argv = function + | POINTER(Some p) :: POINTER(Some q) :: INT info :: INT time :: _ -> + f (Obj.magic p : Gdk.drag_context) + (Obj.magic q : GtkData.Selection.t) + ~info + ~time + | _ -> invalid_arg "GtkBase.Widget.Signals.marshal_drag_data_get" + in + { name = "drag_data_get"; marshaller = marshal } + let drag_data_received : ([>`widget],_) t = + let marshal f _ = function + | POINTER(Some p) :: INT x :: INT y :: POINTER(Some q) :: + INT info :: INT time :: _ -> + f (Obj.magic p : Gdk.drag_context) ~x ~y + (Obj.magic q : GtkData.Selection.t) + ~info ~time + | _ -> invalid_arg "GtkBase.Widget.Signals.marshal_drag_data_received" + in + { name = "drag_data_received"; marshaller = marshal } + + module Event = struct + let marshal f argv = function + | [POINTER(Some p)] -> + let ev = GdkEvent.unsafe_copy p in + GtkArgv.set_result argv (`BOOL(f ev)) + | _ -> invalid_arg "GtkBase.Widget.Event.marshal" + let any : ([>`widget], Gdk.Tags.event_type Gdk.event -> bool) t = + { name = "event"; marshaller = marshal } + let button_press : ([>`widget], GdkEvent.Button.t -> bool) t = + { name = "button_press_event"; marshaller = marshal } + let button_release : ([>`widget], GdkEvent.Button.t -> bool) t = + { name = "button_release_event"; marshaller = marshal } + let motion_notify : ([>`widget], GdkEvent.Motion.t -> bool) t = + { name = "motion_notify_event"; marshaller = marshal } + let delete : ([>`widget], [`DELETE] Gdk.event -> bool) t = + { name = "delete_event"; marshaller = marshal } + let destroy : ([>`widget], [`DESTROY] Gdk.event -> bool) t = + { name = "destroy_event"; marshaller = marshal } + let expose : ([>`widget], GdkEvent.Expose.t -> bool) t = + { name = "expose_event"; marshaller = marshal } + let key_press : ([>`widget], GdkEvent.Key.t -> bool) t = + { name = "key_press_event"; marshaller = marshal } + let key_release : ([>`widget], GdkEvent.Key.t -> bool) t = + { name = "key_release_event"; marshaller = marshal } + let enter_notify : ([>`widget], GdkEvent.Crossing.t -> bool) t = + { name = "enter_notify_event"; marshaller = marshal } + let leave_notify : ([>`widget], GdkEvent.Crossing.t -> bool) t = + { name = "leave_notify_event"; marshaller = marshal } + let configure : ([>`widget], GdkEvent.Configure.t -> bool) t = + { name = "configure_event"; marshaller = marshal } + let focus_in : ([>`widget], GdkEvent.Focus.t -> bool) t = + { name = "focus_in_event"; marshaller = marshal } + let focus_out : ([>`widget], GdkEvent.Focus.t -> bool) t = + { name = "focus_out_event"; marshaller = marshal } + let map : ([>`widget], [`MAP] Gdk.event -> bool) t = + { name = "map_event"; marshaller = marshal } + let unmap : ([>`widget], [`UNMAP] Gdk.event -> bool) t = + { name = "unmap_event"; marshaller = marshal } + let property_notify : ([>`widget], GdkEvent.Property.t -> bool) t = + { name = "property_notify_event"; marshaller = marshal } + let selection_clear : ([>`widget], GdkEvent.Selection.t -> bool) t = + { name = "selection_clear_event"; marshaller = marshal } + let selection_request : ([>`widget], GdkEvent.Selection.t -> bool) t = + { name = "selection_request_event"; marshaller = marshal } + let selection_notify : ([>`widget], GdkEvent.Selection.t -> bool) t = + { name = "selection_notify_event"; marshaller = marshal } + let proximity_in : ([>`widget], GdkEvent.Proximity.t -> bool) t = + { name = "proximity_in_event"; marshaller = marshal } + let proximity_out : ([>`widget], GdkEvent.Proximity.t -> bool) t = + { name = "proximity_out_event"; marshaller = marshal } + end + end +end + +module Container = struct + let cast w : container obj = Object.try_cast w "GtkContainer" + external coerce : [>`container] obj -> container obj = "%identity" + external set_border_width : [>`container] obj -> int -> unit + = "ml_gtk_container_set_border_width" + external set_resize_mode : [>`container] obj -> resize_mode -> unit + = "ml_gtk_container_set_resize_mode" + external add : [>`container] obj -> [>`widget] obj -> unit + = "ml_gtk_container_add" + external remove : [>`container] obj -> [>`widget] obj -> unit + = "ml_gtk_container_remove" + let set ?border_width ?(width = -2) ?(height = -2) w = + may border_width ~f:(set_border_width w); + if width <> -2 || height <> -2 then + Widget.set_usize w ?width ?height + external foreach : [>`container] obj -> f:(widget obj-> unit) -> unit + = "ml_gtk_container_foreach" + let children w = + let l = ref [] in + foreach w ~f:(fun c -> l := c :: !l); + List.rev !l + external focus : [>`container] obj -> direction_type -> bool + = "ml_gtk_container_focus" + (* Called by Widget.grab_focus *) + external set_focus_child : [>`container] obj -> [>`widget] optobj -> unit + = "ml_gtk_container_set_focus_child" + external set_focus_vadjustment : + [>`container] obj -> [>`adjustment] optobj -> unit + = "ml_gtk_container_set_focus_vadjustment" + external set_focus_hadjustment : + [>`container] obj -> [>`adjustment] optobj -> unit + = "ml_gtk_container_set_focus_hadjustment" + module Signals = struct + open GtkSignal + let add : ([>`container],_) t = + { name = "add"; marshaller = Widget.Signals.marshal } + let remove : ([>`container],_) t = + { name = "remove"; marshaller = Widget.Signals.marshal } + let need_resize : ([>`container],_) t = + let marshal f argv _ = GtkArgv.set_result argv (`BOOL(f ())) in + { name = "need_resize"; marshaller = marshal } + external val_direction : int -> direction_type = "ml_Val_direction_type" + let focus : ([>`container],_) t = + let marshal f argv = function + | GtkArgv.INT dir :: _ -> + GtkArgv.set_result argv (`BOOL(f (val_direction dir))) + | _ -> invalid_arg "GtkBase.Container.Signals.marshal_focus" + in { name = "focus"; marshaller = marshal } + end +end + +module Item = struct + let cast w : item obj = Object.try_cast w "GtkItem" + external coerce : [>`item] obj -> item obj = "%identity" + external select : [>`item] obj -> unit = "ml_gtk_item_select" + external deselect : [>`item] obj -> unit = "ml_gtk_item_deselect" + external toggle : [>`item] obj -> unit = "ml_gtk_item_toggle" + module Signals = struct + open GtkSignal + let select : ([>`item],_) t = + { name = "select"; marshaller = marshal_unit } + let deselect : ([>`item],_) t = + { name = "deselect"; marshaller = marshal_unit } + let toggle : ([>`item],_) t = + { name = "toggle"; marshaller = marshal_unit } + end +end + + +module DnD = struct + external dest_set : + [>`widget] obj -> flags:dest_defaults list -> + targets:target_entry array -> actions:Gdk.Tags.drag_action list -> unit + = "ml_gtk_drag_dest_set" + external dest_unset : [>`widget] obj -> unit + = "ml_gtk_drag_dest_unset" + external finish : + Gdk.drag_context -> success:bool -> del:bool -> time:int -> unit + = "ml_gtk_drag_finish" + external get_data : + [>`widget] obj -> Gdk.drag_context -> target:Gdk.atom -> time:int -> unit + = "ml_gtk_drag_get_data" + external get_source_widget : Gdk.drag_context -> widget obj + = "ml_gtk_drag_get_source_widget" + external highlight : [>`widget] obj -> unit = "ml_gtk_drag_highlight" + external unhighlight : [>`widget] obj -> unit = "ml_gtk_drag_unhighlight" + external set_icon_widget : + Gdk.drag_context -> [>`widget] obj -> hot_x:int -> hot_y:int -> unit + = "ml_gtk_drag_set_icon_widget" + external set_icon_pixmap : + Gdk.drag_context -> colormap:Gdk.colormap -> + Gdk.pixmap -> ?mask:Gdk.bitmap -> hot_x:int -> hot_y:int -> unit + = "ml_gtk_drag_set_icon_pixmap_bc" "ml_gtk_drag_set_icon_pixmap" + external set_icon_default : Gdk.drag_context -> unit + = "ml_gtk_drag_set_icon_default" + external set_default_icon : + colormap:Gdk.colormap -> Gdk.pixmap -> + ?mask:Gdk.bitmap -> hot_x:int -> hot_y:int -> unit + = "ml_gtk_drag_set_default_icon" + external source_set : + [>`widget] obj -> ?modi:Gdk.Tags.modifier list -> + targets:target_entry array -> actions:Gdk.Tags.drag_action list -> unit + = "ml_gtk_drag_source_set" + external source_set_icon : + [>`widget] obj -> colormap:Gdk.colormap -> + Gdk.pixmap -> ?mask:Gdk.bitmap -> unit + = "ml_gtk_drag_source_set_icon" + external source_unset : [>`widget] obj -> unit + = "ml_gtk_drag_source_unset" +(* external dest_handle_event : [>`widget] -> *) +end + diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkBin.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkBin.ml new file mode 100644 index 000000000..ab4cc7e85 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkBin.ml @@ -0,0 +1,170 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags +open GtkBase + +module Alignment = struct + let cast w : alignment obj = Object.try_cast w "GtkAlignment" + external create : + x:clampf -> y:clampf -> xscale:clampf -> yscale:clampf -> alignment obj + = "ml_gtk_alignment_new" + let create ?(x=0.5) ?(y=0.5) ?(xscale=1.) ?(yscale=1.) () = + create ~x ~y ~xscale ~yscale + external set : + ?x:clampf -> ?y:clampf -> ?xscale:clampf -> ?yscale:clampf -> + [>`alignment] obj -> unit + = "ml_gtk_alignment_set" +end + +module EventBox = struct + let cast w : event_box obj = Object.try_cast w "GtkEventBox" + external create : unit -> event_box obj = "ml_gtk_event_box_new" +end + +module Frame = struct + let cast w : frame obj = Object.try_cast w "GtkFrame" + external coerce : [>`frame] obj -> frame obj = "%identity" + external create : string -> frame obj = "ml_gtk_frame_new" + external set_label : [>`frame] obj -> string -> unit + = "ml_gtk_frame_set_label" + external set_label_align : [>`frame] obj -> x:clampf -> y:clampf -> unit + = "ml_gtk_frame_set_label_align" + external set_shadow_type : [>`frame] obj -> shadow_type -> unit + = "ml_gtk_frame_set_shadow_type" + external get_label_xalign : [>`frame] obj -> float + = "ml_gtk_frame_get_label_xalign" + external get_label_yalign : [>`frame] obj -> float + = "ml_gtk_frame_get_label_yalign" + let set_label_align' ?x ?y w = + set_label_align w + ~x:(may_default get_label_xalign w ~opt:x) + ~y:(may_default get_label_yalign w ~opt:y) + let set ?label ?label_xalign ?label_yalign ?shadow_type w = + may label ~f:(set_label w); + if label_xalign <> None || label_yalign <> None then + set_label_align' w ?x:label_xalign ?y:label_yalign; + may shadow_type ~f:(set_shadow_type w) +end + +module AspectFrame = struct + let cast w : aspect_frame obj = Object.try_cast w "GtkAspectFrame" + external create : + label:string -> xalign:clampf -> + yalign:clampf -> ratio:float -> obey_child:bool -> aspect_frame obj + = "ml_gtk_aspect_frame_new" + let create ?(label="") ?(xalign=0.5) ?(yalign=0.5) + ?(ratio=1.0) ?(obey_child=true) () = + create ~label ~xalign ~yalign ~ratio ~obey_child + external set : + [>`aspect] obj -> + xalign:clampf -> yalign:clampf -> ratio:float -> obey_child:bool -> unit + = "ml_gtk_aspect_frame_set" + external get_xalign : [>`aspect] obj -> clampf + = "ml_gtk_aspect_frame_get_xalign" + external get_yalign : [>`aspect] obj -> clampf + = "ml_gtk_aspect_frame_get_yalign" + external get_ratio : [>`aspect] obj -> clampf + = "ml_gtk_aspect_frame_get_ratio" + external get_obey_child : [>`aspect] obj -> bool + = "ml_gtk_aspect_frame_get_obey_child" + let set ?xalign ?yalign ?ratio ?obey_child w = + if xalign <> None || yalign <> None || ratio <> None || obey_child <> None + then set w + ~xalign:(may_default get_xalign w ~opt:xalign) + ~yalign:(may_default get_yalign w ~opt:yalign) + ~ratio:(may_default get_ratio w ~opt:ratio) + ~obey_child:(may_default get_obey_child w ~opt:obey_child) +end + +module HandleBox = struct + let cast w : handle_box obj = Object.try_cast w "GtkHandleBox" + external create : unit -> handle_box obj = "ml_gtk_handle_box_new" + external set_shadow_type : [>`handlebox] obj -> shadow_type -> unit = + "ml_gtk_handle_box_set_shadow_type" + external set_handle_position : [>`handlebox] obj -> position -> unit = + "ml_gtk_handle_box_set_handle_position" + external set_snap_edge : [>`handlebox] obj -> position -> unit = + "ml_gtk_handle_box_set_snap_edge" + module Signals = struct + open GtkSignal + let child_attached : ([>`handlebox],_) t = + { name = "child_attached"; marshaller = Widget.Signals.marshal } + let child_detached : ([>`handlebox],_) t = + { name = "child_detached"; marshaller = Widget.Signals.marshal } + end +end + +module Viewport = struct + let cast w : viewport obj = Object.try_cast w "GtkViewport" + external create : + [>`adjustment] optobj -> [>`adjustment] optobj -> viewport obj + = "ml_gtk_viewport_new" + let create ?hadjustment ?vadjustment () = + create (Gpointer.optboxed hadjustment) (Gpointer.optboxed vadjustment) + external get_hadjustment : [>`viewport] obj -> adjustment obj + = "ml_gtk_viewport_get_hadjustment" + external get_vadjustment : [>`viewport] obj -> adjustment obj + = "ml_gtk_viewport_get_vadjustment" + external set_hadjustment : [>`viewport] obj -> [>`adjustment] obj -> unit + = "ml_gtk_viewport_set_hadjustment" + external set_vadjustment : [>`viewport] obj -> [>`adjustment] obj -> unit + = "ml_gtk_viewport_set_vadjustment" + external set_shadow_type : [>`viewport] obj -> shadow_type -> unit + = "ml_gtk_viewport_set_shadow_type" + let set ?hadjustment ?vadjustment ?shadow_type w = + may hadjustment ~f:(set_hadjustment w); + may vadjustment ~f:(set_vadjustment w); + may shadow_type ~f:(set_shadow_type w) +end + +module ScrolledWindow = struct + let cast w : scrolled_window obj = Object.try_cast w "GtkScrolledWindow" + external create : + [>`adjustment] optobj -> [>`adjustment] optobj -> scrolled_window obj + = "ml_gtk_scrolled_window_new" + let create ?hadjustment ?vadjustment () = + create (Gpointer.optboxed hadjustment) (Gpointer.optboxed vadjustment) + external set_hadjustment : [>`scrolled] obj -> [>`adjustment] obj -> unit + = "ml_gtk_scrolled_window_set_hadjustment" + external set_vadjustment : [>`scrolled] obj -> [>`adjustment] obj -> unit + = "ml_gtk_scrolled_window_set_vadjustment" + external get_hadjustment : [>`scrolled] obj -> adjustment obj + = "ml_gtk_scrolled_window_get_hadjustment" + external get_vadjustment : [>`scrolled] obj -> adjustment obj + = "ml_gtk_scrolled_window_get_vadjustment" + external set_policy : [>`scrolled] obj -> policy_type -> policy_type -> unit + = "ml_gtk_scrolled_window_set_policy" + external add_with_viewport : [>`scrolled] obj -> [>`widget] obj -> unit + = "ml_gtk_scrolled_window_add_with_viewport" + external get_hscrollbar_policy : [>`scrolled] obj -> policy_type + = "ml_gtk_scrolled_window_get_hscrollbar_policy" + external get_vscrollbar_policy : [>`scrolled] obj -> policy_type + = "ml_gtk_scrolled_window_get_vscrollbar_policy" + external set_placement : [>`scrolled] obj -> corner_type -> unit + = "ml_gtk_scrolled_window_set_placement" + let set_policy' ?hpolicy ?vpolicy w = + set_policy w + (may_default get_hscrollbar_policy w ~opt:hpolicy) + (may_default get_vscrollbar_policy w ~opt:vpolicy) + let set ?hpolicy ?vpolicy ?placement w = + if hpolicy <> None || vpolicy <> None then + set_policy' w ?hpolicy ?vpolicy; + may placement ~f:(set_placement w) +end + +module Socket = struct + let cast w : socket obj = Object.try_cast w "GtkSocket" + external coerce : [>`socket] obj -> socket obj = "%identity" + external create : unit -> socket obj = "ml_gtk_socket_new" + external steal : [>`socket] obj -> Gdk.xid -> unit = "ml_gtk_socket_steal" +end + +(* +module Invisible = struct + let cast w : socket obj = Object.try_cast w "GtkInvisible" + external coerce : [>`invisible] obj -> invisible obj = "%identity" + external create : unit -> invisible obj = "ml_gtk_invisible_new" +end +*) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkButton.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkButton.ml new file mode 100644 index 000000000..6d9ddf500 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkButton.ml @@ -0,0 +1,148 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags +open GtkBase + +module Button = struct + let cast w : button obj = Object.try_cast w "GtkButton" + external coerce : [>`button] obj -> button obj = "%identity" + external create : unit -> button obj = "ml_gtk_button_new" + external create_with_label : string -> button obj + = "ml_gtk_button_new_with_label" + let create ?label () = + match label with None -> create () + | Some x -> create_with_label x + external pressed : [>`button] obj -> unit = "ml_gtk_button_pressed" + external released : [>`button] obj -> unit = "ml_gtk_button_released" + external clicked : [>`button] obj -> unit = "ml_gtk_button_clicked" + external enter : [>`button] obj -> unit = "ml_gtk_button_enter" + external leave : [>`button] obj -> unit = "ml_gtk_button_leave" + module Signals = struct + open GtkSignal + let pressed : ([>`button],_) t = + { name = "pressed"; marshaller = marshal_unit } + let released : ([>`button],_) t = + { name = "released"; marshaller = marshal_unit } + let clicked : ([>`button],_) t = + { name = "clicked"; marshaller = marshal_unit } + let enter : ([>`button],_) t = + { name = "enter"; marshaller = marshal_unit } + let leave : ([>`button],_) t = + { name = "leave"; marshaller = marshal_unit } + end +end + +module ToggleButton = struct + let cast w : toggle_button obj = Object.try_cast w "GtkToggleButton" + external coerce : [>`toggle] obj -> toggle_button obj = "%identity" + external toggle_button_create : unit -> toggle_button obj + = "ml_gtk_toggle_button_new" + external toggle_button_create_with_label : string -> toggle_button obj + = "ml_gtk_toggle_button_new_with_label" + external check_button_create : unit -> toggle_button obj + = "ml_gtk_check_button_new" + external check_button_create_with_label : string -> toggle_button obj + = "ml_gtk_check_button_new_with_label" + let create_toggle ?label () = + match label with None -> toggle_button_create () + | Some label -> toggle_button_create_with_label label + let create_check ?label () = + match label with None -> check_button_create () + | Some label -> check_button_create_with_label label + external set_mode : [>`toggle] obj -> bool -> unit + = "ml_gtk_toggle_button_set_mode" + external set_active : [>`toggle] obj -> bool -> unit + = "ml_gtk_toggle_button_set_active" + let set ?active ?draw_indicator w = + may ~f:(set_mode w) draw_indicator; + may ~f:(set_active w) active + external get_active : [>`toggle] obj -> bool + = "ml_gtk_toggle_button_get_active" + external toggled : [>`toggle] obj -> unit + = "ml_gtk_toggle_button_toggled" + module Signals = struct + open GtkSignal + let toggled : ([>`toggle],_) t = + { name = "toggled"; marshaller = marshal_unit } + end +end + +module RadioButton = struct + let cast w : radio_button obj = Object.try_cast w "GtkRadioButton" + external create : radio_button group -> radio_button obj + = "ml_gtk_radio_button_new" + external create_with_label : radio_button group -> string -> radio_button obj + = "ml_gtk_radio_button_new_with_label" + external set_group : [>`radio] obj -> radio_button group -> unit + = "ml_gtk_radio_button_set_group" + let create ?(group = None) ?label () = + match label with None -> create group + | Some label -> create_with_label group label +end + +module Toolbar = struct + let cast w : toolbar obj = Object.try_cast w "GtkToolbar" + external create : orientation -> style:toolbar_style -> toolbar obj + = "ml_gtk_toolbar_new" + let create dir ?(style=`BOTH) () = create dir ~style + external insert_space : [>`toolbar] obj -> pos:int -> unit + = "ml_gtk_toolbar_insert_space" + let insert_space w ?(pos = -1) () = insert_space w ~pos + external insert_button : + [>`toolbar] obj -> kind:[`BUTTON|`TOGGLEBUTTON|`RADIOBUTTON] -> + text:string -> tooltip:string -> + tooltip_private:string -> + icon:[>`widget] optobj -> pos:int -> button obj + = "ml_gtk_toolbar_insert_element_bc" "ml_gtk_toolbar_insert_element" + let insert_button w ?(kind=`BUTTON) ?(text="") ?(tooltip="") + ?(tooltip_private="") ?icon ?(pos = -1) ?callback () = + let b =insert_button w ~kind ~text ~tooltip ~tooltip_private ~pos + ~icon:(Gpointer.optboxed icon) + in + match callback with + | None -> b + | Some c -> GtkSignal.connect b ~sgn:Button.Signals.clicked + ~callback: c; b + external insert_widget : + [>`toolbar] obj -> [>`widget] obj -> + tooltip:string -> tooltip_private:string -> pos:int -> unit + = "ml_gtk_toolbar_insert_widget" + let insert_widget w ?(tooltip="") ?(tooltip_private="") ?(pos = -1) w' = + insert_widget w w' ~tooltip ~tooltip_private ~pos + external set_orientation : [>`toolbar] obj -> orientation -> unit = + "ml_gtk_toolbar_set_orientation" + external set_style : [>`toolbar] obj -> toolbar_style -> unit = + "ml_gtk_toolbar_set_style" + external set_space_size : [>`toolbar] obj -> int -> unit = + "ml_gtk_toolbar_set_space_size" + external set_space_style : [>`toolbar] obj -> [ `EMPTY|`LINE ] -> unit = + "ml_gtk_toolbar_set_space_style" + external set_tooltips : [>`toolbar] obj -> bool -> unit = + "ml_gtk_toolbar_set_tooltips" + external set_button_relief : [>`toolbar] obj -> relief_style -> unit = + "ml_gtk_toolbar_set_button_relief" + external get_button_relief : [>`toolbar] obj -> relief_style = + "ml_gtk_toolbar_get_button_relief" + let set ?orientation ?style ?space_size + ?space_style ?tooltips ?button_relief w = + may orientation ~f:(set_orientation w); + may style ~f:(set_style w); + may space_size ~f:(set_space_size w); + may space_style ~f:(set_space_style w); + may tooltips ~f:(set_tooltips w); + may button_relief ~f:(set_button_relief w) + module Signals = struct + open GtkSignal + external val_orientation : int -> orientation = "ml_Val_orientation" + external val_toolbar_style : int -> toolbar_style + = "ml_Val_toolbar_style" + let orientation_changed : ([>`toolbar],_) t = + let marshal f = marshal_int (fun x -> f (val_orientation x)) in + { name = "orientation_changed"; marshaller = marshal } + let style_changed : ([>`toolbar],_) t = + let marshal f = marshal_int (fun x -> f (val_toolbar_style x)) in + { name = "style_changed"; marshaller = marshal } + end +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkData.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkData.ml new file mode 100644 index 000000000..5b7f90ec0 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkData.ml @@ -0,0 +1,148 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags + +module AccelGroup = struct + external create : unit -> accel_group = "ml_gtk_accel_group_new" + external activate : + accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool + = "ml_gtk_accel_group_activate" + external groups_activate : + 'a obj -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool + = "ml_gtk_accel_groups_activate" + external attach : accel_group -> 'a obj -> unit + = "ml_gtk_accel_group_attach" + external detach : accel_group -> 'a obj -> unit + = "ml_gtk_accel_group_detach" + external lock : accel_group -> unit + = "ml_gtk_accel_group_lock" + external unlock : accel_group -> unit + = "ml_gtk_accel_group_unlock" + external lock_entry : + accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool + = "ml_gtk_accel_group_lock_entry" + external add : + accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> + ?flags:accel_flag list -> + call:'a obj -> sgn:('a,unit->unit) GtkSignal.t -> unit + = "ml_gtk_accel_group_add_bc" "ml_gtk_accel_group_add" + external remove : + accel_group -> + key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> call:'a obj -> unit + = "ml_gtk_accel_group_remove" + external valid : key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool + = "ml_gtk_accelerator_valid" + external set_default_mod_mask : Gdk.Tags.modifier list option -> unit + = "ml_gtk_accelerator_set_default_mod_mask" +end + +module Style = struct + external create : unit -> style = "ml_gtk_style_new" + external copy : style -> style = "ml_gtk_style_copy" + external attach : style -> Gdk.window -> style = "ml_gtk_style_attach" + external detach : style -> unit = "ml_gtk_style_detach" + external set_background : style -> Gdk.window -> state_type -> unit + = "ml_gtk_style_set_background" + external draw_hline : + style -> Gdk.window -> state_type -> x:int -> x:int -> y:int -> unit + = "ml_gtk_draw_hline_bc" "ml_gtk_draw_hline" + external draw_vline : + style -> Gdk.window -> state_type -> y:int -> y:int -> x:int -> unit + = "ml_gtk_draw_vline_bc" "ml_gtk_draw_vline" + external get_bg : style -> state:state_type -> Gdk.Color.t + = "ml_gtk_style_get_bg" + external set_bg : style -> state:state_type -> color:Gdk.Color.t -> unit + = "ml_gtk_style_set_bg" + external get_dark_gc : style -> state:state_type -> Gdk.gc + = "ml_gtk_style_get_dark_gc" + external get_light_gc : style -> state:state_type -> Gdk.gc + = "ml_gtk_style_get_light_gc" + external get_colormap : style -> Gdk.colormap = "ml_gtk_style_get_colormap" + external get_font : style -> Gdk.font = "ml_gtk_style_get_font" + external set_font : style -> Gdk.font -> unit = "ml_gtk_style_set_font" +(* + let set st ?:background ?:font = + let may_set f = may fun:(f st) in + may_set set_background background; + may_set set_font font +*) +end + +module Data = struct + module Signals = struct + open GtkSignal + let disconnect : ([>`data],_) t = + { name = "disconnect"; marshaller = marshal_unit } + end +end + +module Adjustment = struct + external create : + value:float -> lower:float -> upper:float -> + step_incr:float -> page_incr:float -> page_size:float -> adjustment obj + = "ml_gtk_adjustment_new_bc" "ml_gtk_adjustment_new" + external set_value : [>`adjustment] obj -> float -> unit + = "ml_gtk_adjustment_set_value" + external clamp_page : + [>`adjustment] obj -> lower:float -> upper:float -> unit + = "ml_gtk_adjustment_clamp_page" + external get_lower : [>`adjustment] obj -> float + = "ml_gtk_adjustment_get_lower" + external get_upper : [>`adjustment] obj -> float + = "ml_gtk_adjustment_get_upper" + external get_value : [>`adjustment] obj -> float + = "ml_gtk_adjustment_get_value" + external get_step_increment : [>`adjustment] obj -> float + = "ml_gtk_adjustment_get_step_increment" + external get_page_increment : [>`adjustment] obj -> float + = "ml_gtk_adjustment_get_page_increment" + external get_page_size : [>`adjustment] obj -> float + = "ml_gtk_adjustment_get_page_size" + module Signals = struct + open GtkSignal + let changed : ([>`adjustment],_) t = + { name = "changed"; marshaller = marshal_unit } + let value_changed : ([>`adjustment],_) t = + { name = "value_changed"; marshaller = marshal_unit } + end +end + +module Tooltips = struct + external create : unit -> tooltips obj = "ml_gtk_tooltips_new" + external enable : [>`tooltips] obj -> unit = "ml_gtk_tooltips_enable" + external disable : [>`tooltips] obj -> unit = "ml_gtk_tooltips_disable" + external set_delay : [>`tooltips] obj -> int -> unit + = "ml_gtk_tooltips_set_delay" + external set_tip : + [>`tooltips] obj -> + [>`widget] obj -> ?text:string -> ?privat:string -> unit + = "ml_gtk_tooltips_set_tip" + external set_colors : + [>`tooltips] obj -> + ?foreground:Gdk.Color.t -> ?background:Gdk.Color.t -> unit -> unit + = "ml_gtk_tooltips_set_colors" + let set ?delay ?foreground ?background tt = + may ~f:(set_delay tt) delay; + if foreground <> None || background <> None then + set_colors tt ?foreground ?background () +end + + +module Selection = struct + type t + external selection : t -> Gdk.atom + = "ml_gtk_selection_data_selection" + external target : t -> Gdk.atom + = "ml_gtk_selection_data_target" + external seltype : t -> Gdk.atom + = "ml_gtk_selection_data_type" + external format : t -> int + = "ml_gtk_selection_data_format" + external get_data : t -> string + = "ml_gtk_selection_data_get_data" (* May raise Gpointer.null *) + external set : + t -> typ:Gdk.atom -> format:int -> ?data:string -> unit + = "ml_gtk_selection_data_set" +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkEdit.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkEdit.ml new file mode 100644 index 000000000..bef2fedb9 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkEdit.ml @@ -0,0 +1,223 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags +open GtkBase + +module Editable = struct + let cast w : editable obj = Object.try_cast w "GtkEditable" + external coerce : [>`editable] obj -> editable obj = "%identity" + external select_region : [>`editable] obj -> start:int -> stop:int -> unit + = "ml_gtk_editable_select_region" + external insert_text : [>`editable] obj -> string -> pos:int -> int + = "ml_gtk_editable_insert_text" + external delete_text : [>`editable] obj -> start:int -> stop:int -> unit + = "ml_gtk_editable_delete_text" + external get_chars : [>`editable] obj -> start:int -> stop:int -> string + = "ml_gtk_editable_get_chars" + external cut_clipboard : [>`editable] obj -> unit + = "ml_gtk_editable_cut_clipboard" + external copy_clipboard : [>`editable] obj -> unit + = "ml_gtk_editable_copy_clipboard" + external paste_clipboard : [>`editable] obj -> unit + = "ml_gtk_editable_paste_clipboard" + external claim_selection : + [>`editable] obj -> claim:bool -> time:int -> unit + = "ml_gtk_editable_claim_selection" + external delete_selection : [>`editable] obj -> unit + = "ml_gtk_editable_delete_selection" + external changed : [>`editable] obj -> unit = "ml_gtk_editable_changed" + external set_position : [>`editable] obj -> int -> unit + = "ml_gtk_editable_set_position" + external get_position : [>`editable] obj -> int + = "ml_gtk_editable_get_position" + external set_editable : [>`editable] obj -> bool -> unit + = "ml_gtk_editable_set_editable" + external selection_start_pos : [>`editable] obj -> int + = "ml_gtk_editable_selection_start_pos" + external selection_end_pos : [>`editable] obj -> int + = "ml_gtk_editable_selection_end_pos" + external has_selection : [>`editable] obj -> bool + = "ml_gtk_editable_has_selection" + module Signals = struct + open GtkArgv + open GtkSignal + let activate : ([>`editable],_) t = + { name = "activate"; marshaller = marshal_unit } + let changed : ([>`editable],_) t = + { name = "changed"; marshaller = marshal_unit } + let marshal_insert f argv = function + | STRING _ :: INT len :: POINTER(Some pos) :: _ -> + (* XXX These two accesses are implementation-dependent *) + let s = string_at_pointer (get_pointer argv ~pos:0) ~len + and pos = int_at_pointer pos in + f s ~pos + | _ -> invalid_arg "GtkEdit.Editable.Signals.marshal_insert" + let insert_text : ([>`editable],_) t = + { name = "insert_text"; marshaller = marshal_insert } + let marshal_delete f _ = function + | INT start :: INT stop :: _ -> + f ~start ~stop + | _ -> invalid_arg "GtkEdit.Editable.Signals.marshal_delete" + let delete_text : ([>`editable],_) t = + { name = "delete_text"; marshaller = marshal_delete } + end +end + +module Entry = struct + let cast w : entry obj = Object.try_cast w "GtkEntry" + external coerce : [>`entry] obj -> entry obj = "%identity" + external create : unit -> entry obj = "ml_gtk_entry_new" + external create_with_max_length : int -> entry obj + = "ml_gtk_entry_new_with_max_length" + let create ?max_length () = + match max_length with None -> create () + | Some len -> create_with_max_length len + external set_text : [>`entry] obj -> string -> unit + = "ml_gtk_entry_set_text" + external append_text : [>`entry] obj -> string -> unit + = "ml_gtk_entry_append_text" + external prepend_text : [>`entry] obj -> string -> unit + = "ml_gtk_entry_prepend_text" + external get_text : [>`entry] obj -> string = "ml_gtk_entry_get_text" + external set_visibility : [>`entry] obj -> bool -> unit + = "ml_gtk_entry_set_visibility" + external set_max_length : [>`entry] obj -> int -> unit + = "ml_gtk_entry_set_max_length" + let set ?text ?visibility ?max_length w = + let may_set f = may ~f:(f w) in + may_set set_text text; + may_set set_visibility visibility; + may_set set_max_length max_length + external text_length : [>`entry] obj -> int + = "ml_GtkEntry_text_length" +end + +module SpinButton = struct + let cast w : spin_button obj = Object.try_cast w "GtkSpinButton" + external create : + [>`adjustment] optobj -> rate:float -> digits:int -> spin_button obj + = "ml_gtk_spin_button_new" + let create ?adjustment ?(rate=0.5) ?(digits=0) () = + create (Gpointer.optboxed adjustment) ~rate ~digits + external configure : + [>`spinbutton] obj -> adjustment:[>`adjustment] obj -> + rate:float -> digits:int -> unit + = "ml_gtk_spin_button_configure" + external set_adjustment : [>`spinbutton] obj -> [>`adjustment] obj -> unit + = "ml_gtk_spin_button_set_adjustment" + external get_adjustment : [>`spinbutton] obj -> adjustment obj + = "ml_gtk_spin_button_get_adjustment" + external set_digits : [>`spinbutton] obj -> int -> unit + = "ml_gtk_spin_button_set_digits" + external get_value : [>`spinbutton] obj -> float + = "ml_gtk_spin_button_get_value_as_float" + let get_value_as_int w = truncate (get_value w +. 0.5) + external set_value : [>`spinbutton] obj -> float -> unit + = "ml_gtk_spin_button_set_value" + external set_update_policy : + [>`spinbutton] obj -> [`ALWAYS|`IF_VALID] -> unit + = "ml_gtk_spin_button_set_update_policy" + external set_numeric : [>`spinbutton] obj -> bool -> unit + = "ml_gtk_spin_button_set_numeric" + external spin : [>`spinbutton] obj -> spin_type -> unit + = "ml_gtk_spin_button_spin" + external set_wrap : [>`spinbutton] obj -> bool -> unit + = "ml_gtk_spin_button_set_wrap" + external set_shadow_type : [>`spinbutton] obj -> shadow_type -> unit + = "ml_gtk_spin_button_set_shadow_type" + external set_snap_to_ticks : [>`spinbutton] obj -> bool -> unit + = "ml_gtk_spin_button_set_snap_to_ticks" + external update : [>`spinbutton] obj -> unit + = "ml_gtk_spin_button_update" + let set ?adjustment ?digits ?value ?update_policy + ?numeric ?wrap ?shadow_type ?snap_to_ticks w = + let may_set f = may ~f:(f w) in + may_set set_adjustment adjustment; + may_set set_digits digits; + may_set set_value value; + may_set set_update_policy update_policy; + may_set set_numeric numeric; + may_set set_wrap wrap; + may_set set_shadow_type shadow_type; + may_set set_snap_to_ticks snap_to_ticks +end + +module Text = struct + let cast w : text obj = Object.try_cast w "GtkText" + external create : [>`adjustment] optobj -> [>`adjustment] optobj -> text obj + = "ml_gtk_text_new" + let create ?hadjustment ?vadjustment () = + create (Gpointer.optboxed hadjustment) (Gpointer.optboxed vadjustment) + external set_word_wrap : [>`text] obj -> bool -> unit + = "ml_gtk_text_set_word_wrap" + external set_line_wrap : [>`text] obj -> bool -> unit + = "ml_gtk_text_set_line_wrap" + external set_adjustment : + [>`text] obj -> ?horizontal:[>`adjustment] obj -> + ?vertical:[>`adjustment] obj -> unit -> unit + = "ml_gtk_text_set_adjustments" + external get_hadjustment : [>`text] obj -> adjustment obj + = "ml_gtk_text_get_hadj" + external get_vadjustment : [>`text] obj -> adjustment obj + = "ml_gtk_text_get_vadj" + external set_point : [>`text] obj -> int -> unit + = "ml_gtk_text_set_point" + external get_point : [>`text] obj -> int = "ml_gtk_text_get_point" + external get_length : [>`text] obj -> int = "ml_gtk_text_get_length" + external freeze : [>`text] obj -> unit = "ml_gtk_text_freeze" + external thaw : [>`text] obj -> unit = "ml_gtk_text_thaw" + external insert : + [>`text] obj -> ?font:Gdk.font -> ?foreground:Gdk.Color.t -> + ?background:Gdk.Color.t -> string -> unit + = "ml_gtk_text_insert" + let set ?hadjustment ?vadjustment ?word_wrap w = + if hadjustment <> None || vadjustment <> None then + set_adjustment w ?horizontal: hadjustment ?vertical: vadjustment (); + may word_wrap ~f:(set_word_wrap w) +end + +module Combo = struct + let cast w : combo obj = Object.try_cast w "GtkCombo" + external create : unit -> combo obj = "ml_gtk_combo_new" + external set_value_in_list : + [>`combo] obj -> ?required:bool -> ?ok_if_empty:bool -> unit -> unit + = "ml_gtk_combo_set_value_in_list" + external set_use_arrows : [>`combo] obj -> bool -> unit + = "ml_gtk_combo_set_use_arrows" + external set_use_arrows_always : [>`combo] obj -> bool -> unit + = "ml_gtk_combo_set_use_arrows_always" + external set_case_sensitive : [>`combo] obj -> bool -> unit + = "ml_gtk_combo_set_case_sensitive" + external set_item_string : [>`combo] obj -> [>`item] obj -> string -> unit + = "ml_gtk_combo_set_item_string" + external entry : [>`combo] obj -> entry obj= "ml_gtk_combo_entry" + external list : [>`combo] obj -> liste obj= "ml_gtk_combo_list" + let set_popdown_strings combo strings = + GtkList.Liste.clear_items (list combo) ~start:0 ~stop:(-1); + List.iter strings ~f: + begin fun s -> + let li = GtkList.ListItem.create_with_label s in + Widget.show li; + Container.add (list combo) li + end + let set_use_arrows' w (mode : [`NEVER|`DEFAULT|`ALWAYS]) = + let def,always = + match mode with + `NEVER -> false, false + | `DEFAULT -> true, false + | `ALWAYS -> true, true + in + set_use_arrows w def; + set_use_arrows_always w always + let set ?popdown_strings ?use_arrows + ?case_sensitive ?value_in_list ?ok_if_empty w = + may popdown_strings ~f:(set_popdown_strings w); + may use_arrows ~f:(set_use_arrows' w); + may case_sensitive ~f:(set_case_sensitive w); + if value_in_list <> None || ok_if_empty <> None then + set_value_in_list w ?required:value_in_list ?ok_if_empty () + external disable_activate : [>`combo] obj -> unit + = "ml_gtk_combo_disable_activate" +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkInit.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkInit.ml new file mode 100644 index 000000000..5ce40db5f --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkInit.ml @@ -0,0 +1,5 @@ +(* $Id$ *) + +(* Does the initialization for toplevels *) + +let locale = GtkMain.Main.init () diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkList.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkList.ml new file mode 100644 index 000000000..4d2ae0951 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkList.ml @@ -0,0 +1,294 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags +open GtkBase + +module ListItem = struct + let cast w : list_item obj = Object.try_cast w "GtkListItem" + external create : unit -> list_item obj = "ml_gtk_list_item_new" + external create_with_label : string -> list_item obj + = "ml_gtk_list_item_new_with_label" + let create ?label () = + match label with None -> create () + | Some label -> create_with_label label +end + +module Liste = struct + let cast w : liste obj = Object.try_cast w "GtkList" + external create : unit -> liste obj = "ml_gtk_list_new" + external insert_item : + [>`list] obj -> [>`listitem] obj -> pos:int -> unit + = "ml_gtk_list_insert_item" + let insert_items l wl ~pos = + let wl = if pos < 0 then wl else List.rev wl in + List.iter wl ~f:(insert_item l ~pos) + let append_items l = insert_items l ~pos:(-1) + let prepend_items l = insert_items l ~pos:0 + external clear_items : [>`list] obj -> start:int -> stop:int -> unit = + "ml_gtk_list_clear_items" + external select_item : [>`list] obj -> pos:int -> unit + = "ml_gtk_list_select_item" + external unselect_item : [>`list] obj -> pos:int -> unit + = "ml_gtk_list_unselect_item" + external select_child : [>`list] obj -> [>`listitem] obj -> unit + = "ml_gtk_list_select_child" + external unselect_child : [>`list] obj -> [>`listitem] obj -> unit + = "ml_gtk_list_unselect_child" + external child_position : [>`list] obj -> [>`listitem] obj -> int + = "ml_gtk_list_child_position" + external set_selection_mode : [>`list] obj -> selection_mode -> unit + = "ml_gtk_list_set_selection_mode" + module Signals = struct + open GtkSignal + let selection_changed : ([>`list],_) t = + { name = "selection_changed"; marshaller = marshal_unit } + let select_child : ([>`list],_) t = + { name = "select_child"; marshaller = Widget.Signals.marshal } + let unselect_child : ([>`list],_) t = + { name = "unselect_child"; marshaller = Widget.Signals.marshal } + end +end + +module CList = struct + let cast w : clist obj = Object.try_cast w "GtkCList" + external create : cols:int -> clist obj = "ml_gtk_clist_new" + external create_with_titles : string array -> clist obj + = "ml_gtk_clist_new_with_titles" + external get_rows : [>`clist] obj -> int = "ml_gtk_clist_get_rows" + external get_columns : [>`clist] obj -> int = "ml_gtk_clist_get_columns" + external get_focus_row : [>`clist] obj -> int + = "ml_gtk_clist_get_focus_row" + external set_hadjustment : [>`clist] obj -> [>`adjustment] obj -> unit + = "ml_gtk_clist_set_hadjustment" + external set_vadjustment : [>`clist] obj -> [>`adjustment] obj -> unit + = "ml_gtk_clist_set_vadjustment" + external get_hadjustment : [>`clist] obj -> adjustment obj + = "ml_gtk_clist_get_hadjustment" + external get_vadjustment : [>`clist] obj -> adjustment obj + = "ml_gtk_clist_get_vadjustment" + external set_shadow_type : [>`clist] obj -> shadow_type -> unit + = "ml_gtk_clist_set_shadow_type" + external set_selection_mode : [>`clist] obj -> selection_mode -> unit + = "ml_gtk_clist_set_selection_mode" + external set_reorderable : [>`clist] obj -> bool -> unit + = "ml_gtk_clist_set_reorderable" + external set_use_drag_icons : [>`clist] obj -> bool -> unit + = "ml_gtk_clist_set_use_drag_icons" + external set_button_actions : + [>`clist] obj -> int -> button_action list -> unit + = "ml_gtk_clist_set_button_actions" + external freeze : [>`clist] obj -> unit = "ml_gtk_clist_freeze" + external thaw : [>`clist] obj -> unit = "ml_gtk_clist_thaw" + external column_titles_show : [>`clist] obj -> unit + = "ml_gtk_clist_column_titles_show" + external column_titles_hide : [>`clist] obj -> unit + = "ml_gtk_clist_column_titles_hide" + external column_title_active : [>`clist] obj -> int -> unit + = "ml_gtk_clist_column_title_active" + external column_title_passive : [>`clist] obj -> int -> unit + = "ml_gtk_clist_column_title_passive" + external column_titles_active : [>`clist] obj -> unit + = "ml_gtk_clist_column_titles_active" + external column_titles_passive : [>`clist] obj -> unit + = "ml_gtk_clist_column_titles_passive" + external set_column_title : [>`clist] obj -> int -> string -> unit + = "ml_gtk_clist_set_column_title" + external get_column_title : [>`clist] obj -> int -> string + = "ml_gtk_clist_get_column_title" + external set_column_widget : [>`clist] obj -> int -> [>`widget] obj -> unit + = "ml_gtk_clist_set_column_widget" + external get_column_widget : [>`clist] obj -> int -> widget obj + = "ml_gtk_clist_get_column_widget" + external set_column_justification : + [>`clist] obj -> int -> justification -> unit + = "ml_gtk_clist_set_column_justification" + external set_column_visibility : [>`clist] obj -> int -> bool -> unit + = "ml_gtk_clist_set_column_visibility" + external set_column_resizeable : [>`clist] obj -> int -> bool -> unit + = "ml_gtk_clist_set_column_resizeable" + external set_column_auto_resize : [>`clist] obj -> int -> bool -> unit + = "ml_gtk_clist_set_column_auto_resize" + external columns_autosize : [>`clist] obj -> unit + = "ml_gtk_clist_columns_autosize" + external optimal_column_width : [>`clist] obj -> int -> int + = "ml_gtk_clist_optimal_column_width" + external set_column_width : [>`clist] obj -> int -> int -> unit + = "ml_gtk_clist_set_column_width" + external set_column_min_width : [>`clist] obj -> int -> int -> unit + = "ml_gtk_clist_set_column_min_width" + external set_column_max_width : [>`clist] obj -> int -> int -> unit + = "ml_gtk_clist_set_column_max_width" + external set_row_height : [>`clist] obj -> int -> unit + = "ml_gtk_clist_set_row_height" + external moveto : + [>`clist] obj -> + int -> int -> row_align:clampf -> col_align:clampf -> unit + = "ml_gtk_clist_moveto" + external row_is_visible : [>`clist] obj -> int -> visibility + = "ml_gtk_clist_row_is_visible" + external get_cell_type : [>`clist] obj -> int -> int -> cell_type + = "ml_gtk_clist_get_cell_type" + external set_text : [>`clist] obj -> int -> int -> string -> unit + = "ml_gtk_clist_set_text" + external get_text : [>`clist] obj -> int -> int -> string + = "ml_gtk_clist_get_text" + external set_pixmap : + [>`clist] obj -> + int -> int -> Gdk.pixmap -> Gdk.bitmap Gpointer.optboxed -> unit + = "ml_gtk_clist_set_pixmap" + external get_pixmap : + [>`clist] obj -> int -> int -> Gdk.pixmap option * Gdk.bitmap option + = "ml_gtk_clist_get_pixmap" + external set_pixtext : + [>`clist] obj -> int -> int -> + string -> int -> Gdk.pixmap -> Gdk.bitmap Gpointer.optboxed -> unit + = "ml_gtk_clist_set_pixtext_bc" "ml_gtk_clist_set_pixtext" + external set_foreground : + [>`clist] obj -> row:int -> Gdk.Color.t Gpointer.optboxed -> unit + = "ml_gtk_clist_set_foreground" + external set_background : + [>`clist] obj -> row:int -> Gdk.Color.t Gpointer.optboxed -> unit + = "ml_gtk_clist_set_background" + external get_cell_style : [>`clist] obj -> int -> int -> Gtk.style + = "ml_gtk_clist_get_cell_style" + external set_cell_style : [>`clist] obj -> int -> int -> Gtk.style -> unit + = "ml_gtk_clist_set_cell_style" + external get_row_style : [>`clist] obj -> row:int -> Gtk.style + = "ml_gtk_clist_get_row_style" + external set_row_style : [>`clist] obj -> row:int -> Gtk.style -> unit + = "ml_gtk_clist_set_row_style" + external set_selectable : [>`clist] obj -> row:int -> bool -> unit + = "ml_gtk_clist_set_selectable" + external get_selectable : [>`clist] obj -> row:int -> bool + = "ml_gtk_clist_get_selectable" + external set_shift : + [>`clist] obj -> int -> int -> vertical:int -> horizontal:int -> unit + = "ml_gtk_clist_set_shift" + external insert : [>`clist] obj -> row:int -> Gpointer.optstring array -> int + = "ml_gtk_clist_insert" + let insert w ~row texts = + let len = get_columns w in + if List.length texts > len then invalid_arg "CList.insert"; + let arr = Array.create (get_columns w) None in + List.fold_left texts ~init:0 + ~f:(fun pos text -> arr.(pos) <- text; pos+1); + let r = insert w ~row (Array.map ~f:Gpointer.optstring arr) in + if r = -1 then invalid_arg "GtkCList::insert"; + r + external remove : [>`clist] obj -> row:int -> unit + = "ml_gtk_clist_remove" + external set_row_data : [>`clist] obj -> row:int -> Obj.t -> unit + = "ml_gtk_clist_set_row_data" + external get_row_data : [>`clist] obj -> row:int -> Obj.t + = "ml_gtk_clist_get_row_data" + external select : [>`clist] obj -> int -> int -> unit + = "ml_gtk_clist_select_row" + external unselect : [>`clist] obj -> int -> int -> unit + = "ml_gtk_clist_unselect_row" + external clear : [>`clist] obj -> unit = "ml_gtk_clist_clear" + external get_row_column : [>`clist] obj -> x:int -> y:int -> int * int + = "ml_gtk_clist_get_selection_info" + external select_all : [>`clist] obj -> unit = "ml_gtk_clist_select_all" + external unselect_all : [>`clist] obj -> unit = "ml_gtk_clist_unselect_all" + external swap_rows : [>`clist] obj -> int -> int -> unit + = "ml_gtk_clist_swap_rows" + external row_move : [>`clist] obj -> int -> dst:int -> unit + = "ml_gtk_clist_row_move" + external set_sort_column : [>`clist] obj -> int -> unit + = "ml_gtk_clist_set_sort_column" + external set_sort_type : [>`clist] obj -> sort_type -> unit + = "ml_gtk_clist_set_sort_type" + external sort : [>`clist] obj -> unit + = "ml_gtk_clist_sort" + external set_auto_sort : [>`clist] obj -> bool -> unit + = "ml_gtk_clist_set_auto_sort" + let set_titles_show w = function + true -> column_titles_show w + | false -> column_titles_hide w + let set_titles_active w = function + true -> column_titles_active w + | false -> column_titles_passive w + let set ?hadjustment ?vadjustment ?shadow_type + ?(button_actions=[]) ?selection_mode ?reorderable + ?use_drag_icons ?row_height ?titles_show ?titles_active w = + let may_set f param = may param ~f:(f w) in + may_set set_hadjustment hadjustment; + may_set set_vadjustment vadjustment; + may_set set_shadow_type shadow_type; + List.iter button_actions ~f:(fun (n,act) -> set_button_actions w n act); + may_set set_selection_mode selection_mode; + may_set set_reorderable reorderable; + may_set set_use_drag_icons use_drag_icons; + may_set set_row_height row_height; + may_set set_titles_show titles_show; + may_set set_titles_active titles_active + let set_sort w ?auto ?column ?dir:sort_type () = + may auto ~f:(set_auto_sort w); + may column ~f:(set_sort_column w); + may sort_type ~f:(set_sort_type w) + let set_cell w ?text ?pixmap ?mask ?(spacing=0) ?style row col = + begin match text, pixmap with + | Some text, None -> + set_text w row col text + | None, Some pm -> + set_pixmap w row col pm (Gpointer.optboxed mask) + | Some text, Some pm -> + set_pixtext w row col text spacing pm (Gpointer.optboxed mask) + | _ -> () + end; + may style ~f:(set_cell_style w row col) + let set_column w ?widget ?title ?title_active ?justification + ?visibility ?resizeable ?auto_resize ?width ?min_width ?max_width + col = + let may_set f param = may param ~f:(f w col) in + may_set set_column_widget widget; + may_set set_column_title title; + may title_active + ~f:(fun active -> if active then column_title_active w col + else column_title_passive w col); + may_set set_column_justification justification; + may_set set_column_visibility visibility; + may_set set_column_resizeable resizeable; + may_set set_column_auto_resize auto_resize; + may_set set_column_width width; + may_set set_column_min_width min_width; + may_set set_column_max_width max_width + let set_row w ?foreground ?background ?selectable ?style row = + let may_set f = may ~f:(f w ~row) in + may_set set_foreground foreground; + may_set set_background background; + may_set set_selectable selectable; + may_set set_row_style style + module Signals = struct + open GtkArgv + open GtkSignal + let marshal_select f argv = function + | INT row :: INT column :: POINTER p :: _ -> + let event : GdkEvent.Button.t option = + may_map ~f:GdkEvent.unsafe_copy p + in + f ~row ~column ~event + | _ -> invalid_arg "GtkList.CList.Signals.marshal_select" + let select_row : ([>`clist],_) t = + { name = "select_row"; marshaller = marshal_select } + let unselect_row : ([>`clist],_) t = + { name = "unselect_row"; marshaller = marshal_select } + let click_column : ([>`clist],_) t = + { name = "click_column"; marshaller = marshal_int } + external val_scroll_type : int -> scroll_type = "ml_Val_scroll_type" + let marshal_scroll f argv = function + | INT st :: FLOAT (pos : clampf) :: _ -> + f (val_scroll_type st) ~pos + | _ -> invalid_arg "GtkList.CList.Signals.marshal_scroll" + let scroll_horizontal : ([>`clist],_) t = + { name = "scroll_horizontal"; marshaller = marshal_scroll } + let scroll_vertical : ([>`clist],_) t = + { name = "scroll_vertical"; marshaller = marshal_scroll } + external emit_scroll : + 'a obj -> name:string -> Tags.scroll_type -> pos:clampf -> unit + = "ml_gtk_signal_emit_scroll" + let emit_scroll = emit ~emitter:emit_scroll + end +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkMain.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkMain.ml new file mode 100644 index 000000000..3c4561429 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkMain.ml @@ -0,0 +1,49 @@ +(* $Id$ *) + +open Gtk + +let _ = Callback.register_exception "gtkerror" (Error"") + +module Timeout = struct + type id + external add : ms:int -> callback:(GtkArgv.t -> unit) -> id + = "ml_gtk_timeout_add" + let add ~ms ~callback = + add ~ms ~callback:(fun arg -> GtkArgv.set_result arg (`BOOL(callback ()))) + external remove : id -> unit = "ml_gtk_timeout_remove" +end + +module Main = struct + external init : string array -> string array = "ml_gtk_init" + (* external exit : int -> unit = "ml_gtk_exit" *) + external set_locale : unit -> string = "ml_gtk_set_locale" + (* external main : unit -> unit = "ml_gtk_main" *) + let init () = + let locale = set_locale () in + let argv = init Sys.argv in + Array.blit ~src:argv ~dst:Sys.argv ~len:(Array.length argv) + ~src_pos:0 ~dst_pos:0; + Obj.truncate (Obj.repr Sys.argv) ~len:(Array.length argv); + locale + open Glib + let loops = ref [] + let main () = + let loop = (Main.create true) in + loops := loop :: !loops; + while Main.is_running loop do Main.iteration true done; + loops := List.tl !loops + and quit () = Main.quit (List.hd !loops) + external get_version : unit -> int * int * int = "ml_gtk_get_version" + let version = get_version () + + let flush = Gdk.X.flush +end + +module Grab = struct + external add : [>`widget] obj -> unit = "ml_gtk_grab_add" + external remove : [>`widget] obj -> unit = "ml_gtk_grab_remove" + external get_current : unit -> widget obj= "ml_gtk_grab_get_current" +end + +let _ = Glib.set_warning_handler (fun msg -> raise (Warning msg)) +let _ = Glib.set_print_handler (fun msg -> print_string msg) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkMenu.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkMenu.ml new file mode 100644 index 000000000..2f1eb30f0 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkMenu.ml @@ -0,0 +1,144 @@ +(* $Id$ *) + +open Gaux +open Gtk +open GtkBase + +module MenuItem = struct + let cast w : menu_item obj = Object.try_cast w "GtkMenuItem" + external coerce : [>`menuitem] obj -> menu_item obj = "%identity" + external create : unit -> menu_item obj = "ml_gtk_menu_item_new" + external create_with_label : string -> menu_item obj + = "ml_gtk_menu_item_new_with_label" + external tearoff_create : unit -> menu_item obj + = "ml_gtk_tearoff_menu_item_new" + let create ?label () = + match label with None -> create () + | Some label -> create_with_label label + external set_submenu : [>`menuitem] obj -> [>`menu] obj -> unit + = "ml_gtk_menu_item_set_submenu" + external remove_submenu : [>`menuitem] obj -> unit + = "ml_gtk_menu_item_remove_submenu" + external configure : + [>`menuitem] obj -> show_toggle:bool -> show_indicator:bool -> unit + = "ml_gtk_menu_item_configure" + external activate : [>`menuitem] obj -> unit + = "ml_gtk_menu_item_activate" + external right_justify : [>`menuitem] obj -> unit + = "ml_gtk_menu_item_right_justify" + module Signals = struct + open GtkSignal + let activate : ([>`menuitem],_) t = + { name = "activate"; marshaller = marshal_unit } + let activate_item : ([>`menuitem],_) t = + { name = "activate_item"; marshaller = marshal_unit } + end +end + +module CheckMenuItem = struct + let cast w : check_menu_item obj = Object.try_cast w "GtkCheckMenuItem" + external coerce : [>`checkmenuitem] obj -> check_menu_item obj = "%identity" + external create : unit -> check_menu_item obj = "ml_gtk_check_menu_item_new" + external create_with_label : string -> check_menu_item obj + = "ml_gtk_check_menu_item_new_with_label" + let create ?label () = + match label with None -> create () + | Some label -> create_with_label label + external set_active : [>`checkmenuitem] obj -> bool -> unit + = "ml_gtk_check_menu_item_set_active" + external get_active : [>`checkmenuitem] obj -> bool + = "ml_gtk_check_menu_item_get_active" + external set_show_toggle : [>`checkmenuitem] obj -> bool -> unit + = "ml_gtk_check_menu_item_set_show_toggle" + let set ?active ?show_toggle w = + may active ~f:(set_active w); + may show_toggle ~f:(set_show_toggle w) + external toggled : [>`checkmenuitem] obj -> unit + = "ml_gtk_check_menu_item_toggled" + module Signals = struct + open GtkSignal + let toggled : ([>`checkmenuitem],_) t = + { name = "toggled"; marshaller = marshal_unit } + end +end + +module RadioMenuItem = struct + let cast w : radio_menu_item obj = Object.try_cast w "GtkRadioMenuItem" + external create : radio_menu_item group -> radio_menu_item obj + = "ml_gtk_radio_menu_item_new" + external create_with_label : + radio_menu_item group -> string -> radio_menu_item obj + = "ml_gtk_radio_menu_item_new_with_label" + let create ?(group = None) ?label () = + match label with None -> create group + | Some label -> create_with_label group label + external set_group : [>`radiomenuitem] obj -> radio_menu_item group -> unit + = "ml_gtk_radio_menu_item_set_group" +end + +module OptionMenu = struct + let cast w : option_menu obj = Object.try_cast w "GtkOptionMenu" + external create : unit -> option_menu obj = "ml_gtk_option_menu_new" + external get_menu : [>`optionmenu] obj -> menu obj + = "ml_gtk_option_menu_get_menu" + external set_menu : [>`optionmenu] obj -> [>`menu] obj -> unit + = "ml_gtk_option_menu_set_menu" + external remove_menu : [>`optionmenu] obj -> unit + = "ml_gtk_option_menu_remove_menu" + external set_history : [>`optionmenu] obj -> int -> unit + = "ml_gtk_option_menu_set_history" + let set ?menu ?history w = + may menu ~f:(set_menu w); + may history ~f:(set_history w) +end + +module MenuShell = struct + let cast w : menu_shell obj = Object.try_cast w "GtkMenuShell" + external coerce : [>`menushell] obj -> menu_shell obj = "%identity" + external append : [>`menushell] obj -> [>`widget] obj -> unit + = "ml_gtk_menu_shell_append" + external prepend : [>`menushell] obj -> [>`widget] obj -> unit + = "ml_gtk_menu_shell_prepend" + external insert : [>`menushell] obj -> [>`widget] obj -> pos:int -> unit + = "ml_gtk_menu_shell_insert" + external deactivate : [>`menushell] obj -> unit + = "ml_gtk_menu_shell_deactivate" + module Signals = struct + open GtkSignal + let deactivate : ([>`menushell],_) t = + { name = "deactivate"; marshaller = marshal_unit } + end +end + +module Menu = struct + let cast w : menu obj = Object.try_cast w "GtkMenu" + external create : unit -> menu obj = "ml_gtk_menu_new" + external popup : + [>`menu] obj -> [>`menushell] optobj -> + [>`menuitem] optobj -> button:int -> time:int -> unit + = "ml_gtk_menu_popup" + let popup ?parent_menu ?parent_item w = + popup w (Gpointer.optboxed parent_menu) (Gpointer.optboxed parent_item) + external popdown : [>`menu] obj -> unit = "ml_gtk_menu_popdown" + external get_active : [>`menu] obj -> widget obj= "ml_gtk_menu_get_active" + external set_active : [>`menu] obj -> int -> unit = "ml_gtk_menu_set_active" + external set_accel_group : [>`menu] obj -> accel_group -> unit + = "ml_gtk_menu_set_accel_group" + external get_accel_group : [>`menu] obj -> accel_group + = "ml_gtk_menu_get_accel_group" + external ensure_uline_accel_group : [>`menu] obj -> accel_group + = "ml_gtk_menu_ensure_uline_accel_group" + external attach_to_widget : [>`menu] obj -> [>`widget] obj -> unit + = "ml_gtk_menu_attach_to_widget" + external get_attach_widget : [>`menu] obj -> widget obj + = "ml_gtk_menu_get_attach_widget" + external detach : [>`menu] obj -> unit = "ml_gtk_menu_detach" + let set ?active ?accel_group w = + may active ~f:(set_active w); + may accel_group ~f:(set_accel_group w) +end + +module MenuBar = struct + let cast w : menu_bar obj = Object.try_cast w "GtkMenuBar" + external create : unit -> menu_bar obj = "ml_gtk_menu_bar_new" +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkMisc.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkMisc.ml new file mode 100644 index 000000000..ded7f487a --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkMisc.ml @@ -0,0 +1,323 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags +open GtkBase + +module GammaCurve = struct + let cast w : gamma_curve obj = Object.try_cast w "GtkGammaCurve" + external create : unit -> gamma_curve obj = "ml_gtk_gamma_curve_new" + external get_gamma : [>`gamma] obj -> float = "ml_gtk_gamma_curve_get_gamma" +end + +module ColorSelection = struct + let cast w : color_selection obj = Object.try_cast w "GtkColorSelection" + external create : unit -> color_selection obj = "ml_gtk_color_selection_new" + external create_dialog : string -> color_selection_dialog obj + = "ml_gtk_color_selection_dialog_new" + external set_update_policy : [>`colorsel] obj -> update_type -> unit + = "ml_gtk_color_selection_set_update_policy" + external set_opacity : [>`colorsel] obj -> bool -> unit + = "ml_gtk_color_selection_set_opacity" + let set ?update_policy ?opacity w = + may update_policy ~f:(set_update_policy w); + may opacity ~f:(set_opacity w) + external set_color : + [>`colorsel] obj -> + red:float -> green:float -> blue:float -> ?opacity:float -> unit + = "ml_gtk_color_selection_set_color" + external get_color : [>`colorsel] obj -> color + = "ml_gtk_color_selection_get_color" + + external ok_button : [>`colorseldialog] obj -> button obj = + "ml_gtk_color_selection_dialog_ok_button" + external cancel_button : [>`colorseldialog] obj -> button obj = + "ml_gtk_color_selection_dialog_cancel_button" + external help_button : [>`colorseldialog] obj -> button obj = + "ml_gtk_color_selection_dialog_help_button" + external colorsel : [>`colorseldialog] obj -> color_selection obj = + "ml_gtk_color_selection_dialog_colorsel" + module Signals = struct + open GtkSignal + let color_changed : ([>`colorsel],_) t = + { name = "color_changed"; marshaller = marshal_unit } + end +end + +module Statusbar = struct + let cast w : statusbar obj = Object.try_cast w "GtkStatusbar" + external create : unit -> statusbar obj = "ml_gtk_statusbar_new" + external get_context : [>`statusbar] obj -> string -> statusbar_context + = "ml_gtk_statusbar_get_context_id" + external push : + [>`statusbar] obj -> + statusbar_context -> text:string -> statusbar_message + = "ml_gtk_statusbar_push" + external pop : [>`statusbar] obj -> statusbar_context -> unit + = "ml_gtk_statusbar_pop" + external remove : + [>`statusbar] obj -> statusbar_context -> statusbar_message -> unit + = "ml_gtk_statusbar_remove" + module Signals = struct + open GtkSignal + let text_pushed : ([>`statusbar],_) t = + let marshal f _ = function + | GtkArgv.INT ctx :: GtkArgv.STRING s :: _ -> + f (Obj.magic ctx : statusbar_context) s + | _ -> invalid_arg "GtkMisc.Statusbar.Signals.marshal_text" + in + { name = "text_pushed"; marshaller = marshal } + end +end + +module Calendar = struct + let cast w : calendar obj = Object.try_cast w "GtkCalendar" + external create : unit -> calendar obj = "ml_gtk_calendar_new" + external select_month : [>`calendar] obj -> month:int -> year:int -> unit + = "ml_gtk_calendar_select_month" + external select_day : [>`calendar] obj -> int -> unit + = "ml_gtk_calendar_select_day" + external mark_day : [>`calendar] obj -> int -> unit + = "ml_gtk_calendar_mark_day" + external unmark_day : [>`calendar] obj -> int -> unit + = "ml_gtk_calendar_unmark_day" + external clear_marks : [>`calendar] obj -> unit + = "ml_gtk_calendar_clear_marks" + external display_options : + [>`calendar] obj -> Tags.calendar_display_options list -> unit + = "ml_gtk_calendar_display_options" + external get_date : [>`calendar] obj -> int * int * int + = "ml_gtk_calendar_get_date" (* year * month * day *) + external freeze : [>`calendar] obj -> unit + = "ml_gtk_calendar_freeze" + external thaw : [>`calendar] obj -> unit + = "ml_gtk_calendar_thaw" + module Signals = struct + open GtkSignal + let month_changed : ([>`calendar],_) t = + { name = "month_changed"; marshaller = marshal_unit } + let day_selected : ([>`calendar],_) t = + { name = "day_selected"; marshaller = marshal_unit } + let day_selected_double_click : ([>`calendar],_) t = + { name = "day_selected_double_click"; marshaller = marshal_unit } + let prev_month : ([>`calendar],_) t = + { name = "prev_month"; marshaller = marshal_unit } + let next_month : ([>`calendar],_) t = + { name = "next_month"; marshaller = marshal_unit } + let prev_year : ([>`calendar],_) t = + { name = "prev_year"; marshaller = marshal_unit } + let next_year : ([>`calendar],_) t = + { name = "next_year"; marshaller = marshal_unit } + end +end + +module DrawingArea = struct + let cast w : drawing_area obj = Object.try_cast w "GtkDrawingArea" + external create : unit -> drawing_area obj = "ml_gtk_drawing_area_new" + external size : [>`drawing] obj -> width:int -> height:int -> unit + = "ml_gtk_drawing_area_size" +end + +(* Does not seem very useful ... +module Curve = struct + type t = [widget drawing curve] obj + let cast w : t = Object.try_cast w "GtkCurve" + external create : unit -> t = "ml_gtk_curve_new" + external reset : [>`curve] obj -> unit = "ml_gtk_curve_reset" + external set_gamma : [>`curve] obj -> float -> unit + = "ml_gtk_curve_set_gamma" + external set_range : + [>`curve] obj -> min_x:float -> max_x:float -> + min_y:float -> max_y:float -> unit + = "ml_gtk_curve_set_gamma" +end +*) + +module Misc = struct + let cast w : misc obj = Object.try_cast w "GtkMisc" + external coerce : [>`misc] obj -> misc obj = "%identity" + external set_alignment : [>`misc] obj -> x:float -> y:float -> unit + = "ml_gtk_misc_set_alignment" + external set_padding : [>`misc] obj -> x:int -> y:int -> unit + = "ml_gtk_misc_set_padding" + external get_xalign : [>`misc] obj -> float = "ml_gtk_misc_get_xalign" + external get_yalign : [>`misc] obj -> float = "ml_gtk_misc_get_yalign" + external get_xpad : [>`misc] obj -> int = "ml_gtk_misc_get_xpad" + external get_ypad : [>`misc] obj -> int = "ml_gtk_misc_get_ypad" + let set_alignment w ?x ?y () = + set_alignment w ~x:(may_default get_xalign w ~opt:x) + ~y:(may_default get_yalign w ~opt:y) + let set_padding w ?x ?y () = + set_padding w ~x:(may_default get_xpad w ~opt:x) + ~y:(may_default get_ypad w ~opt:y) + let set ?xalign ?yalign ?xpad ?ypad ?(width = -2) ?(height = -2) w = + if xalign <> None || yalign <> None then + set_alignment w ?x:xalign ?y:yalign (); + if xpad <> None || ypad <> None then + set_padding w ?x:xpad ?y:ypad (); + if width <> -2 || height <> -2 then Widget.set_usize w ~width ~height +end + +module Arrow = struct + let cast w : arrow obj = Object.try_cast w "GtkArrow" + external create : kind:arrow_type -> shadow:shadow_type -> arrow obj + = "ml_gtk_arrow_new" + external set : [>`arrow] obj -> kind:arrow_type -> shadow:shadow_type -> unit + = "ml_gtk_arrow_set" +end + +module Image = struct + let cast w : image obj = Object.try_cast w "GtkImage" + external create : Gdk.image -> ?mask:Gdk.bitmap -> image obj + = "ml_gtk_image_new" + let create ?mask img = create img ?mask + external set : [>`image] obj -> Gdk.image -> ?mask:Gdk.bitmap -> unit + = "ml_gtk_image_set" +end + +module Label = struct + let cast w : label obj = Object.try_cast w "GtkLabel" + external coerce : [>`label] obj -> label obj = "%identity" + external create : string -> label obj = "ml_gtk_label_new" + external set_text : [>`label] obj -> string -> unit = "ml_gtk_label_set_text" + external set_justify : [>`label] obj -> justification -> unit + = "ml_gtk_label_set_justify" + external set_pattern : [>`label] obj -> string -> unit + = "ml_gtk_label_set_pattern" + external set_line_wrap : [>`label] obj -> bool -> unit + = "ml_gtk_label_set_line_wrap" + let set ?text ?justify ?line_wrap ?pattern w = + may ~f:(set_text w) text; + may ~f:(set_justify w) justify; + may ~f:(set_line_wrap w) line_wrap; + may ~f:(set_pattern w) pattern + external get_text : [>`label] obj -> string = "ml_gtk_label_get_label" +end + +module TipsQuery = struct + let cast w : tips_query obj = Object.try_cast w "GtkTipsQuery" + external create : unit -> tips_query obj = "ml_gtk_tips_query_new" + external start : [>`tipsquery] obj -> unit = "ml_gtk_tips_query_start_query" + external stop : [>`tipsquery] obj -> unit = "ml_gtk_tips_query_stop_query" + external set_caller : [>`tipsquery] obj -> [>`widget] obj -> unit + = "ml_gtk_tips_query_set_caller" + external set_labels : + [>`tipsquery] obj -> inactive:string -> no_tip:string -> unit + = "ml_gtk_tips_query_set_labels" + external set_emit_always : [>`tipsquery] obj -> bool -> unit + = "ml_gtk_tips_query_set_emit_always" + external get_caller : [>`tipsquery] obj -> widget obj + = "ml_gtk_tips_query_get_caller" + external get_label_inactive : [>`tipsquery] obj -> string + = "ml_gtk_tips_query_get_label_inactive" + external get_label_no_tip : [>`tipsquery] obj -> string + = "ml_gtk_tips_query_get_label_no_tip" + external get_emit_always : [>`tipsquery] obj -> bool + = "ml_gtk_tips_query_get_emit_always" + let set_labels ?inactive ?no_tip w = + set_labels w + ~inactive:(may_default get_label_inactive w ~opt:inactive) + ~no_tip:(may_default get_label_no_tip w ~opt:no_tip) + let set ?caller ?emit_always ?label_inactive ?label_no_tip w = + may caller ~f:(set_caller w); + may emit_always ~f:(set_emit_always w); + if label_inactive <> None || label_no_tip <> None then + set_labels w ?inactive:label_inactive ?no_tip:label_no_tip + module Signals = struct + open GtkArgv + open GtkSignal + let start_query : ([>`tipsquery],_) t = + { name = "start_query"; marshaller = marshal_unit } + let stop_query : ([>`tipsquery],_) t = + { name = "stop_query"; marshaller = marshal_unit } + let widget_entered : + ([>`tipsquery], + widget obj option -> + text:string option -> privat:string option -> unit) t = + let marshal f _ = function + | OBJECT opt :: STRING text :: STRING privat :: _ -> + f (may_map ~f:Widget.cast opt) ~text ~privat + | _ -> invalid_arg "GtkMisc.TipsQuery.Signals.marshal_entered" + in + { name = "widget_entered"; marshaller = marshal } + let widget_selected : + ([>`tipsquery], + widget obj option -> + text:string option -> + privat:string option -> GdkEvent.Button.t option -> bool) t = + let marshal f argv = function + | OBJECT obj :: STRING text :: STRING privat :: POINTER p :: _ -> + let stop = + f (may_map ~f:Widget.cast obj) ~text ~privat + (may_map ~f:GdkEvent.unsafe_copy p) + in set_result argv (`BOOL stop) + | _ -> invalid_arg "GtkMisc.TipsQuery.Signals.marshal_selected" + in + { name = "widget_selected"; marshaller = marshal } + end +end + +module Pixmap = struct + let cast w : pixmap obj = Object.try_cast w "GtkPixmap" + external create : Gdk.pixmap -> ?mask:Gdk.bitmap -> pixmap obj + = "ml_gtk_pixmap_new" + let create ?mask img = create img ?mask + external set : + [>`pixmap] obj -> ?pixmap:Gdk.pixmap -> ?mask:Gdk.bitmap -> unit + = "ml_gtk_pixmap_set" + external pixmap : [>`pixmap] obj -> Gdk.pixmap = "ml_GtkPixmap_pixmap" + external mask : [>`pixmap] obj -> Gdk.bitmap = "ml_GtkPixmap_mask" +end + +module Separator = struct + let cast w : separator obj = Object.try_cast w "GtkSeparator" + external hseparator_new : unit -> separator obj = "ml_gtk_hseparator_new" + external vseparator_new : unit -> separator obj = "ml_gtk_vseparator_new" + let create (dir : Tags.orientation) = + if dir = `HORIZONTAL then hseparator_new () else vseparator_new () +end + +module FontSelection = struct + type null_terminated + let null_terminated arg : null_terminated = + match arg with None -> Obj.magic Gpointer.raw_null + | Some l -> + let len = List.length l in + let arr = Array.create (len + 1) "" in + let rec loop i = function + [] -> arr.(i) <- Obj.magic Gpointer.raw_null + | s::l -> arr.(i) <- s; loop (i+1) l + in loop 0 l; + Obj.magic (arr : string array) + let cast w : font_selection obj = + Object.try_cast w "GtkFontSelection" + external create : unit -> font_selection obj + = "ml_gtk_font_selection_new" + external get_font : [>`fontsel] obj -> Gdk.font + = "ml_gtk_font_selection_get_font" + let get_font w = + try Some (get_font w) with Gpointer.Null -> None + external get_font_name : [>`fontsel] obj -> string + = "ml_gtk_font_selection_get_font_name" + let get_font_name w = + try Some (get_font_name w) with Gpointer.Null -> None + external set_font_name : [>`fontsel] obj -> string -> unit + = "ml_gtk_font_selection_set_font_name" + external set_filter : + [>`fontsel] obj -> font_filter_type -> font_type list -> + null_terminated -> null_terminated -> null_terminated -> + null_terminated -> null_terminated -> null_terminated -> unit + = "ml_gtk_font_selection_set_filter_bc" + "ml_gtk_font_selection_set_filter" + let set_filter w ?kind:(tl=[`ALL]) ?foundry + ?weight ?slant ?setwidth ?spacing ?charset filter = + set_filter w filter tl (null_terminated foundry) + (null_terminated weight) (null_terminated slant) + (null_terminated setwidth) (null_terminated spacing) + (null_terminated charset) + external get_preview_text : [>`fontsel] obj -> string + = "ml_gtk_font_selection_get_preview_text" + external set_preview_text : [>`fontsel] obj -> string -> unit + = "ml_gtk_font_selection_set_preview_text" +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkNew.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkNew.ml new file mode 100644 index 000000000..532a709d7 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkNew.ml @@ -0,0 +1,56 @@ +(* $Id$ *) + +open Gtk + +type t + +(* if you modify this type modify widget_info_array + in ml_gtk.c in accordance *) +type object_type = + | OBJECT | WIDGET | MISC | LABEL | ACCELLABEL | TIPSQUERY | ARROW + | IMAGE | PIXMAP | CONTAINER | BIN | ALIGNMENT | FRAME | ASPECTFRAME + | BUTTON | TOGGLEBUTTON | CHECKBUTTON | RADIOBUTTON | OPTIONMENU + | ITEM | MENUITEM | CHECKMENUITEM | RADIOMENUITEM | TEAROFFMENUITEM + | LISTITEM | TREEITEM | WINDOW | COLORSELECTIONDIALOG | DIALOG + | INPUTDIALOG | FILESELECTION | FONTSELECTIONDIALOG | PLUG + | EVENTBOX | HANDLEBOX | SCROLLEDWINDOW | VIEWPORT | BOX + | BUTTONBOX | HBUTTONBOX | VBUTTONBOX | VBOX | COLORSELECTION + | GAMMACURVE | HBOX | COMBO | STATUSBAR | CLIST | CTREE | FIXED + | NOTEBOOK | FONTSELECTION | PANED | HPANED | VPANED | LAYOUT + | LIST | MENUSHELL | MENUBAR | MENU | PACKER | SOCKET | TABLE + | TOOLBAR | TREE | CALENDAR | DRAWINGAREA | CURVE | EDITABLE + | ENTRY | SPINBUTTON | TEXT | RULER | HRULER | VRULER | RANGE + | SCALE | HSCALE | VSCALE | SCROLLBAR | HSCROLLBAR | VSCROLLBAR + | SEPARATOR | HSEPARATOR | VSEPARATOR | PREVIEW | PROGRESS + | PROGRESSBAR | DATA | ADJUSTMENT | TOOLTIPS | ITEMFACTORY + +external set_ml_class_init : (t -> unit) -> unit = "set_ml_class_init" +external signal_new : string -> int -> t -> object_type -> int -> int + = "ml_gtk_signal_new" +external object_class_add_signals : t -> int array -> int -> unit + = "ml_gtk_object_class_add_signals" +external type_unique : + name:string -> parent:object_type -> nsignals:int -> gtk_type + = "ml_gtk_type_unique" +external type_new : gtk_type -> unit obj + = "ml_gtk_type_new" + +open GtkSignal + +let make_new_widget ~name ~parent + ~(signals : ('a, unit -> unit) GtkSignal.t list) = + let nsignals = List.length signals in + let new_type = type_unique ~name ~parent ~nsignals in + let signal_num_array = Array.create nsignals 0 in + let class_init_func classe = + List.fold_left signals ~init:0 ~f: + (fun i signal -> + signal_num_array.(i) <- signal_new signal.name 1 classe parent i; + i+1); + object_class_add_signals classe signal_num_array nsignals + in + new_type, + (fun () -> + set_ml_class_init class_init_func; + type_new new_type) + (* , signal_num_array *) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkPack.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkPack.ml new file mode 100644 index 000000000..20adb0505 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkPack.ml @@ -0,0 +1,318 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags +open GtkBase + +module Box = struct + let cast w : box obj = Object.try_cast w "GtkBox" + external coerce : [>`box] obj -> box obj = "%identity" + external pack_start : + [>`box] obj -> [>`widget] obj -> + expand:bool -> fill:bool -> padding:int -> unit + = "ml_gtk_box_pack_start" + external pack_end : + [>`box] obj -> [>`widget] obj -> + expand:bool -> fill:bool -> padding:int -> unit + = "ml_gtk_box_pack_end" + let pack box ?from:( dir = (`START : pack_type)) + ?(expand=false) ?(fill=true) ?(padding=0) child = + (match dir with `START -> pack_start | `END -> pack_end) + box child ~expand ~fill ~padding + external reorder_child : [>`box] obj -> [>`widget] obj -> pos:int -> unit + = "ml_gtk_box_reorder_child" + external set_homogeneous : [>`box] obj -> bool -> unit + = "ml_gtk_box_set_homogeneous" + external set_spacing : [>`box] obj -> int -> unit + = "ml_gtk_box_set_spacing" + let set ?homogeneous ?spacing w = + may homogeneous ~f:(set_homogeneous w); + may spacing ~f:(set_spacing w) + type packing = + { expand: bool; fill: bool; padding: int; pack_type: pack_type } + external query_child_packing : [>`box] obj -> [>`widget] obj -> packing + = "ml_gtk_box_query_child_packing" + external set_child_packing : + [>`box] obj -> [>`widget] obj -> + ?expand:bool -> ?fill:bool -> ?padding:int -> ?from:pack_type -> unit + = "ml_gtk_box_set_child_packing_bc" "ml_gtk_box_set_child_packing" + external hbox_new : homogeneous:bool -> spacing:int -> box obj + = "ml_gtk_hbox_new" + external vbox_new : homogeneous:bool -> spacing:int -> box obj + = "ml_gtk_vbox_new" + let create (dir : orientation) ?(homogeneous=false) ?(spacing=0) () = + (match dir with `HORIZONTAL -> hbox_new | `VERTICAL -> vbox_new) + ~homogeneous ~spacing +end + +module BBox = struct + (* Omitted defaults setting *) + let cast w : button_box obj = Object.try_cast w "GtkBBox" + external coerce : [>`bbox] obj -> button_box obj = "%identity" + type bbox_style = [ `DEFAULT_STYLE|`SPREAD|`EDGE|`START|`END ] + external get_spacing : [>`bbox] obj -> int = "ml_gtk_button_box_get_spacing" + external get_child_width : [>`bbox] obj -> int + = "ml_gtk_button_box_get_child_min_width" + external get_child_height : [>`bbox] obj -> int + = "ml_gtk_button_box_get_child_min_height" + external get_child_ipadx : [>`bbox] obj -> int + = "ml_gtk_button_box_get_child_ipad_x" + external get_child_ipady : [>`bbox] obj -> int + = "ml_gtk_button_box_get_child_ipad_y" + external get_layout : [>`bbox] obj -> bbox_style + = "ml_gtk_button_box_get_layout_style" + external set_spacing : [>`bbox] obj -> int -> unit + = "ml_gtk_button_box_set_spacing" + external set_child_size : [>`bbox] obj -> width:int -> height:int -> unit + = "ml_gtk_button_box_set_child_size" + external set_child_ipadding : [>`bbox] obj -> x:int -> y:int -> unit + = "ml_gtk_button_box_set_child_ipadding" + external set_layout : [>`bbox] obj -> bbox_style -> unit + = "ml_gtk_button_box_set_layout" + let set_child_size w ?width ?height () = + set_child_size w ~width:(may_default get_child_width w ~opt:width) + ~height:(may_default get_child_height w ~opt:height) + let set_child_ipadding w ?x ?y () = + set_child_ipadding w + ~x:(may_default get_child_ipadx w ~opt:x) + ~y:(may_default get_child_ipady w ~opt:y) + let set ?spacing ?child_width ?child_height ?child_ipadx + ?child_ipady ?layout w = + may spacing ~f:(set_spacing w); + if child_width <> None || child_height <> None then + set_child_size w ?width:child_width ?height:child_height (); + if child_ipadx <> None || child_ipady <> None then + set_child_ipadding w ?x:child_ipadx ?y:child_ipady (); + may layout ~f:(set_layout w) + external set_child_size_default : width:int -> height:int -> unit + = "ml_gtk_button_box_set_child_size_default" + external set_child_ipadding_default : x:int -> y:int -> unit + = "ml_gtk_button_box_set_child_ipadding_default" + external create_hbbox : unit -> button_box obj = "ml_gtk_hbutton_box_new" + external create_vbbox : unit -> button_box obj = "ml_gtk_vbutton_box_new" + let create (dir : orientation) = + if dir = `HORIZONTAL then create_hbbox () else create_vbbox () +end + +module Fixed = struct + let cast w : fixed obj = Object.try_cast w "GtkFixed" + external create : unit -> fixed obj = "ml_gtk_fixed_new" + external put : [>`fixed] obj -> [>`widget] obj -> x:int -> y:int -> unit + = "ml_gtk_fixed_put" + external move : [>`fixed] obj -> [>`widget] obj -> x:int -> y:int -> unit + = "ml_gtk_fixed_move" +end + +module Layout = struct + let cast w : layout obj = Object.try_cast w "GtkLayout" + external create : + [>`adjustment] optobj -> [>`adjustment] optobj -> layout obj + = "ml_gtk_layout_new" + external put : [>`layout] obj -> [>`widget] obj -> x:int -> y:int -> unit + = "ml_gtk_layout_put" + external move : [>`layout] obj -> [>`widget] obj -> x:int -> y:int -> unit + = "ml_gtk_layout_move" + external set_size : [>`layout] obj -> width:int -> height:int -> unit + = "ml_gtk_layout_set_size" + external get_hadjustment : [>`layout] obj -> adjustment obj + = "ml_gtk_layout_get_hadjustment" + external get_vadjustment : [>`layout] obj -> adjustment obj + = "ml_gtk_layout_get_vadjustment" + external set_hadjustment : [>`layout] obj -> [>`adjustment] obj -> unit + = "ml_gtk_layout_set_hadjustment" + external set_vadjustment : [>`layout] obj -> [>`adjustment] obj -> unit + = "ml_gtk_layout_set_vadjustment" + external freeze : [>`layout] obj -> unit + = "ml_gtk_layout_freeze" + external thaw : [>`layout] obj -> unit + = "ml_gtk_layout_thaw" + external get_height : [>`layout] obj -> int + = "ml_gtk_layout_get_height" + external get_width : [>`layout] obj -> int + = "ml_gtk_layout_get_width" + let set_size ?width ?height w = + set_size w ~width:(may_default get_width w ~opt:width) + ~height:(may_default get_height w ~opt:height) +end + + +module Packer = struct + let cast w : packer obj = Object.try_cast w "GtkPacker" + external create : unit -> packer obj = "ml_gtk_packer_new" + external add : + [>`packer] obj -> [>`widget] obj -> + ?side:side_type -> ?anchor:anchor_type -> + ?options:packer_options list -> + ?border_width:int -> ?pad_x:int -> ?pad_y:int -> + ?i_pad_x:int -> ?i_pad_y:int -> unit + = "ml_gtk_packer_add_bc" "ml_gtk_packer_add" + external add_defaults : + [>`packer] obj -> [>`widget] obj -> + ?side:side_type -> ?anchor:anchor_type -> + ?options:packer_options list -> unit + = "ml_gtk_packer_add_defaults" + external set_child_packing : + [>`packer] obj -> [>`widget] obj -> + ?side:side_type -> ?anchor:anchor_type -> + ?options:packer_options list -> + ?border_width:int -> ?pad_x:int -> ?pad_y:int -> + ?i_pad_x:int -> ?i_pad_y:int -> unit + = "ml_gtk_packer_set_child_packing_bc" "ml_gtk_packer_set_child_packing" + external reorder_child : [>`packer] obj -> [>`widget] obj -> pos:int -> unit + = "ml_gtk_packer_reorder_child" + external set_spacing : [>`packer] obj -> int -> unit + = "ml_gtk_packer_set_spacing" + external set_defaults : + [>`packer] obj -> ?border_width:int -> ?pad_x:int -> ?pad_y:int -> + ?i_pad_x:int -> ?i_pad_y:int -> unit -> unit + = "ml_gtk_packer_set_defaults_bc" "ml_gtk_packer_set_defaults" + + let build_options ?(expand=false) ?(fill=`BOTH) () = + (if expand then [`PACK_EXPAND] else []) @ + (match (fill : expand_type) with `NONE -> [] + | `X -> [`FILL_X] + | `Y -> [`FILL_Y] + | `BOTH -> [`FILL_X;`FILL_Y]) +end + +module Paned = struct + let cast w : paned obj = Object.try_cast w "GtkPaned" + external add1 : [>`paned] obj -> [>`widget] obj -> unit + = "ml_gtk_paned_add1" + external add2 : [>`paned] obj -> [>`widget] obj -> unit + = "ml_gtk_paned_add2" + external set_handle_size : [>`paned] obj -> int -> unit + = "ml_gtk_paned_set_handle_size" + external set_gutter_size : [>`paned] obj -> int -> unit + = "ml_gtk_paned_set_gutter_size" + let set ?handle_size ?gutter_size w = + may ~f:(set_handle_size w) handle_size; + may ~f:(set_gutter_size w) gutter_size + external child1 : [>`paned] obj -> widget obj = "ml_gtk_paned_child1" + external child2 : [>`paned] obj -> widget obj = "ml_gtk_paned_child2" + external handle_size : [>`paned] obj -> int = "ml_gtk_paned_handle_size" + external gutter_size : [>`paned] obj -> int = "ml_gtk_paned_handle_size" + external hpaned_new : unit -> paned obj = "ml_gtk_hpaned_new" + external vpaned_new : unit -> paned obj = "ml_gtk_vpaned_new" + let create (dir : orientation) = + if dir = `HORIZONTAL then hpaned_new () else vpaned_new () +end + +module Table = struct + let cast w : table obj = Object.try_cast w "GtkTable" + external create : int -> int -> homogeneous:bool -> table obj + = "ml_gtk_table_new" + let create ~rows:r ~columns:c ?(homogeneous=false) () = + create r c ~homogeneous + external attach : + [>`table] obj -> [>`widget] obj -> left:int -> right:int -> + top:int -> bottom:int -> xoptions:attach_options list -> + yoptions:attach_options list -> xpadding:int -> ypadding:int -> unit + = "ml_gtk_table_attach_bc" "ml_gtk_table_attach" + let has_x : expand_type -> bool = + function `X|`BOTH -> true | `Y|`NONE -> false + let has_y : expand_type -> bool = + function `Y|`BOTH -> true | `X|`NONE -> false + let attach t ~left ~top ?(right=left+1) ?(bottom=top+1) + ?(expand=`NONE) ?(fill=`BOTH) ?(shrink=`NONE) + ?(xpadding=0) ?(ypadding=0) w = + let xoptions = if has_x shrink then [`SHRINK] else [] in + let xoptions = if has_x fill then `FILL::xoptions else xoptions in + let xoptions = if has_x expand then `EXPAND::xoptions else xoptions in + let yoptions = if has_y shrink then [`SHRINK] else [] in + let yoptions = if has_y fill then `FILL::yoptions else yoptions in + let yoptions = if has_y expand then `EXPAND::yoptions else yoptions in + attach t w ~left ~top ~right ~bottom ~xoptions ~yoptions + ~xpadding ~ypadding + external set_row_spacing : [>`table] obj -> int -> int -> unit + = "ml_gtk_table_set_row_spacing" + external set_col_spacing : [>`table] obj -> int -> int -> unit + = "ml_gtk_table_set_col_spacing" + external set_row_spacings : [>`table] obj -> int -> unit + = "ml_gtk_table_set_row_spacings" + external set_col_spacings : [>`table] obj -> int -> unit + = "ml_gtk_table_set_col_spacings" + external set_homogeneous : [>`table] obj -> bool -> unit + = "ml_gtk_table_set_homogeneous" + let set ?homogeneous ?row_spacings ?col_spacings w = + may row_spacings ~f:(set_row_spacings w); + may col_spacings ~f:(set_col_spacings w); + may homogeneous ~f:(set_homogeneous w) +end + +module Notebook = struct + let cast w : notebook obj = Object.try_cast w "GtkNotebook" + external create : unit -> notebook obj = "ml_gtk_notebook_new" + external insert_page : + [>`notebook] obj -> [>`widget] obj -> tab_label:[>`widget] optobj -> + menu_label:[>`widget] optobj -> pos:int -> unit + = "ml_gtk_notebook_insert_page_menu" + (* default is append to end *) + external remove_page : [>`notebook] obj -> int -> unit + = "ml_gtk_notebook_remove_page" + external get_current_page : [>`notebook] obj -> int + = "ml_gtk_notebook_get_current_page" + external set_page : [>`notebook] obj -> int -> unit + = "ml_gtk_notebook_set_page" + external set_tab_pos : [>`notebook] obj -> position -> unit + = "ml_gtk_notebook_set_tab_pos" + external set_homogeneous_tabs : [>`notebook] obj -> bool -> unit + = "ml_gtk_notebook_set_homogeneous_tabs" + external set_show_tabs : [>`notebook] obj -> bool -> unit + = "ml_gtk_notebook_set_show_tabs" + external set_show_border : [>`notebook] obj -> bool -> unit + = "ml_gtk_notebook_set_show_border" + external set_scrollable : [>`notebook] obj -> bool -> unit + = "ml_gtk_notebook_set_scrollable" + external set_tab_border : [>`notebook] obj -> int -> unit + = "ml_gtk_notebook_set_tab_border" + external popup_enable : [>`notebook] obj -> unit + = "ml_gtk_notebook_popup_enable" + external popup_disable : [>`notebook] obj -> unit + = "ml_gtk_notebook_popup_disable" + external get_nth_page : [>`notebook] obj -> int -> widget obj + = "ml_gtk_notebook_get_nth_page" + external page_num : [>`notebook] obj -> [>`widget] obj -> int + = "ml_gtk_notebook_page_num" + external next_page : [>`notebook] obj -> unit + = "ml_gtk_notebook_next_page" + external prev_page : [>`notebook] obj -> unit + = "ml_gtk_notebook_prev_page" + external get_tab_label : [>`notebook] obj -> [>`widget] obj -> widget obj + = "ml_gtk_notebook_get_tab_label" + external set_tab_label : + [>`notebook] obj -> [>`widget] obj -> [>`widget] obj -> unit + = "ml_gtk_notebook_set_tab_label" + external get_menu_label : [>`notebook] obj -> [>`widget] obj -> widget obj + = "ml_gtk_notebook_get_menu_label" + external set_menu_label : + [>`notebook] obj -> [>`widget] obj -> [>`widget] obj -> unit + = "ml_gtk_notebook_set_menu_label" + external reorder_child : [>`notebook] obj -> [>`widget] obj -> int -> unit + = "ml_gtk_notebook_reorder_child" + + let set_popup w = function + true -> popup_enable w + | false -> popup_disable w + let set ?page ?tab_pos ?show_tabs ?homogeneous_tabs + ?show_border ?scrollable ?tab_border ?popup w = + let may_set f = may ~f:(f w) in + may_set set_page page; + may_set set_tab_pos tab_pos; + may_set set_show_tabs show_tabs; + may_set set_homogeneous_tabs homogeneous_tabs; + may_set set_show_border show_border; + may_set set_scrollable scrollable; + may_set set_tab_border tab_border; + may_set set_popup popup + module Signals = struct + open GtkArgv + open GtkSignal + let marshal_page f argv = function + | _ :: INT page :: _ -> f page + | _ -> invalid_arg "GtkPack.Notebook.Signals.marshal_page" + let switch_page : ([>`notebook],_) t = + { name = "switch_page"; marshaller = marshal_page } + end +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkRange.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkRange.ml new file mode 100644 index 000000000..b67e49b2e --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkRange.ml @@ -0,0 +1,147 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags +open GtkBase + +module Progress = struct + let cast w : progress obj = Object.try_cast w "GtkProgress" + external set_show_text : [>`progress] obj -> bool -> unit + = "ml_gtk_progress_set_show_text" + external set_text_alignment : + [>`progress] obj -> ?x:float -> ?y:float -> unit -> unit + = "ml_gtk_progress_set_show_text" + external set_format_string : [>`progress] obj -> string -> unit + = "ml_gtk_progress_set_format_string" + external set_adjustment : [>`progress] obj -> [>`adjustment] obj -> unit + = "ml_gtk_progress_set_adjustment" + external configure : + [>`progress] obj -> current:float -> min:float -> max:float -> unit + = "ml_gtk_progress_configure" + external set_percentage : [>`progress] obj -> float -> unit + = "ml_gtk_progress_set_percentage" + external set_value : [>`progress] obj -> float -> unit + = "ml_gtk_progress_set_value" + external get_value : [>`progress] obj -> float + = "ml_gtk_progress_get_value" + external get_percentage : [>`progress] obj -> float + = "ml_gtk_progress_get_current_percentage" + external set_activity_mode : [>`progress] obj -> bool -> unit + = "ml_gtk_progress_set_activity_mode" + external get_current_text : [>`progress] obj -> string + = "ml_gtk_progress_get_current_text" + external get_adjustment : [>`progress] obj -> adjustment obj + = "ml_gtk_progress_get_adjustment" + let set ?value ?percentage ?activity_mode + ?show_text ?format_string ?text_xalign ?text_yalign w = + may value ~f:(set_value w); + may percentage ~f:(set_percentage w); + may activity_mode ~f:(set_activity_mode w); + may show_text ~f:(set_show_text w); + may format_string ~f:(set_format_string w); + if text_xalign <> None || text_yalign <> None then + set_text_alignment w ?x:text_xalign ?y:text_yalign () +end + +module ProgressBar = struct + let cast w : progress_bar obj = Object.try_cast w "GtkProgressBar" + external create : unit -> progress_bar obj = "ml_gtk_progress_bar_new" + external create_with_adjustment : [>`adjustment] obj -> progress_bar obj + = "ml_gtk_progress_bar_new_with_adjustment" + external set_bar_style : + [>`progressbar] obj -> [`CONTINUOUS|`DISCRETE] -> unit + = "ml_gtk_progress_bar_set_bar_style" + external set_discrete_blocks : [>`progressbar] obj -> int -> unit + = "ml_gtk_progress_bar_set_discrete_blocks" + external set_activity_step : [>`progressbar] obj -> int -> unit + = "ml_gtk_progress_bar_set_activity_step" + external set_activity_blocks : [>`progressbar] obj -> int -> unit + = "ml_gtk_progress_bar_set_activity_blocks" + external set_orientation : + [>`progressbar] obj -> Tags.progress_bar_orientation -> unit + = "ml_gtk_progress_bar_set_orientation" + let set ?bar_style ?discrete_blocks ?activity_step ?activity_blocks w = + let may_set f opt = may opt ~f:(f w) in + may_set set_bar_style bar_style; + may_set set_discrete_blocks discrete_blocks; + may_set set_activity_step activity_step; + may_set set_activity_blocks activity_blocks +end + +module Range = struct + let cast w : range obj = Object.try_cast w "GtkRange" + external coerce : [>`range] obj -> range obj = "%identity" + external get_adjustment : [>`range] obj -> adjustment obj + = "ml_gtk_range_get_adjustment" + external set_adjustment : [>`range] obj -> [>`adjustment] obj -> unit + = "ml_gtk_range_set_adjustment" + external set_update_policy : [>`range] obj -> update_type -> unit + = "ml_gtk_range_set_update_policy" + let set ?adjustment ?update_policy w = + may adjustment ~f:(set_adjustment w); + may update_policy ~f:(set_update_policy w) +end + +module Scale = struct + let cast w : scale obj = Object.try_cast w "GtkScale" + external hscale_new : [>`adjustment] optobj -> scale obj + = "ml_gtk_hscale_new" + external vscale_new : [>`adjustment] optobj -> scale obj + = "ml_gtk_vscale_new" + let create ?adjustment (dir : orientation) = + let create = if dir = `HORIZONTAL then hscale_new else vscale_new in + create (Gpointer.optboxed adjustment) + external set_digits : [>`scale] obj -> int -> unit + = "ml_gtk_scale_set_digits" + external set_draw_value : [>`scale] obj -> bool -> unit + = "ml_gtk_scale_set_draw_value" + external set_value_pos : [>`scale] obj -> position -> unit + = "ml_gtk_scale_set_value_pos" + external get_value_width : [>`scale] obj -> int + = "ml_gtk_scale_get_value_width" + external draw_value : [>`scale] obj -> unit + = "ml_gtk_scale_draw_value" + let set ?digits ?draw_value ?value_pos w = + may digits ~f:(set_digits w); + may draw_value ~f:(set_draw_value w); + may value_pos ~f:(set_value_pos w) +end + +module Scrollbar = struct + let cast w : scrollbar obj = Object.try_cast w "GtkScrollbar" + external hscrollbar_new : [>`adjustment] optobj -> scrollbar obj + = "ml_gtk_hscrollbar_new" + external vscrollbar_new : [>`adjustment] optobj -> scrollbar obj + = "ml_gtk_vscrollbar_new" + let create ?adjustment (dir : orientation) = + let create = if dir = `HORIZONTAL then hscrollbar_new else vscrollbar_new + in create (Gpointer.optboxed adjustment) +end + +module Ruler = struct + let cast w : ruler obj = Object.try_cast w "GtkRuler" + external hruler_new : unit -> ruler obj = "ml_gtk_hruler_new" + external vruler_new : unit -> ruler obj = "ml_gtk_vruler_new" + let create (dir : orientation) = + if dir = `HORIZONTAL then hruler_new () else vruler_new () + external set_metric : [>`ruler] obj -> metric_type -> unit + = "ml_gtk_ruler_set_metric" + external set_range : + [>`ruler] obj -> + lower:float -> upper:float -> position:float -> max_size:float -> unit + = "ml_gtk_ruler_set_range" + external get_lower : [>`ruler] obj -> float = "ml_gtk_ruler_get_lower" + external get_upper : [>`ruler] obj -> float = "ml_gtk_ruler_get_upper" + external get_position : [>`ruler] obj -> float = "ml_gtk_ruler_get_position" + external get_max_size : [>`ruler] obj -> float = "ml_gtk_ruler_get_max_size" + let set_range ?lower ?upper ?position ?max_size w = + set_range w ~lower:(may_default get_lower w ~opt:lower) + ~upper:(may_default get_upper w ~opt:upper) + ~position:(may_default get_position w ~opt:position) + ~max_size:(may_default get_max_size w ~opt:max_size) + let set ?metric ?lower ?upper ?position ?max_size w = + may metric ~f:(set_metric w); + if lower <> None || upper <> None || position <> None || max_size <> None + then set_range w ?lower ?upper ?position ?max_size +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkSignal.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkSignal.ml new file mode 100644 index 000000000..8fa460288 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkSignal.ml @@ -0,0 +1,65 @@ +(* $Id$ *) + +open Gtk + +type id +type ('a,'b) t = + { name: string; + marshaller: ('b -> GtkArgv.t -> GtkArgv.data list -> unit) } + +let enter_callback = ref (fun () -> ()) +and exit_callback = ref (fun () -> ()) + +let stop_emit_ref = ref false +let stop_emit () = stop_emit_ref := true + +type saved_state = State of bool +let push_callback () = + !enter_callback (); + let old = !stop_emit_ref in + stop_emit_ref := false; + State old + +let pop_callback (State old) = + let res = !stop_emit_ref in + stop_emit_ref := old; + !exit_callback (); + res + +external connect : + 'a obj -> name:string -> callback:(GtkArgv.t -> unit) -> after:bool -> id + = "ml_gtk_signal_connect" +external emit_stop_by_name : 'a obj -> name:string -> unit + = "ml_gtk_signal_emit_stop_by_name" +let connect ~(sgn : ('a, _) t) ~callback ?(after=false) (obj : 'a obj) = + let callback argv = + let old = push_callback () in + let exn = + try sgn.marshaller callback argv (GtkArgv.get_args argv); None + with exn -> Some exn + in + if pop_callback old then emit_stop_by_name obj ~name:sgn.name; + Gaux.may ~f:raise exn + in + connect obj ~name:sgn.name ~callback ~after +external disconnect : 'a obj -> id -> unit + = "ml_gtk_signal_disconnect" +external handler_block : 'a obj -> id -> unit + = "ml_gtk_signal_handler_block" +external handler_unblock : 'a obj -> id -> unit + = "ml_gtk_signal_handler_unblock" + +let marshal_unit f _ _ = f () +let marshal_int f _ = function + | GtkArgv.INT n :: _ -> f n + | _ -> invalid_arg "GtkSignal.marshal_int" + +let emit (obj : 'a obj) ~(sgn : ('a, 'b) t) + ~(emitter : 'a obj -> name:string -> 'b) = + emitter obj ~name:sgn.name +external emit_none : 'a obj -> name:string -> unit -> unit + = "ml_gtk_signal_emit_none" +let emit_unit obj ~sgn = emit obj ~emitter:emit_none ~sgn () +external emit_int : 'a obj -> name:string -> int -> unit + = "ml_gtk_signal_emit_int" +let emit_int = emit ~emitter:emit_int diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkSignal.mli b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkSignal.mli new file mode 100644 index 000000000..0ef2ab2ea --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkSignal.mli @@ -0,0 +1,45 @@ +(* $Id$ *) + +open Gtk + +type id +type ('a,'b) t = + { name: string; + marshaller: ('b -> GtkArgv.t -> GtkArgv.data list -> unit) } + +val stop_emit : unit -> unit + (* Call [stop_emit ()] in a callback to prohibit further handling + of the current signal invocation, by calling [emit_stop_by_name]. + Be careful about where you use it, since the concept of current + signal may be tricky. *) + +val connect : + sgn:('a, 'b) t -> callback:'b -> ?after:bool -> 'a obj -> id + (* You may use [stop_emit] inside the callback *) + +external disconnect : 'a obj -> id -> unit + = "ml_gtk_signal_disconnect" +external emit_stop_by_name : 'a obj -> name:string -> unit + = "ml_gtk_signal_emit_stop_by_name" + (* Unsafe: use [stop_emit] instead. *) +external handler_block : 'a obj -> id -> unit + = "ml_gtk_signal_handler_block" +external handler_unblock : 'a obj -> id -> unit + = "ml_gtk_signal_handler_unblock" + +(* Some marshaller functions, to build signals *) +val marshal_unit : (unit -> unit) -> GtkArgv.t -> GtkArgv.data list -> unit +val marshal_int : (int -> unit) -> GtkArgv.t -> GtkArgv.data list -> unit + +(* Emitter functions *) +val emit : + 'a obj -> sgn:('a, 'b) t -> emitter:('a obj -> name:string -> 'b) -> 'b +val emit_unit : 'a obj -> sgn:('a, unit -> unit) t -> unit +val emit_int : 'a obj -> sgn:('a, int -> unit) t -> int -> unit + +(* Internal functions. *) +val enter_callback : (unit -> unit) ref +val exit_callback : (unit -> unit) ref +type saved_state +val push_callback : unit -> saved_state +val pop_callback : saved_state -> bool diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkThInit.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkThInit.ml new file mode 100644 index 000000000..517f80be4 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkThInit.ml @@ -0,0 +1,5 @@ +(* $Id$ *) + +(* Start the main thread in a threaded toplevel *) + +let thread = GtkThread.start () diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkThread.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkThread.ml new file mode 100644 index 000000000..3ab577e3e --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkThread.ml @@ -0,0 +1,33 @@ +(* $Id$ *) + +open GtkMain + +(* We check first whether there are some event pending, and run + some iterations. We then need to delay, thus focing a thread switch. *) + +let main () = + try + let loop = (Glib.Main.create true) in + Main.loops := loop :: !Main.loops; + while Glib.Main.is_running loop do + let i = ref 0 in + while !i < 100 && Glib.Main.pending () do + Glib.Main.iteration true; + incr i + done; + Thread.delay 0.001 + done; + Main.loops := List.tl !Main.loops + with exn -> + Main.loops := List.tl !Main.loops; + raise exn + +let start = Thread.create main + +let _ = + let mutex = Mutex.create () in + let depth = ref 0 in + GtkSignal.enter_callback := + (fun () -> if !depth = 0 then Mutex.lock mutex; incr depth); + GtkSignal.exit_callback := + (fun () -> decr depth; if !depth = 0 then Mutex.unlock mutex) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkTree.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkTree.ml new file mode 100644 index 000000000..926074167 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkTree.ml @@ -0,0 +1,122 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags +open GtkBase + +module TreeItem = struct + let cast w : tree_item obj = Object.try_cast w "GtkTreeItem" + external create : unit -> tree_item obj = "ml_gtk_tree_item_new" + external create_with_label : string -> tree_item obj + = "ml_gtk_tree_item_new_with_label" + let create ?label () = + match label with None -> create () + | Some label -> create_with_label label + external set_subtree : [>`treeitem] obj -> [>`widget] obj -> unit + = "ml_gtk_tree_item_set_subtree" + external remove_subtree : [>`treeitem] obj -> unit + = "ml_gtk_tree_item_remove_subtree" + external expand : [>`treeitem] obj -> unit + = "ml_gtk_tree_item_expand" + external collapse : [>`treeitem] obj -> unit + = "ml_gtk_tree_item_collapse" + external subtree : [>`treeitem] obj -> tree obj + = "ml_GTK_TREE_ITEM_SUBTREE" + module Signals = struct + open GtkSignal + let expand : ([>`treeitem],_) t = + { name = "expand"; marshaller = marshal_unit } + let collapse : ([>`treeitem],_) t = + { name = "collapse"; marshaller = marshal_unit } + end +end + +module Tree = struct + let cast w : tree obj = Object.try_cast w "GtkTree" + external coerce : [>`tree] obj -> tree obj = "%identity" + external create : unit -> tree obj = "ml_gtk_tree_new" + external insert : [>`tree] obj -> [>`treeitem] obj -> pos:int -> unit + = "ml_gtk_tree_insert" + external remove_items : [>`tree] obj -> [>`treeitem] obj list -> unit + = "ml_gtk_tree_remove_items" + external clear_items : [>`tree] obj -> start:int -> stop:int -> unit + = "ml_gtk_tree_clear_items" + external select_item : [>`tree] obj -> pos:int -> unit + = "ml_gtk_tree_select_item" + external unselect_item : [>`tree] obj -> pos:int -> unit + = "ml_gtk_tree_unselect_item" + external child_position : [>`tree] obj -> [>`treeitem] obj -> int + = "ml_gtk_tree_child_position" + external set_selection_mode : [>`tree] obj -> selection_mode -> unit + = "ml_gtk_tree_set_selection_mode" + external set_view_mode : [>`tree] obj -> [`LINE|`ITEM] -> unit + = "ml_gtk_tree_set_view_mode" + external set_view_lines : [>`tree] obj -> bool -> unit + = "ml_gtk_tree_set_view_lines" + external selection : [>`tree] obj -> tree_item obj list = + "ml_gtk_tree_selection" + let set ?selection_mode ?view_mode ?view_lines w = + let may_set f = may ~f:(f w) in + may_set set_selection_mode selection_mode; + may_set set_view_mode view_mode; + may_set set_view_lines view_lines + module Signals = struct + open GtkSignal + let selection_changed : ([>`tree],_) t = + { name = "selection_changed"; marshaller = marshal_unit } + let select_child : ([>`tree],_) t = + { name = "select_child"; marshaller = Widget.Signals.marshal } + let unselect_child : ([>`tree],_) t = + { name = "unselect_child"; marshaller = Widget.Signals.marshal } + end +end +(* +module CTree = struct + type t + type node = [`ctree] obj * t + let cast w : ctree obj = Object.try_cast w "GtkCTree" + external create : cols:int -> treecol:int -> ctree obj = "ml_gtk_ctree_new" + external insert_node : + [>`ctree] obj -> ?parent:node -> ?sibling:node -> + titles:optstring array -> + spacing:int -> ?pclosed:Gdk.pixmap -> ?mclosed:Gdk.bitmap obj -> + ?popened:Gdk.pixmap -> ?mopened:Gdk.bitmap obj -> + is_leaf:bool -> expanded:bool -> node + = "ml_gtk_ctree_insert_node_bc" "ml_gtk_ctree_insert_node" + let insert_node' + w ?parent ?sibling ?(spacing = 0) ?(is_leaf = true) + ?(expanded = false) + ?pclosed ?mclosed ?popened ?mopened titles = + let len = GtkList.CList.get_columns w in + if List.length titles > len then invalid_arg "CTree.insert_node"; + let arr = Array.create ~len None in + List.fold_left titles ~acc:0 + ~f:(fun ~acc text -> arr.(acc) <- Some text; acc+1); + insert_node w + ?parent ?sibling ~titles:(Array.map ~f:optstring arr) + ~spacing ~is_leaf ~expanded + ?pclosed ?mclosed ?popened ?mopened + external node_set_row_data : [>`ctree] obj -> node:node -> Obj.t -> unit + = "ml_gtk_ctree_node_set_row_data" + external node_get_row_data : [>`ctree] obj -> node:node -> Obj.t + = "ml_gtk_ctree_node_get_row_data" + external set_indent : [>`ctree] obj -> int -> unit + = "ml_gtk_ctree_set_indent" + module Signals = struct + open GtkSignal + let marshal_select f argv = + let node : node = + match GtkArgv.get_pointer argv ~pos:0 with + Some p -> Obj.magic p + | None -> invalid_arg "GtkTree.CTree.Signals.marshal_select" + in + f ~node ~column:(GtkArgv.get_int argv ~pos:1) + + let tree_select_row : ([>`ctree],_) t = + { name = "tree_select_row"; marshaller = marshal_select } + let tree_unselect_row : ([>`ctree],_) t = + { name = "tree_unselect_row"; marshaller = marshal_select } + end +end +*) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkWindow.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkWindow.ml new file mode 100644 index 000000000..ffe00e921 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkWindow.ml @@ -0,0 +1,189 @@ +(* $Id$ *) + +open Gaux +open Gtk +open Tags +open GtkBase + +module Window = struct + let cast w : window obj = Object.try_cast w "GtkWindow" + external coerce : [>`window] obj -> window obj = "%identity" + external create : window_type -> window obj = "ml_gtk_window_new" + external set_title : [>`window] obj -> string -> unit + = "ml_gtk_window_set_title" + external set_wmclass : [>`window] obj -> name:string -> clas:string -> unit + = "ml_gtk_window_set_title" + external get_wmclass_name : [>`window] obj -> string + = "ml_gtk_window_get_wmclass_name" + external get_wmclass_class : [>`window] obj -> string + = "ml_gtk_window_get_wmclass_class" + (* set_focus/default are called by Widget.grab_focus/default *) + external set_focus : [>`window] obj -> [>`widget] obj -> unit + = "ml_gtk_window_set_focus" + external set_default : [>`window] obj -> [>`widget] obj -> unit + = "ml_gtk_window_set_default" + external set_policy : + [>`window] obj -> + allow_shrink:bool -> allow_grow:bool -> auto_shrink:bool -> unit + = "ml_gtk_window_set_policy" + external get_allow_shrink : [>`window] obj -> bool + = "ml_gtk_window_get_allow_shrink" + external get_allow_grow : [>`window] obj -> bool + = "ml_gtk_window_get_allow_grow" + external get_auto_shrink : [>`window] obj -> bool + = "ml_gtk_window_get_auto_shrink" + external activate_focus : [>`window] obj -> bool + = "ml_gtk_window_activate_focus" + external activate_default : [>`window] obj -> bool + = "ml_gtk_window_activate_default" + external set_modal : [>`window] obj -> bool -> unit + = "ml_gtk_window_set_modal" + external set_default_size : + [>`window] obj -> width:int -> height:int -> unit + = "ml_gtk_window_set_default_size" + external set_position : [>`window] obj -> window_position -> unit + = "ml_gtk_window_set_position" + external set_transient_for : [>`window] obj ->[>`window] obj -> unit + = "ml_gtk_window_set_transient_for" + + let set_wmclass ?name ?clas:wm_class w = + set_wmclass w ~name:(may_default get_wmclass_name w ~opt:name) + ~clas:(may_default get_wmclass_class w ~opt:wm_class) + let set_policy ?allow_shrink ?allow_grow ?auto_shrink w = + set_policy w + ~allow_shrink:(may_default get_allow_shrink w ~opt:allow_shrink) + ~allow_grow:(may_default get_allow_grow w ~opt:allow_grow) + ~auto_shrink:(may_default get_auto_shrink w ~opt:auto_shrink) + let set ?title ?wm_name ?wm_class ?position ?allow_shrink ?allow_grow + ?auto_shrink ?modal ?(x = -2) ?(y = -2) w = + may title ~f:(set_title w); + if wm_name <> None || wm_class <> None then + set_wmclass w ?name:wm_name ?clas:wm_class; + may position ~f:(set_position w); + if allow_shrink <> None || allow_grow <> None || auto_shrink <> None then + set_policy w ?allow_shrink ?allow_grow ?auto_shrink; + may ~f:(set_modal w) modal; + if x <> -2 || y <> -2 then Widget.set_uposition w ~x ~y + external add_accel_group : [>`window] obj -> accel_group -> unit + = "ml_gtk_window_add_accel_group" + external remove_accel_group : + [>`window] obj -> accel_group -> unit + = "ml_gtk_window_remove_accel_group" + external activate_focus : [>`window] obj -> unit + = "ml_gtk_window_activate_focus" + external activate_default : [>`window] obj -> unit + = "ml_gtk_window_activate_default" + module Signals = struct + open GtkSignal + let move_resize : ([>`window],_) t = + { name = "move_resize"; marshaller = marshal_unit } + let set_focus : ([>`window],_) t = + { name = "set_focus"; marshaller = Widget.Signals.marshal_opt } + end +end + +module Dialog = struct + let cast w : dialog obj = Object.try_cast w "GtkDialog" + external coerce : [>`dialog] obj -> dialog obj = "%identity" + external create : unit -> dialog obj = "ml_gtk_dialog_new" + external action_area : [>`dialog] obj -> box obj + = "ml_GtkDialog_action_area" + external vbox : [>`dialog] obj -> box obj + = "ml_GtkDialog_vbox" +end + +module InputDialog = struct + let cast w : input_dialog obj = Object.try_cast w "GtkInputDialog" + external create : unit -> input_dialog obj = "ml_gtk_input_dialog_new" + module Signals = struct + open GtkSignal + let enable_device : ([>`inputdialog],_) t = + { name = "enable_device"; marshaller = marshal_int } + let disable_device : ([>`inputdialog],_) t = + { name = "disable_device"; marshaller = marshal_int } + end +end + +module FileSelection = struct + let cast w : file_selection obj = Object.try_cast w "GtkFileSelection" + external create : string -> file_selection obj = "ml_gtk_file_selection_new" + external set_filename : [>`filesel] obj -> string -> unit + = "ml_gtk_file_selection_set_filename" + external get_filename : [>`filesel] obj -> string + = "ml_gtk_file_selection_get_filename" + external show_fileop_buttons : [>`filesel] obj -> unit + = "ml_gtk_file_selection_show_fileop_buttons" + external hide_fileop_buttons : [>`filesel] obj -> unit + = "ml_gtk_file_selection_hide_fileop_buttons" + external get_ok_button : [>`filesel] obj -> button obj + = "ml_gtk_file_selection_get_ok_button" + external get_cancel_button : [>`filesel] obj -> button obj + = "ml_gtk_file_selection_get_cancel_button" + external get_help_button : [>`filesel] obj -> button obj + = "ml_gtk_file_selection_get_help_button" + let set_fileop_buttons w = function + true -> show_fileop_buttons w + | false -> hide_fileop_buttons w + let set ?filename ?fileop_buttons w = + may filename ~f:(set_filename w); + may fileop_buttons ~f:(set_fileop_buttons w) +end + +module FontSelectionDialog = struct + let cast w : font_selection_dialog obj = + Object.try_cast w "GtkFontSelectionDialog" + external create : ?title:string -> unit -> font_selection_dialog obj + = "ml_gtk_font_selection_dialog_new" + external font_selection : [>`fontseldialog] obj -> font_selection obj + = "ml_gtk_font_selection_dialog_fontsel" + external ok_button : [>`fontseldialog] obj -> button obj + = "ml_gtk_font_selection_dialog_ok_button" + external apply_button : [>`fontseldialog] obj -> button obj + = "ml_gtk_font_selection_dialog_apply_button" + external cancel_button : [>`fontseldialog] obj -> button obj + = "ml_gtk_font_selection_dialog_cancel_button" +(* + type null_terminated + let null_terminated arg : null_terminated = + match arg with None -> Obj.magic Gpointer.raw_null + | Some l -> + let len = List.length l in + let arr = Array.create (len + 1) "" in + let rec loop i = function + [] -> arr.(i) <- Obj.magic Gpointer.raw_null + | s::l -> arr.(i) <- s; loop (i+1) l + in loop 0 l; + Obj.magic (arr : string array) + external get_font : [>`fontseldialog] obj -> Gdk.font + = "ml_gtk_font_selection_dialog_get_font" + let get_font w = + try Some (get_font w) with Gpointer.Null -> None + external get_font_name : [>`fontseldialog] obj -> string + = "ml_gtk_font_selection_dialog_get_font_name" + let get_font_name w = + try Some (get_font_name w) with Gpointer.Null -> None + external set_font_name : [>`fontseldialog] obj -> string -> unit + = "ml_gtk_font_selection_dialog_set_font_name" + external set_filter : + [>`fontseldialog] obj -> font_filter_type -> font_type list -> + null_terminated -> null_terminated -> null_terminated -> + null_terminated -> null_terminated -> null_terminated -> unit + = "ml_gtk_font_selection_dialog_set_filter_bc" + "ml_gtk_font_selection_dialog_set_filter" + let set_filter w ?kind:(tl=[`ALL]) ?foundry + ?weight ?slant ?setwidth ?spacing ?charset filter = + set_filter w filter tl (null_terminated foundry) + (null_terminated weight) (null_terminated slant) + (null_terminated setwidth) (null_terminated spacing) + (null_terminated charset) + external get_preview_text : [>`fontseldialog] obj -> string + = "ml_gtk_font_selection_dialog_get_preview_text" + external set_preview_text : [>`fontseldialog] obj -> string -> unit + = "ml_gtk_font_selection_dialog_set_preview_text" +*) +end + +module Plug = struct + let cast w : plug obj = Object.try_cast w "GtkPlug" + external create : Gdk.xid -> plug obj = "ml_gtk_plug_new" +end diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkXmHTML.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkXmHTML.ml new file mode 100644 index 000000000..3bf5791a4 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkXmHTML.ml @@ -0,0 +1,109 @@ +(* $Id$ *) + +open Gtk + +type string_direction = [ + | `R_TO_L + | `L_TO_R +] + +type position = [ + | `END + | `CENTER + | `BEGINNING +] + +type line_type = [ + | `SOLID + | `DASHED + | `SINGLE + | `DOUBLE + | `STRIKE + | `UNDER + | `NONE +] + +type dither_type = [ + | `QUICK + | `BEST + | `FAST + | `SLOW + | `DISABLED +] + +type xmhtml = [`widget|`container|`xmhtml] + +external create : unit -> xmhtml obj = "ml_gtk_xmhtml_new" +external freeze : [> `xmhtml] obj -> unit = "ml_gtk_xmhtml_freeze" +external thaw : [> `xmhtml] obj -> unit = "ml_gtk_xmhtml_thaw" +external source : [> `xmhtml] obj -> string -> unit = "ml_gtk_xmhtml_source" +(* external get_source : [> `xmhtml] obj -> string = "ml_gtk_xmhtml_get_source" *) +external set_string_direction : [> `xmhtml] obj -> string_direction -> unit + = "ml_gtk_xmhtml_set_string_direction" +external set_alignment : [> `xmhtml] obj -> position -> unit + = "ml_gtk_xmhtml_set_alignment" +(* external set_outline : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_outline" *) +external set_font_familty : + [> `xmhtml] obj -> family:string -> sizes:string -> unit + = "ml_gtk_xmhtml_set_font_familty" +external set_font_familty_fixed : + [> `xmhtml] obj -> family:string -> sizes:string -> unit + = "ml_gtk_xmhtml_set_font_familty_fixed" +external set_font_charset : [> `xmhtml] obj -> string -> unit + = "ml_gtk_xmhtml_set_font_charset" +external set_allow_body_colors : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_allow_body_colors" +external set_hilight_on_enter : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_hilight_on_enter" +external set_anchor_underline_type : [> `xmhtml] obj -> line_type list -> unit + = "ml_gtk_xmhtml_set_anchor_underline_type" +external set_anchor_visited_underline_type : + [> `xmhtml] obj -> line_type list -> unit + = "ml_gtk_xmhtml_set_anchor_visited_underline_type" +external set_anchor_target_underline_type : + [> `xmhtml] obj -> line_type list -> unit + = "ml_gtk_xmhtml_set_anchor_target_underline_type" +external set_allow_color_switching : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_allow_color_switching" +external set_dithering : [> `xmhtml] obj -> dither_type -> unit + = "ml_gtk_xmhtml_set_dithering" +external set_allow_font_switching : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_allow_font_switching" +external set_max_image_colors : [> `xmhtml] obj -> int -> unit + = "ml_gtk_xmhtml_set_max_image_colors" +external set_allow_images : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_allow_images" +external set_plc_intervals : + [> `xmhtml] obj -> min:int -> max:int -> default:int -> unit + = "ml_gtk_xmhtml_set_plc_intervals" +(* +external set_def_body_image_url : [> `xmhtml] obj -> string -> unit + = "ml_gtk_xmhtml_set_def_body_image_url" +*) +external set_anchor_buttons : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_anchor_buttons" +external set_anchor_cursor : [> `xmhtml] obj -> Gdk.cursor option -> unit + = "ml_gtk_xmhtml_set_anchor_cursor" +external set_topline : [> `xmhtml] obj -> int -> unit + = "ml_gtk_xmhtml_set_topline" +external get_topline : [> `xmhtml] obj -> int + = "ml_gtk_xmhtml_get_topline" +external set_freeze_animations : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_freeze_animations" +external set_screen_gamma : [> `xmhtml] obj -> float -> unit + = "ml_gtk_xmhtml_set_screen_gamma" +external set_perfect_colors : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_perfect_colors" +external set_uncompress_command : [> `xmhtml] obj -> string -> unit + = "ml_gtk_xmhtml_set_uncompress_command" +external set_strict_checking : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_strict_checking" +external set_bad_html_warnings : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_bad_html_warnings" +external set_allow_form_coloring : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_allow_form_coloring" +external set_imagemap_draw : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_imagemap_draw" +external set_alpha_processing : [> `xmhtml] obj -> bool -> unit + = "ml_gtk_xmhtml_set_alpha_processing" diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtk_tags.var b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtk_tags.var new file mode 100644 index 000000000..b2a7d2a80 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtk_tags.var @@ -0,0 +1,169 @@ +(* $Id$ *) + +type arrow_type = "GTK_ARROW_" + [ `UP | `DOWN | `LEFT | `RIGHT ] + +type attach_options = "GTK_" + [ `EXPAND | `SHRINK | `FILL ] + +type button_box_style = "GTK_BUTTONBOX_" + [ `DEFAULT_STYLE | `SPREAD | `EDGE | `START | `END ] + +type direction_type = "GTK_DIR_" + [ `TAB_FORWARD | `TAB_BACKWARD | `UP | `DOWN | `LEFT | `RIGHT ] + +type justification = "GTK_JUSTIFY_" + [ `LEFT | `RIGHT | `CENTER | `FILL ] + +type match_type = "GTK_MATCH_" + [ `ALL | `ALL_TAIL | `HEAD | `TAIL | `EXACT | `LAST ] + +type metric_type = "GTK_" + [ `PIXELS | `INCHES | `CENTIMETERS ] + +type orientation = "GTK_ORIENTATION_" + [ `HORIZONTAL | `VERTICAL ] + +type corner_type = "GTK_CORNER_" + [ `TOP_LEFT | `BOTTOM_LEFT | `TOP_RIGHT | `BOTTOM_RIGHT ] + +type pack_type = "GTK_PACK_" + [ `START | `END ] + +type path_type = "GTK_PATH_" + [ `WIDGET | `WIDGET_CLASS | `CLASS ] + +type policy_type = "GTK_POLICY_" + [ `ALWAYS | `AUTOMATIC | `NEVER ] + +type position = "GTK_POS_" + [ `LEFT | `RIGHT | `TOP | `BOTTOM ] + +type preview_type = "GTK_PREVIEW_" + [ `COLOR | `GRAYSCALE ] + +type relief_style = "GTK_RELIEF_" + [ `NORMAL | `HALF | `NONE ] + +type resize_mode = "GTK_RESIZE_" + [ `PARENT | `QUEUE | `IMMEDIATE ] + +type signal_run_type = "GTK_RUN_" + [ `FIRST | `LAST | `BOTH | `NO_RECURSE | `ACTION | `NO_HOOKS ] + +type scroll_type = "GTK_SCROLL_" + [ `NONE | `STEP_FORWARD | `STEP_BACKWARD | `PAGE_BACKWARD + | `PAGE_FORWARD | `JUMP ] + +type selection_mode = "GTK_SELECTION_" + [ `SINGLE | `BROWSE | `MULTIPLE | `EXTENDED ] + +type shadow_type = "GTK_SHADOW_" + [ `NONE | `IN | `OUT | `ETCHED_IN | `ETCHED_OUT ] + +type state_type = "GTK_STATE_" + [ `NORMAL | `ACTIVE | `PRELIGHT | `SELECTED | `INSENSITIVE ] + +type submenu_direction = "GTK_DIRECTION_" + [ `LEFT | `RIGHT ] + +type submenu_placement = "GTK_" + [ `TOP_BOTTOM | `LEFT_RIGHT ] + +type toolbar_style = "GTK_TOOLBAR_" + [ `ICONS | `TEXT | `BOTH ] + +type trough_type = "GTK_TROUGH_" + [ `NONE | `START | `END | `JUMP ] + +type update_type = "GTK_UPDATE_" + [ `CONTINUOUS | `DISCONTINUOUS | `DELAYED ] + +type visibility = "GTK_VISIBILITY_" + [ `NONE | `PARTIAL | `FULL ] + +type window_position = "GTK_WIN_POS_" + [ `NONE | `CENTER | `MOUSE | `CENTER_ALWAYS ] + +type window_type = "GTK_WINDOW_" + [ `TOPLEVEL | `DIALOG | `POPUP ] + +type sort_type = "GTK_SORT_" + [ `ASCENDING | `DESCENDING ] + + +type fundamental_type = "GTK_TYPE_" + [ `INVALID | `NONE | `CHAR | `BOOL | `INT | `UINT | `LONG | `ULONG + | `FLOAT | `DOUBLE | `STRING | `ENUM | `FLAGS | `BOXED | `FOREIGN + | `CALLBACK | `ARGS | `POINTER | `SIGNAL | `C_CALLBACK | `OBJECT ] + +type cell_type = "GTK_CELL_" + [ `EMPTY | `TEXT | `PIXMAP | `PIXTEXT | `WIDGET ] + +type toolbar_child = "GTK_TOOLBAR_CHILD_" + [ `SPACE | `BUTTON | `TOGGLEBUTTON | `RADIOBUTTON | `WIDGET ] + +type toolbar_space_style = "GTK_TOOLBAR_SPACE_" + [ `EMPTY | `LINE ] + +type tree_view_mode = "GTK_TREE_VIEW_" + [ `LINE | `ITEM ] + +type spin_type = "GTK_SPIN_" + [ `STEP_FORWARD | `STEP_BACKWARD | `PAGE_FORWARD | `PAGE_BACKWARD + | `HOME | `END | `USER_DEFINED ] + +type accel_flag = "GTK_ACCEL_" + [ `VISIBLE | `SIGNAL_VISIBLE | `LOCKED ] + +type packer_options = "GTK_" + [ `PACK_EXPAND | `FILL_X | `FILL_Y ] + +type side_type = "GTK_SIDE_" + [ `TOP | `BOTTOM | `LEFT | `RIGHT ] + +type anchor_type = "GTK_ANCHOR_" + [ `CENTER | `NORTH | `NW | `NE | `SOUTH | `SW | `SE | `WEST | `EAST ] + +type button_action = "GTK_BUTTON_" + [ `SELECTS | `DRAGS | `EXPANDS ] + +type calendar_display_options = "GTK_CALENDAR_" + [ `SHOW_HEADING | `SHOW_DAY_NAMES | `NO_MONTH_CHANGE | `SHOW_WEEK_NUMBERS + | `WEEK_START_MONDAY ] + +type progress_bar_style = "GTK_PROGRESS_" + [ `CONTINUOUS | `DISCRETE ] + +type progress_bar_orientation = "GTK_PROGRESS_" + [ `LEFT_TO_RIGHT | `RIGHT_TO_LEFT | `BOTTOM_TO_TOP | `TOP_TO_BOTTOM ] + +type dest_defaults = "GTK_DEST_DEFAULT_" + [ `MOTION | `HIGHLIGHT | `DROP | `ALL ] + +type target_flags = "GTK_TARGET_" + [ `SAME_APP | `SAME_WIDGET ] + +type font_metric_type = "GTK_FONT_METRIC_" + [ `PIXELS | `POINTS ] + +type font_type = "GTK_FONT_" + [ `BITMAP | `SCALABLE | `SCALABLE_BITMAP | `ALL ] + +type font_filter_type = "GTK_FONT_FILTER_" + [ `BASE | `USER ] + +(* +type tree_pos = "GTK_CTREE_POS_" + [ `BEFORE | `AS_CHILD | `AFTER ] + +type tree_line_style = "GTK_CTREE_LINES_" + [ `NONE | `SOLID | `DOTTED | `TABBED ] + +type tree_expander_style = "GTK_CTREE_EXPANDER_" + [ `NONE | `SQUARE | `TRIANGLE | `CIRCULAR ] + +type tree_expansion_type = "GTK_CTREE_EXPANSION_" + [ `EXPAND | `EXPAND_RECURSIVE | `COLLAPSE | `COLLAPSE_RECURSIVE + | `TOGGLE | `TOGGLE_RECURSIVE ] +*) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkgl_tags.var b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkgl_tags.var new file mode 100644 index 000000000..57a9f7365 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkgl_tags.var @@ -0,0 +1,19 @@ +(* $Id$ *) + +type visual_options = "GDK_GL_" [ + | `USE_GL + | `BUFFER_SIZE + | `LEVEL + | `RGBA + | `DOUBLEBUFFER + | `STEREO + | `AUX_BUFFERS + | `RED_SIZE + | `GREEN_SIZE + | `BLUE_SIZE + | `ALPHA_SIZE + | `DEPTH_SIZE + | `STENCIL_SIZE + | `ACCUM_GREEN_SIZE + | `ACCUM_ALPHA_SIZE +] diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkxmhtml_tags.var b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkxmhtml_tags.var new file mode 100644 index 000000000..f26206ecf --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/gtkxmhtml_tags.var @@ -0,0 +1,30 @@ +(* $Id$ *) + +type string_direction = "TSTRING_DIRECTION_" [ + | `R_TO_L + | `L_TO_R +] + +type alignment = "TALIGNMENT_" [ + | `END + | `CENTER + | `BEGINNING +] + +type line_type = "LINE_" [ + | `SOLID + | `DASHED + | `SINGLE + | `DOUBLE + | `STRIKE + | `UNDER + | `NONE "NO_LINE" +] + +type dither_type = "Xm" [ + | `QUICK + | `BEST + | `FAST + | `SLOW + | `DISABLED +] diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gdk.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gdk.c new file mode 100644 index 000000000..052625888 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gdk.c @@ -0,0 +1,522 @@ +/* $Id$ */ + +#include +#include +#ifdef _WIN32 +#include +#else +#include +#endif +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "gdk_tags.h" + +void ml_raise_gdk (const char *errmsg) +{ + static value * exn = NULL; + if (exn == NULL) + exn = caml_named_value ("gdkerror"); + raise_with_string (*exn, (char*)errmsg); +} + +#include "gdk_tags.c" + +Make_OptFlags_val (GdkModifier_val) +Make_Flags_val (Event_mask_val) + +#define Make_test(conv) \ +value ml_test_##conv (value mask, value test) \ +{ return Val_bool (conv(mask) & Int_val(test)); } + +Make_test(GdkModifier_val) + +/* Colormap */ + +Make_Val_final_pointer (GdkColormap, gdk_colormap_ref, gdk_colormap_unref, 0) +ML_0 (gdk_colormap_get_system, Val_GdkColormap) + +/* Screen geometry */ +ML_0 (gdk_screen_width, Val_int) +ML_0 (gdk_screen_height, Val_int) + +/* Visual */ +value ml_gdk_visual_get_best (value depth, value type) +{ + GdkVisual *vis; + if (type == Val_unit) + if (depth == Val_unit) vis = gdk_visual_get_best (); + else vis = gdk_visual_get_best_with_depth (Int_val(Field(depth,0))); + else + if (depth == Val_unit) + vis = gdk_visual_get_best_with_type + (GdkVisualType_val(Field(type,0))); + else vis = gdk_visual_get_best_with_both + (Int_val(Field(depth,0)),GdkVisualType_val(Field(type,0))); + if (!vis) ml_raise_gdk("Gdk.Visual.get_best"); + return Val_GdkVisual(vis); +} + +Make_Extractor (GdkVisual,GdkVisual_val,type,Val_gdkVisualType) +Make_Extractor (GdkVisual,GdkVisual_val,depth,Val_int) +Make_Extractor (GdkVisual,GdkVisual_val,red_mask,Val_int) +Make_Extractor (GdkVisual,GdkVisual_val,red_shift,Val_int) +Make_Extractor (GdkVisual,GdkVisual_val,red_prec,Val_int) +Make_Extractor (GdkVisual,GdkVisual_val,green_mask,Val_int) +Make_Extractor (GdkVisual,GdkVisual_val,green_shift,Val_int) +Make_Extractor (GdkVisual,GdkVisual_val,green_prec,Val_int) +Make_Extractor (GdkVisual,GdkVisual_val,blue_mask,Val_int) +Make_Extractor (GdkVisual,GdkVisual_val,blue_shift,Val_int) +Make_Extractor (GdkVisual,GdkVisual_val,blue_prec,Val_int) + +/* Image */ + +Make_Val_final_pointer (GdkImage, Ignore, gdk_image_destroy, 0) +GdkImage *GdkImage_val(value val) +{ + if (!Field(val,1)) ml_raise_gdk ("attempt to use destroyed GdkImage"); + return (GdkImage*)(Field(val,1)); +} +value ml_gdk_image_destroy (value val) +{ + if (Field(val,1)) gdk_image_destroy((GdkImage*)(Field(val,1))); + Field(val,1) = 0; + return Val_unit; +} +ML_4 (gdk_image_new_bitmap, GdkVisual_val, String_val, Int_val, Int_val, + Val_GdkImage) +ML_4 (gdk_image_new, GdkImageType_val, GdkVisual_val, Int_val, Int_val, + Val_GdkImage) +ML_5 (gdk_image_get, GdkWindow_val, Int_val, Int_val, Int_val, Int_val, + Val_GdkImage) +ML_4 (gdk_image_put_pixel, GdkImage_val, Int_val, Int_val, Int_val, Unit) +ML_3 (gdk_image_get_pixel, GdkImage_val, Int_val, Int_val, Val_int) + +/* Color */ + +ML_2 (gdk_colormap_new, GdkVisual_val, Bool_val, Val_GdkColormap) + +value ml_gdk_color_white (value cmap) +{ + GdkColor color; + gdk_color_white (GdkColormap_val(cmap), &color); + return Val_copy(color); +} + +value ml_gdk_color_black (value cmap) +{ + GdkColor color; + gdk_color_black (GdkColormap_val(cmap), &color); + return Val_copy(color); +} + +value ml_gdk_color_parse (char *spec) +{ + GdkColor color; + if (!gdk_color_parse (spec, &color)) + ml_raise_gdk ("color_parse"); + return Val_copy(color); +} + +ML_2 (gdk_color_alloc, GdkColormap_val, GdkColor_val, Val_bool) + +value ml_GdkColor (value red, value green, value blue) +{ + GdkColor color; + color.red = Int_val(red); + color.green = Int_val(green); + color.blue = Int_val(blue); + color.pixel = 0; + return Val_copy(color); +} + +Make_Extractor (GdkColor, GdkColor_val, red, Val_int) +Make_Extractor (GdkColor, GdkColor_val, green, Val_int) +Make_Extractor (GdkColor, GdkColor_val, blue, Val_int) +Make_Extractor (GdkColor, GdkColor_val, pixel, Val_int) + +/* Rectangle */ + +value ml_GdkRectangle (value x, value y, value width, value height) +{ + GdkRectangle rectangle; + rectangle.x = Int_val(x); + rectangle.y = Int_val(y); + rectangle.width = Int_val(width); + rectangle.height = Int_val(height); + return Val_copy(rectangle); +} + +Make_Extractor (GdkRectangle, GdkRectangle_val, x, Val_int) +Make_Extractor (GdkRectangle, GdkRectangle_val, y, Val_int) +Make_Extractor (GdkRectangle, GdkRectangle_val, width, Val_int) +Make_Extractor (GdkRectangle, GdkRectangle_val, height, Val_int) + +/* Window */ + +Make_Val_final_pointer (GdkWindow, gdk_window_ref, gdk_window_unref, 0) +Make_Extractor (gdk_visual_get, GdkVisual_val, depth, Val_int) +ML_1 (gdk_window_get_visual, GdkWindow_val, Val_GdkVisual) +ML_3 (gdk_window_set_back_pixmap, GdkWindow_val, GdkPixmap_val, Int_val, Unit) +ML_1 (gdk_window_clear, GdkWindow_val, Unit) +ML_0 (GDK_ROOT_PARENT, Val_GdkWindow) +ML_1 (gdk_window_get_parent, GdkWindow_val, Val_GdkWindow) +ML_1 (GDK_WINDOW_XWINDOW, GdkWindow_val, Val_XID) +value ml_gdk_window_get_position (value window) +{ + int x, y; + value ret; + + gdk_window_get_position (GdkWindow_val(window), &x, &y); + + ret = alloc_small (2,0); + Field(ret,0) = Val_int(x); + Field(ret,1) = Val_int(y); + return ret; +} + +value ml_gdk_window_get_size (value window) +{ + int x, y; + value ret; + + gdk_window_get_size (GdkWindow_val(window), &x, &y); + + ret = alloc_small (2,0); + Field(ret,0) = Val_int(x); + Field(ret,1) = Val_int(y); + return ret; +} + +/* Cursor */ + +ML_1 (gdk_cursor_new, GdkCursorType_val, Val_GdkCursor) +ML_6 (gdk_cursor_new_from_pixmap, GdkPixmap_val, GdkPixmap_val, + GdkColor_val, GdkColor_val, Int_val, Int_val, Val_GdkCursor) +ML_bc6 (ml_gdk_cursor_new_from_pixmap) +ML_1 (gdk_cursor_destroy, GdkCursor_val, Unit) + +/* Pixmap */ + +Make_Val_final_pointer (GdkPixmap, gdk_pixmap_ref, gdk_pixmap_unref, 0) +Make_Val_final_pointer (GdkBitmap, gdk_bitmap_ref, gdk_bitmap_unref, 0) +Make_Val_final_pointer_ext (GdkPixmap, _no_ref, Ignore, gdk_pixmap_unref, 20) +Make_Val_final_pointer_ext (GdkBitmap, _no_ref, Ignore, gdk_bitmap_unref, 20) +ML_4 (gdk_pixmap_new, GdkWindow_val, Int_val, Int_val, Int_val, + Val_GdkPixmap_no_ref) +ML_4 (gdk_bitmap_create_from_data, GdkWindow_val, + String_val, Int_val, Int_val, Val_GdkBitmap_no_ref) +ML_7 (gdk_pixmap_create_from_data, GdkWindow_val, String_val, + Int_val, Int_val, Int_val, GdkColor_val, GdkColor_val, + Val_GdkPixmap_no_ref) +ML_bc7 (ml_gdk_pixmap_create_from_data) + +value ml_gdk_pixmap_colormap_create_from_xpm + (value window, value colormap, value transparent, char *filename) +{ + CAMLparam0(); + GdkBitmap *mask; + CAMLlocal2(vpixmap, vmask); + value ret; + + vpixmap = Val_GdkPixmap_no_ref + (gdk_pixmap_colormap_create_from_xpm + (GdkWindow_val(window), Option_val(colormap,GdkColormap_val,NULL), + &mask, Option_val(transparent,GdkColor_val,NULL), filename)); + vmask = Val_GdkBitmap_no_ref (mask); + + ret = alloc_small (2,0); + Field(ret,0) = vpixmap; + Field(ret,1) = vmask; + CAMLreturn(ret); +} + +value ml_gdk_pixmap_colormap_create_from_xpm_d + (value window, value colormap, value transparent, char **data) +{ + CAMLparam0(); + GdkBitmap *mask; + CAMLlocal2(vpixmap, vmask); + value ret; + + vpixmap = Val_GdkPixmap_no_ref + (gdk_pixmap_colormap_create_from_xpm_d + (GdkWindow_val(window), Option_val(colormap,GdkColormap_val,NULL), + &mask, Option_val(transparent,GdkColor_val,NULL), data)); + vmask = Val_GdkBitmap_no_ref (mask); + + ret = alloc_small (2, 0); + Field(ret,0) = vpixmap; + Field(ret,1) = vmask; + CAMLreturn(ret); +} + +/* Font */ + +Make_Val_final_pointer (GdkFont, gdk_font_ref, gdk_font_unref, 0) +Make_Val_final_pointer_ext (GdkFont, _no_ref, Ignore, gdk_font_unref, 20) +ML_1 (gdk_font_load, String_val, Val_GdkFont_no_ref) +ML_1 (gdk_fontset_load, String_val, Val_GdkFont_no_ref) +ML_2 (gdk_string_width, GdkFont_val, String_val, Val_int) +ML_2 (gdk_char_width, GdkFont_val, (gchar)Long_val, Val_int) +ML_2 (gdk_string_height, GdkFont_val, String_val, Val_int) +ML_2 (gdk_char_height, GdkFont_val, (gchar)Long_val, Val_int) +ML_2 (gdk_string_measure, GdkFont_val, String_val, Val_int) +ML_2 (gdk_char_measure, GdkFont_val, (char)Long_val, Val_int) +Make_Extractor (GdkFont, GdkFont_val, type, Val_gdkFontType) +Make_Extractor (GdkFont, GdkFont_val, ascent, Val_int) +Make_Extractor (GdkFont, GdkFont_val, descent, Val_int) + +/* Region */ + +#define PointArray_val(val) ((GdkPoint*)&Field(val,1)) +#define PointArrayLen_val(val) Int_val(Field(val,0)) +Make_Val_final_pointer (GdkRegion, Ignore, gdk_region_destroy, 0) +GdkRegion *GdkRegion_val(value val) +{ + if (!Field(val,1)) ml_raise_gdk ("attempt to use destroyed GdkRegion"); + return (GdkRegion*)(Field(val,1)); +} +value ml_gdk_region_destroy (value val) +{ + if (Field(val,1)) gdk_region_destroy((GdkRegion*)(Field(val,1))); + Field(val,1) = 0; + return Val_unit; +} +ML_0 (gdk_region_new, Val_GdkRegion) +ML_2 (gdk_region_polygon, Insert(PointArray_val(arg1)) PointArrayLen_val, + GdkFillRule_val, Val_GdkRegion) +ML_2 (gdk_regions_intersect, GdkRegion_val, GdkRegion_val, Val_GdkRegion) +ML_2 (gdk_regions_union, GdkRegion_val, GdkRegion_val, Val_GdkRegion) +ML_2 (gdk_regions_subtract, GdkRegion_val, GdkRegion_val, Val_GdkRegion) +ML_2 (gdk_regions_xor, GdkRegion_val, GdkRegion_val, Val_GdkRegion) +ML_2 (gdk_region_union_with_rect, GdkRegion_val, GdkRectangle_val, + Val_GdkRegion) +ML_3 (gdk_region_offset, GdkRegion_val, Int_val, Int_val, Unit) +ML_3 (gdk_region_shrink, GdkRegion_val, Int_val, Int_val, Unit) +ML_1 (gdk_region_empty, GdkRegion_val, Val_bool) +ML_2 (gdk_region_equal, GdkRegion_val, GdkRegion_val, Val_bool) +ML_3 (gdk_region_point_in, GdkRegion_val, Int_val, Int_val, Val_bool) +ML_2 (gdk_region_rect_in, GdkRegion_val, GdkRectangle_val, Val_gdkOverlapType) +ML_2 (gdk_region_get_clipbox, GdkRegion_val, GdkRectangle_val, Unit) + + +/* GC */ + +Make_Val_final_pointer (GdkGC, gdk_gc_ref, gdk_gc_unref, 0) +Make_Val_final_pointer_ext (GdkGC, _no_ref, Ignore, gdk_gc_unref, 20) +ML_1 (gdk_gc_new, GdkWindow_val, Val_GdkGC_no_ref) +ML_2 (gdk_gc_set_foreground, GdkGC_val, GdkColor_val, Unit) +ML_2 (gdk_gc_set_background, GdkGC_val, GdkColor_val, Unit) +ML_2 (gdk_gc_set_font, GdkGC_val, GdkFont_val, Unit) +ML_2 (gdk_gc_set_function, GdkGC_val, GdkFunction_val, Unit) +ML_2 (gdk_gc_set_fill, GdkGC_val, GdkFill_val, Unit) +ML_2 (gdk_gc_set_tile, GdkGC_val, GdkPixmap_val, Unit) +ML_2 (gdk_gc_set_stipple, GdkGC_val, GdkPixmap_val, Unit) +ML_3 (gdk_gc_set_ts_origin, GdkGC_val, Int_val, Int_val, Unit) +ML_3 (gdk_gc_set_clip_origin, GdkGC_val, Int_val, Int_val, Unit) +ML_2 (gdk_gc_set_clip_mask, GdkGC_val, GdkBitmap_val, Unit) +ML_2 (gdk_gc_set_clip_rectangle, GdkGC_val, GdkRectangle_val, Unit) +ML_2 (gdk_gc_set_clip_region, GdkGC_val, GdkRegion_val, Unit) +ML_2 (gdk_gc_set_subwindow, GdkGC_val, GdkSubwindowMode_val, Unit) +ML_2 (gdk_gc_set_exposures, GdkGC_val, Bool_val, Unit) +ML_5 (gdk_gc_set_line_attributes, GdkGC_val, Int_val, GdkLineStyle_val, + GdkCapStyle_val, GdkJoinStyle_val, Unit) +ML_2 (gdk_gc_copy, GdkGC_val, GdkGC_val, Unit) +value ml_gdk_gc_get_values (value gc) +{ + CAMLparam0(); + GdkGCValues values; + int i; + CAMLlocal2(ret, tmp); + + gdk_gc_get_values (GdkGC_val(gc), &values); + ret = alloc (18, 0); + tmp = Val_copy(values.foreground); Store_field(ret, 0, tmp); + tmp = Val_copy(values.background); Store_field(ret, 1, tmp); + if (values.font) { + tmp = ml_some(Val_GdkFont(values.font)); + Store_field(ret, 2, tmp); + } + Field(ret,3) = Val_gdkFunction(values.function); + Field(ret,4) = Val_gdkFill(values.fill); + if (values.tile) { + tmp = ml_some(Val_GdkPixmap(values.tile)); + Store_field(ret, 5, tmp); + } + if (values.tile) { + tmp = ml_some(Val_GdkPixmap(values.stipple)); + Store_field(ret, 6, tmp); + } + if (values.tile) { + tmp = ml_some(Val_GdkPixmap(values.clip_mask)); + Store_field(ret, 7, tmp); + } + Field(ret,8) = Val_gdkSubwindowMode(values.subwindow_mode); + Field(ret,9) = Val_int(values.ts_x_origin); + Field(ret,10) = Val_int(values.ts_y_origin); + Field(ret,11) = Val_int(values.clip_x_origin); + Field(ret,12) = Val_int(values.clip_y_origin); + Field(ret,13) = Val_bool(values.graphics_exposures); + Field(ret,14) = Val_int(values.line_width); + Field(ret,15) = Val_gdkLineStyle(values.line_style); + Field(ret,16) = Val_gdkCapStyle(values.cap_style); + Field(ret,17) = Val_gdkJoinStyle(values.join_style); + CAMLreturn(ret); +} + +/* Draw */ + +value ml_point_array_new (value len) +{ + value ret = alloc (1 + Wosize_asize(Int_val(len)*sizeof(GdkPoint)), + Abstract_tag); + Field(ret,0) = len; + return ret; +} +value ml_point_array_set (value arr, value pos, value x, value y) +{ + GdkPoint *pt = PointArray_val(arr) + Int_val(pos); + pt->x = Int_val(x); + pt->y = Int_val(y); + return Val_unit; +} + +ML_4 (gdk_draw_point, GdkDrawable_val, GdkGC_val, Int_val, Int_val, Unit) +ML_6 (gdk_draw_line, GdkDrawable_val, GdkGC_val, Int_val, Int_val, + Int_val, Int_val, Unit) +ML_bc6 (ml_gdk_draw_line) +ML_7 (gdk_draw_rectangle, GdkDrawable_val, GdkGC_val, Bool_val, + Int_val, Int_val, Int_val, Int_val, Unit) +ML_bc7 (ml_gdk_draw_rectangle) +ML_9 (gdk_draw_arc, GdkDrawable_val, GdkGC_val, Bool_val, Int_val, Int_val, + Int_val, Int_val, Int_val, Int_val, Unit) +ML_bc9 (ml_gdk_draw_arc) +ML_4 (gdk_draw_polygon, GdkDrawable_val, GdkGC_val, Bool_val, + Insert(PointArray_val(arg4)) PointArrayLen_val, Unit) +ML_6 (gdk_draw_string, GdkDrawable_val, GdkFont_val, GdkGC_val, Int_val, Int_val, String_val, Unit) +ML_bc6 (ml_gdk_draw_string) + +ML_9 (gdk_draw_image, GdkDrawable_val, GdkGC_val, GdkImage_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) +ML_bc9 (ml_gdk_draw_image) + +/* RGB */ + +ML_0 (gdk_rgb_init, Unit) +ML_0 (gdk_rgb_get_visual, Val_GdkVisual) +ML_0 (gdk_rgb_get_cmap, Val_GdkColormap) + +/* Events */ + +/* Have a major collection every 1000 events */ +Make_Val_final_pointer (GdkEvent, Ignore, gdk_event_free, 1) +ML_1 (gdk_event_copy, GdkEvent_val, Val_GdkEvent) + +value ml_gdk_event_new (value event_type) +{ + GdkEvent event; + memset (&event, 0, sizeof(GdkEvent)); + event.type = GdkEventType_val(event_type); + event.any.send_event = TRUE; + return Val_copy(event); +} + +#define GdkEvent_arg(type) (GdkEvent##type*)GdkEvent_val + +Make_Extractor (GdkEventAny, GdkEvent_arg(Any), type, Val_gdkEventType) +Make_Extractor (GdkEventAny, GdkEvent_arg(Any), window, Val_GdkWindow) +Make_Extractor (GdkEventAny, GdkEvent_arg(Any), send_event, Val_bool) +Make_Setter (gdk_event_set, GdkEvent_arg(Any), GdkEventType_val, type) +Make_Setter (gdk_event_set, GdkEvent_arg(Any), GdkWindow_val, window) + +Make_Extractor (GdkEventExpose, GdkEvent_arg(Expose), area, Val_copy) +Make_Extractor (GdkEventExpose, GdkEvent_arg(Expose), count, Val_int) + +Make_Extractor (GdkEventVisibility, GdkEvent_arg(Visibility), state, + Val_gdkVisibilityState) + +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), time, Val_int) +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), x, copy_double) +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), y, copy_double) +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), pressure, copy_double) +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), xtilt, copy_double) +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), ytilt, copy_double) +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), state, Val_int) +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), is_hint, Val_int) +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), source, Val_gdkInputSource) +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), deviceid, Val_int) +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), x_root, copy_double) +Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), y_root, copy_double) + +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), time, Val_int) +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), x, copy_double) +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), y, copy_double) +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), pressure, copy_double) +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), xtilt, copy_double) +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), ytilt, copy_double) +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), state, Val_int) +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), button, Val_int) +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), source, Val_gdkInputSource) +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), deviceid, Val_int) +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), x_root, copy_double) +Make_Extractor (GdkEventButton, GdkEvent_arg(Button), y_root, copy_double) + +Make_Setter (gdk_event_button_set, GdkEvent_arg(Button), Int_val, button) + +Make_Extractor (GdkEventKey, GdkEvent_arg(Key), time, Val_int) +Make_Extractor (GdkEventKey, GdkEvent_arg(Key), state, Val_int) +Make_Extractor (GdkEventKey, GdkEvent_arg(Key), keyval, Val_int) +Make_Extractor (GdkEventKey, GdkEvent_arg(Key), string, Val_string) + +Make_Extractor (GdkEventCrossing, GdkEvent_arg(Crossing), subwindow, + Val_GdkWindow) +Make_Extractor (GdkEventCrossing, GdkEvent_arg(Crossing), detail, + Val_gdkNotifyType) + +Make_Extractor (GdkEventFocus, GdkEvent_arg(Focus), in, Val_int) + +Make_Extractor (GdkEventConfigure, GdkEvent_arg(Configure), x, Val_int) +Make_Extractor (GdkEventConfigure, GdkEvent_arg(Configure), y, Val_int) +Make_Extractor (GdkEventConfigure, GdkEvent_arg(Configure), width, Val_int) +Make_Extractor (GdkEventConfigure, GdkEvent_arg(Configure), height, Val_int) + +Make_Extractor (GdkEventProperty, GdkEvent_arg(Property), atom, Val_int) +Make_Extractor (GdkEventProperty, GdkEvent_arg(Property), time, Val_int) +Make_Extractor (GdkEventProperty, GdkEvent_arg(Property), state, Val_int) + +Make_Extractor (GdkEventSelection, GdkEvent_arg(Selection), selection, Val_int) +Make_Extractor (GdkEventSelection, GdkEvent_arg(Selection), target, Val_int) +Make_Extractor (GdkEventSelection, GdkEvent_arg(Selection), property, Val_int) +Make_Extractor (GdkEventSelection, GdkEvent_arg(Selection), requestor, Val_int) +Make_Extractor (GdkEventSelection, GdkEvent_arg(Selection), time, Val_int) + +Make_Extractor (GdkEventProximity, GdkEvent_arg(Proximity), time, Val_int) +Make_Extractor (GdkEventProximity, GdkEvent_arg(Proximity), source, + Val_gdkInputSource) +Make_Extractor (GdkEventProximity, GdkEvent_arg(Proximity), deviceid, Val_int) + +/* DnD */ +Make_Val_final_pointer (GdkDragContext, gdk_drag_context_ref, gdk_drag_context_unref, 0) +Make_Flags_val (GdkDragAction_val) +ML_3 (gdk_drag_status, GdkDragContext_val, Flags_GdkDragAction_val, Int_val, Unit) +Make_Extractor (GdkDragContext, GdkDragContext_val, suggested_action, Val_gdkDragAction) +value val_int(gpointer i) +{ + return Val_int (GPOINTER_TO_INT(i)); +} +value ml_GdkDragContext_targets (value c) +{ + GList *t; + + t = (GdkDragContext_val(c))->targets; + return Val_GList (t, val_int); +} + +/* Misc */ +ML_0 (gdk_flush, Unit) +ML_0 (gdk_beep, Unit) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gdk.h b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gdk.h new file mode 100644 index 000000000..5d699ace2 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gdk.h @@ -0,0 +1,53 @@ +/* $Id$ */ + +#define GdkColormap_val(val) ((GdkColormap*)Pointer_val(val)) +extern value Val_GdkColormap (GdkColormap *); + +#define GdkColor_val(val) ((GdkColor*)MLPointer_val(val)) +#define Val_GdkColor Val_pointer + +#define GdkRectangle_val(val) ((GdkRectangle*)MLPointer_val(val)) +#define Val_GdkRectangle Val_pointer + +#define GdkDrawable_val(val) ((GdkDrawable*)Pointer_val(val)) + +#define GdkWindow_val(val) ((GdkWindow*)Pointer_val(val)) +extern value Val_GdkWindow (GdkWindow *); + +#define GdkCursor_val(val) ((GdkCursor*)Pointer_val(val)) +#define Val_GdkCursor Val_pointer + +#define GdkPixmap_val(val) ((GdkPixmap*)Pointer_val(val)) +extern value Val_GdkPixmap (GdkPixmap *); + +#define GdkBitmap_val(val) ((GdkBitmap*)Pointer_val(val)) +extern value Val_GdkBitmap (GdkBitmap *); + +extern GdkImage *GdkImage_val (value); /* check argument */ +extern value Val_GdkImage (GdkImage *); /* finalizer is destroy! */ + +#define GdkFont_val(val) ((GdkFont*)Pointer_val(val)) +extern value Val_GdkFont (GdkFont *); + +extern GdkRegion *GdkRegion_val (value); /* check argument */ +extern value Val_GdkRegion (GdkRegion *); /* finalizer is destroy! */ + +#define GdkGC_val(val) ((GdkGC*)Pointer_val(val)) +extern value Val_GdkGC (GdkGC *); + +#define GdkEvent_val (GdkEvent*)MLPointer_val + +#define GdkVisual_val(val) ((GdkVisual*) val) +#define Val_GdkVisual(visual) ((value) visual) + +#define Val_XID copy_int32 +#define XID_val Int32_val + +extern int OptFlags_GdkModifier_val (value); +extern int Flags_Event_mask_val (value); +extern lookup_info ml_table_extension_events[]; +#define Extension_events_val(key) ml_lookup_to_c (ml_table_extension_events, key) + +#define GdkDragContext_val(val) ((GdkDragContext*)Pointer_val(val)) +extern value Val_GdkDragContext (GdkDragContext *); +extern int Flags_GdkDragAction_val (value); diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_glib.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_glib.c new file mode 100644 index 000000000..a93bb586f --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_glib.c @@ -0,0 +1,143 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" + +value copy_string_and_free (char *str) +{ + value res; + res = copy_string_check (str); + g_free (str); + return res; +} + +value Val_GList (GList *list, value (*func)(gpointer)) +{ + value new_cell, result, last_cell, cell; + + if (list == NULL) return Val_unit; + + last_cell = cell = Val_unit; + result = func(list->data); + Begin_roots3 (last_cell, cell, result); + cell = last_cell = alloc_small(2,0); + Field(cell,0) = result; + Field(cell,1) = Val_unit; + list = list->next; + while (list != NULL) { + result = func(list->data); + new_cell = alloc_small(2,0); + Field(new_cell,0) = result; + Field(new_cell,1) = Val_unit; + modify(&Field(last_cell,1), new_cell); + last_cell = new_cell; + list = list->next; + } + End_roots (); + return cell; +} + +GList *GList_val (value list, gpointer (*func)(value)) +{ + CAMLparam1(list); + GList *res = NULL; + if (list == Val_unit) CAMLreturn (res); + for (; Is_block(list); list = Field(list,1)) + res = g_list_append (res, func(Field(list,0))); + CAMLreturn (res); +} + +static value ml_warning_handler = 0L; + +static void ml_warning_wrapper (const gchar *msg) +{ + value arg = copy_string ((char*)msg); + callback (ml_warning_handler, arg); +} + +value ml_g_set_warning_handler (value clos) +{ + value old_handler = ml_warning_handler ? ml_warning_handler : clos; + if (!ml_warning_handler) register_global_root (&ml_warning_handler); + g_set_warning_handler (ml_warning_wrapper); + ml_warning_handler = clos; + return old_handler; +} + +static value ml_print_handler = 0L; + +static void ml_print_wrapper (const gchar *msg) +{ + value arg = copy_string ((char*)msg); + callback (ml_print_handler, arg); +} + +value ml_g_set_print_handler (value clos) +{ + value old_handler = ml_print_handler ? ml_print_handler : clos; + if (!ml_print_handler) register_global_root (&ml_print_handler); + g_set_print_handler (ml_print_wrapper); + ml_print_handler = clos; + return old_handler; +} + +value ml_get_null (value unit) { return 0L; } + +#define GMainLoop_val(val) ((GMainLoop*)Addr_val(val)) +ML_1 (g_main_new, Bool_val, Val_addr) +ML_1 (g_main_iteration, Bool_val, Val_bool) +ML_0 (g_main_pending, Val_bool) +ML_1 (g_main_is_running, GMainLoop_val, Val_bool) +ML_1 (g_main_quit, GMainLoop_val, Unit) +ML_1 (g_main_destroy, GMainLoop_val, Unit) + +/* +value Val_GSList (GSList *list, value (*func)(gpointer)) +{ + value new_cell, result, last_cell, cell; + + if (list == NULL) return Val_unit; + + last_cell = cell = Val_unit; + result = func(list->data); + Begin_roots3 (last_cell, cell, result); + cell = last_cell = alloc_tuple (2); + Field(cell,0) = result; + Field(cell,1) = Val_unit; + list = list->next; + while (list != NULL) { + result = func(list->data); + new_cell = alloc_tuple(2); + Field(new_cell,0) = result; + Field(new_cell,1) = Val_unit; + modify(&Field(last_cell,1), new_cell); + last_cell = new_cell; + list = list->next; + } + End_roots (); + return cell; +} + +GSList *GSList_val (value list, gpointer (*func)(value)) +{ + GSList *res = NULL; + GSList **current = &res; + value cell = list; + if (list == Val_unit) return res; + Begin_root (cell); + while (cell != Val_unit) { + *current = g_slist_alloc (); + (*current)->data = func(Field(cell,0)); + cell = Field(cell,1); + current = &(*current)->next; + } + End_roots (); + return res; +} +*/ diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_glib.h b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_glib.h new file mode 100644 index 000000000..10f31ca7f --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_glib.h @@ -0,0 +1,10 @@ +/* $Id$ */ + +value copy_string_and_free (char *str); /* for g_strings only */ +value Val_GList (GList *list, value (*func)(gpointer)); +GList *GList_val (value list, gpointer (*func)(value)); + +/* +value Val_GSList (GSList *list, value (*func)(gpointer)); +GSList *GSList_val (value list, gpointer (*func)(value)); +*/ diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtk.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtk.c new file mode 100644 index 000000000..271f09405 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtk.c @@ -0,0 +1,1013 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtk_tags.h" + +void ml_raise_gtk (const char *errmsg) +{ + static value * exn = NULL; + if (exn == NULL) + exn = caml_named_value ("gtkerror"); + raise_with_string (*exn, (char*)errmsg); +} + +/* conversion functions */ + +#include "gtk_tags.c" + +ML_1 (Val_direction_type, Int_val, Id) +ML_1 (Val_orientation, Int_val, Id) +ML_1 (Val_toolbar_style, Int_val, Id) +ML_1 (Val_state_type, Int_val, Id) +ML_1 (Val_scroll_type, Int_val, Id) + +static Make_Flags_val (Dest_defaults_val) +static Make_Flags_val (Target_flags_val) +static Make_Flags_val (Font_type_val) + +/* gtkobject.h */ + +Make_Val_final_pointer(GtkObject, gtk_object_ref, gtk_object_unref, 0) + +#define gtk_object_ref_and_sink(w) (gtk_object_ref(w), gtk_object_sink(w)) +Make_Val_final_pointer_ext(GtkObject, _sink , gtk_object_ref_and_sink, + gtk_object_unref, 20) + +/* gtkaccelgroup.h */ + +Make_Val_final_pointer (GtkAccelGroup, gtk_accel_group_ref, + gtk_accel_group_unref, 0) +Make_Val_final_pointer_ext (GtkAccelGroup, _no_ref, Ignore, + gtk_accel_group_unref, 20) +Make_OptFlags_val (Accel_flag_val) + +#define Signal_name_val(val) String_val(Field(val,0)) + +ML_0 (gtk_accel_group_new, Val_GtkAccelGroup_no_ref) +ML_0 (gtk_accel_group_get_default, Val_GtkAccelGroup) +ML_3 (gtk_accel_group_activate, GtkAccelGroup_val, Int_val, + OptFlags_GdkModifier_val, Val_bool) +ML_3 (gtk_accel_groups_activate, GtkObject_val, Int_val, + OptFlags_GdkModifier_val, Val_bool) +ML_2 (gtk_accel_group_attach, GtkAccelGroup_val, GtkObject_val, Unit) +ML_2 (gtk_accel_group_detach, GtkAccelGroup_val, GtkObject_val, Unit) +ML_1 (gtk_accel_group_lock, GtkAccelGroup_val, Unit) +ML_1 (gtk_accel_group_unlock, GtkAccelGroup_val, Unit) +ML_3 (gtk_accel_group_lock_entry, GtkAccelGroup_val, Int_val, + OptFlags_GdkModifier_val, Unit) +ML_3 (gtk_accel_group_unlock_entry, GtkAccelGroup_val, Int_val, + OptFlags_GdkModifier_val, Unit) +ML_6 (gtk_accel_group_add, GtkAccelGroup_val, Int_val, + OptFlags_GdkModifier_val, OptFlags_Accel_flag_val, + GtkObject_val, Signal_name_val, Unit) +ML_bc6 (ml_gtk_accel_group_add) +ML_4 (gtk_accel_group_remove, GtkAccelGroup_val, Int_val, + OptFlags_GdkModifier_val, GtkObject_val, Unit) +ML_2 (gtk_accelerator_valid, Int_val, OptFlags_GdkModifier_val, Val_bool) +ML_1 (gtk_accelerator_set_default_mod_mask, OptFlags_GdkModifier_val, Unit) + +/* gtkstyle.h */ + +Make_Val_final_pointer (GtkStyle, gtk_style_ref, gtk_style_unref, 0) +Make_Val_final_pointer_ext (GtkStyle, _no_ref, Ignore, gtk_style_unref, 20) +ML_0 (gtk_style_new, Val_GtkStyle_no_ref) +ML_1 (gtk_style_copy, GtkStyle_val, Val_GtkStyle_no_ref) +ML_2 (gtk_style_attach, GtkStyle_val, GdkWindow_val, Val_GtkStyle) +ML_1 (gtk_style_detach, GtkStyle_val, Unit) +ML_3 (gtk_style_set_background, GtkStyle_val, GdkWindow_val, State_type_val, Unit) +ML_6 (gtk_draw_hline, GtkStyle_val, GdkWindow_val, State_type_val, + Int_val, Int_val, Int_val, Unit) +ML_bc6 (ml_gtk_draw_hline) +ML_6 (gtk_draw_vline, GtkStyle_val, GdkWindow_val, State_type_val, + Int_val, Int_val, Int_val, Unit) +ML_bc6 (ml_gtk_draw_vline) +Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, bg, Val_copy) +Make_Array_Setter (gtk_style_set, GtkStyle_val, State_type_val, *GdkColor_val, bg) +Make_Extractor (gtk_style_get, GtkStyle_val, colormap, Val_GdkColormap) +Make_Extractor (gtk_style_get, GtkStyle_val, depth, Val_int) +Make_Extractor (gtk_style_get, GtkStyle_val, font, Val_GdkFont) +/* Make_Setter (gtk_style_set, GtkStyle_val, GdkFont_val, font) */ +value ml_gtk_style_set_font (value st, value font) +{ + GtkStyle *style = GtkStyle_val(st); + if (style->font) gdk_font_unref(style->font); + style->font = GdkFont_val(font); + gdk_font_ref(style->font); + return Val_unit; +} +Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, dark_gc, Val_GdkGC) +Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, light_gc, Val_GdkGC) + +/* gtktypeutils.h */ + +ML_1 (gtk_type_name, Int_val, Val_string) +ML_1 (gtk_type_from_name, String_val, Val_int) +ML_1 (gtk_type_parent, Int_val, Val_int) +ML_1 (gtk_type_class, Int_val, (value)) +ML_1 (gtk_type_parent_class, Int_val, (value)) +ML_2 (gtk_type_is_a, Int_val, Int_val, Val_bool) +value ml_gtk_type_fundamental (value type) +{ + return Val_fundamental_type (GTK_FUNDAMENTAL_TYPE (Int_val(type))); +} + +/* gtkobject.h */ + +/* ML_1 (GTK_OBJECT_TYPE, GtkObject_val, Val_int) */ +value ml_gtk_object_type (value val) +{ + return Val_int (GtkObject_val(val)->klass->type); +} + +ML_1 (gtk_object_destroy, GtkObject_val, Unit) +ML_1 (gtk_object_ref, GtkObject_val, Unit) +ML_1 (gtk_object_unref, GtkObject_val, Unit) +ML_1 (gtk_object_sink, GtkObject_val, Unit) + +Make_Extractor (gtk_class,(GtkObjectClass *),type,Val_int) + +/* gtkdata.h */ + +/* gtkadjustment.h */ + +ML_6 (gtk_adjustment_new, Float_val, Float_val, Float_val, Float_val, + Float_val, Float_val, Val_GtkObject_sink) +ML_bc6 (ml_gtk_adjustment_new) +ML_2 (gtk_adjustment_set_value, GtkAdjustment_val, Float_val, Unit) +ML_3 (gtk_adjustment_clamp_page, GtkAdjustment_val, + Float_val, Float_val, Unit) +Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, lower, copy_double) +Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, upper, copy_double) +Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, value, copy_double) +Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, step_increment, + copy_double) +Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, page_increment, + copy_double) +Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, page_size, copy_double) + +/* gtktooltips.h */ + +#define GtkTooltips_val(val) check_cast(GTK_TOOLTIPS,val) +ML_0 (gtk_tooltips_new, Val_GtkAny) +ML_1 (gtk_tooltips_enable, GtkTooltips_val, Unit) +ML_1 (gtk_tooltips_disable, GtkTooltips_val, Unit) +ML_2 (gtk_tooltips_set_delay, GtkTooltips_val, Int_val, Unit) +ML_4 (gtk_tooltips_set_tip, GtkTooltips_val, GtkWidget_val, + String_option_val, String_option_val, Unit) +ML_3 (gtk_tooltips_set_colors, GtkTooltips_val, + Option_val(arg2, GdkColor_val, NULL) Ignore, + Option_val(arg3, GdkColor_val, NULL) Ignore, + Unit) + +/* gtkwidget.h */ + +value ml_gtk_widget_set_can_default (value val, value bool) +{ + GtkWidget *w = GtkWidget_val(val); + guint32 saved_flags = GTK_WIDGET_FLAGS(w); + if (Bool_val(bool)) GTK_WIDGET_SET_FLAGS(w, GTK_CAN_DEFAULT); + else GTK_WIDGET_UNSET_FLAGS(w, GTK_CAN_DEFAULT); + if (saved_flags != GTK_WIDGET_FLAGS(w)) + gtk_widget_queue_resize (w); + return Val_unit; +} +value ml_gtk_widget_set_can_focus (value val, value bool) +{ + GtkWidget *w = GtkWidget_val(val); + guint32 saved_flags = GTK_WIDGET_FLAGS(w); + if (Bool_val(bool)) GTK_WIDGET_SET_FLAGS(w, GTK_CAN_FOCUS); + else GTK_WIDGET_UNSET_FLAGS(w, GTK_CAN_FOCUS); + if (saved_flags != GTK_WIDGET_FLAGS(w)) + gtk_widget_queue_resize (w); + return Val_unit; +} +ML_1 (gtk_widget_unparent, GtkWidget_val, Unit) +ML_1 (gtk_widget_show, GtkWidget_val, Unit) +ML_1 (gtk_widget_show_now, GtkWidget_val, Unit) +ML_1 (gtk_widget_show_all, GtkWidget_val, Unit) +ML_1 (gtk_widget_hide, GtkWidget_val, Unit) +ML_1 (gtk_widget_hide_all, GtkWidget_val, Unit) +ML_1 (gtk_widget_map, GtkWidget_val, Unit) +ML_1 (gtk_widget_unmap, GtkWidget_val, Unit) +ML_1 (gtk_widget_realize, GtkWidget_val, Unit) +ML_1 (gtk_widget_unrealize, GtkWidget_val, Unit) +ML_1 (gtk_widget_queue_draw, GtkWidget_val, Unit) +ML_1 (gtk_widget_queue_resize, GtkWidget_val, Unit) +ML_2 (gtk_widget_draw, GtkWidget_val, + Option_val(arg2,GdkRectangle_val,NULL) Ignore, Unit) +ML_1 (gtk_widget_draw_focus, GtkWidget_val, Unit) +ML_1 (gtk_widget_draw_default, GtkWidget_val, Unit) +/* ML_1 (gtk_widget_draw_children, GtkWidget_val, Unit) */ +ML_2 (gtk_widget_event, GtkWidget_val, GdkEvent_val, Val_bool) +ML_1 (gtk_widget_activate, GtkWidget_val, Val_bool) +ML_2 (gtk_widget_reparent, GtkWidget_val, GtkWidget_val, Unit) +ML_3 (gtk_widget_popup, GtkWidget_val, Int_val, Int_val, Unit) +value ml_gtk_widget_intersect (value w, value area) +{ + GdkRectangle inter; + if (gtk_widget_intersect(GtkWidget_val(w), GdkRectangle_val(area), &inter)) + return ml_some (Val_copy (inter)); + return Val_unit; +} +/* ML_1 (gtk_widget_basic, GtkWidget_val, Val_bool) */ +ML_1 (gtk_widget_grab_focus, GtkWidget_val, Unit) +ML_1 (gtk_widget_grab_default, GtkWidget_val, Unit) +ML_2 (gtk_widget_set_name, GtkWidget_val, String_val, Unit) +ML_1 (gtk_widget_get_name, GtkWidget_val, Val_string) +ML_2 (gtk_widget_set_state, GtkWidget_val, State_type_val, Unit) +ML_2 (gtk_widget_set_sensitive, GtkWidget_val, Bool_val, Unit) +ML_3 (gtk_widget_set_uposition, GtkWidget_val, Int_val, Int_val, Unit) +ML_3 (gtk_widget_set_usize, GtkWidget_val, Int_val, Int_val, Unit) +ML_2 (gtk_widget_add_events, GtkWidget_val, Flags_Event_mask_val, Unit) +ML_2 (gtk_widget_set_events, GtkWidget_val, Flags_Event_mask_val, Unit) +ML_2 (gtk_widget_set_extension_events, GtkWidget_val, Extension_events_val, + Unit) +ML_1 (gtk_widget_get_toplevel, GtkWidget_val, Val_GtkWidget) +ML_2 (gtk_widget_get_ancestor, GtkWidget_val, Int_val, Val_GtkWidget) +ML_1 (gtk_widget_get_colormap, GtkWidget_val, Val_GdkColormap) +ML_1 (gtk_widget_get_visual, GtkWidget_val, (value)) +value ml_gtk_widget_get_pointer (value w) +{ + int x,y; + value ret; + gtk_widget_get_pointer (GtkWidget_val(w), &x, &y); + ret = alloc_small (2,0); + Field(ret,0) = Val_int(x); + Field(ret,1) = Val_int(y); + return ret; +} +ML_2 (gtk_widget_is_ancestor, GtkWidget_val, GtkWidget_val, Val_bool) +/* ML_2 (gtk_widget_is_child, GtkWidget_val, GtkWidget_val, Val_bool) */ +ML_2 (gtk_widget_set_style, GtkWidget_val, GtkStyle_val, Unit) +ML_1 (gtk_widget_set_rc_style, GtkWidget_val, Unit) +ML_1 (gtk_widget_ensure_style, GtkWidget_val, Unit) +ML_1 (gtk_widget_get_style, GtkWidget_val, Val_GtkStyle) +ML_1 (gtk_widget_restore_default_style, GtkWidget_val, Unit) + +ML_6 (gtk_widget_add_accelerator, GtkWidget_val, Signal_name_val, + GtkAccelGroup_val, Char_val, OptFlags_GdkModifier_val, + OptFlags_Accel_flag_val, Unit) +ML_bc6 (ml_gtk_widget_add_accelerator) +ML_4 (gtk_widget_remove_accelerator, GtkWidget_val, GtkAccelGroup_val, + Char_val, OptFlags_GdkModifier_val, Unit) +ML_1 (gtk_widget_lock_accelerators, GtkWidget_val, Unit) +ML_1 (gtk_widget_unlock_accelerators, GtkWidget_val, Unit) +ML_1 (gtk_widget_accelerators_locked, GtkWidget_val, Val_bool) + +ML_1 (GTK_WIDGET_VISIBLE, GtkWidget_val, Val_bool) +ML_1 (GTK_WIDGET_HAS_FOCUS, GtkWidget_val, Val_bool) + +Make_Extractor (GtkWidget, GtkWidget_val, window, Val_GdkWindow) +Make_Extractor (gtk_widget, GtkWidget_val, parent, Val_GtkWidget) +static value Val_GtkAllocation (GtkAllocation allocation) +{ + value ret = alloc_small (4, 0); + Field(ret,0) = Val_int(allocation.x); + Field(ret,1) = Val_int(allocation.y); + Field(ret,2) = Val_int(allocation.width); + Field(ret,3) = Val_int(allocation.height); + return ret; +} +Make_Extractor (gtk_widget, GtkWidget_val, allocation, Val_GtkAllocation) +/* +#define GtkAllocation_val(val) ((GtkAllocation*)Pointer_val(val)) +Make_Extractor (gtk_allocation, GtkAllocation_val, x, Val_int) +Make_Extractor (gtk_allocation, GtkAllocation_val, y, Val_int) +Make_Extractor (gtk_allocation, GtkAllocation_val, width, Val_int) +Make_Extractor (gtk_allocation, GtkAllocation_val, height, Val_int) +*/ + +ML_2 (gtk_widget_set_app_paintable, GtkWidget_val, Bool_val, Unit) + +ML_2 (gtk_widget_set_visual, GtkWidget_val, GdkVisual_val, Unit) +ML_2 (gtk_widget_set_colormap, GtkWidget_val, GdkColormap_val, Unit) +ML_1 (gtk_widget_set_default_visual, GdkVisual_val, Unit) +ML_1 (gtk_widget_set_default_colormap, GdkColormap_val, Unit) +ML_0 (gtk_widget_get_default_visual, Val_GdkVisual) +ML_0 (gtk_widget_get_default_colormap, Val_GdkColormap) +ML_1 (gtk_widget_push_visual, GdkVisual_val, Unit) +ML_1 (gtk_widget_push_colormap, GdkColormap_val, Unit) +ML_0 (gtk_widget_pop_visual, Unit) +ML_0 (gtk_widget_pop_colormap, Unit) + +/* gtkdnd.h */ + +value ml_gtk_drag_dest_set (value w, value f, value t, value a) +{ + GtkTargetEntry *targets = (GtkTargetEntry *)Val_unit; + int n_targets, i; + + CAMLparam4 (w,f,t,a); + n_targets = Wosize_val(t); + if (n_targets) + targets = (GtkTargetEntry *) + alloc (Wosize_asize(n_targets * sizeof(GtkTargetEntry)), + Abstract_tag); + for (i=0; ilength < 0) ml_raise_null_pointer(); + ret = alloc_string (data->length); + if (data->length) memcpy ((void*)ret, data->data, data->length); + return ret; +} + +ML_4 (gtk_selection_data_set, GtkSelectionData_val, Int_val, Int_val, + Insert((guchar*)String_option_val(arg4)) + Option_val(arg4, string_length, -1) Ignore, + Unit) + +/* gtkcontainer.h */ + +#define GtkContainer_val(val) check_cast(GTK_CONTAINER,val) +ML_2 (gtk_container_set_border_width, GtkContainer_val, Int_val, Unit) +ML_2 (gtk_container_set_resize_mode, GtkContainer_val, Resize_mode_val, Unit) +ML_2 (gtk_container_add, GtkContainer_val, GtkWidget_val, Unit) +ML_2 (gtk_container_remove, GtkContainer_val, GtkWidget_val, Unit) +static void ml_gtk_simple_callback (GtkWidget *w, gpointer data) +{ + value val, *clos = (value*)data; + val = Val_GtkWidget(w); + callback (*clos, val); +} +value ml_gtk_container_foreach (value w, value clos) +{ + CAMLparam1(clos); + gtk_container_foreach (GtkContainer_val(w), ml_gtk_simple_callback, + &clos); + CAMLreturn(Val_unit); +} +ML_1 (gtk_container_register_toplevel, GtkContainer_val, Unit) +ML_1 (gtk_container_unregister_toplevel, GtkContainer_val, Unit) +ML_2 (gtk_container_focus, GtkContainer_val, Direction_type_val, Val_bool) +ML_2 (gtk_container_set_focus_child, GtkContainer_val, GtkWidget_val, Unit) +ML_2 (gtk_container_set_focus_vadjustment, GtkContainer_val, + GtkAdjustment_val, Unit) +ML_2 (gtk_container_set_focus_hadjustment, GtkContainer_val, + GtkAdjustment_val, Unit) + +/* gtkdialog.h */ + +static void window_unref (GtkObject *w) +{ + /* If the window exists and is still not visible, then unreference twice. + This should be enough to destroy it. */ + if (!GTK_OBJECT_DESTROYED(w) && !GTK_WIDGET_VISIBLE(w)) + gtk_object_unref (w); + gtk_object_unref (w); +} +Make_Val_final_pointer_ext (GtkObject, _window, gtk_object_ref, window_unref, + 20) +#define Val_GtkWidget_window(w) Val_GtkObject_window((GtkObject*)w) + +#define GtkDialog_val(val) check_cast(GTK_DIALOG,val) +ML_0 (gtk_dialog_new, Val_GtkWidget_window) +Make_Extractor (GtkDialog, GtkDialog_val, action_area, Val_GtkWidget) +Make_Extractor (GtkDialog, GtkDialog_val, vbox, Val_GtkWidget) + +/* gtkinputdialog.h */ + +ML_0 (gtk_input_dialog_new, Val_GtkWidget_window) + +/* gtkfileselection.h */ + +#define GtkFileSelection_val(val) check_cast(GTK_FILE_SELECTION,val) +ML_1 (gtk_file_selection_new, String_val, Val_GtkWidget_window) +ML_2 (gtk_file_selection_set_filename, GtkFileSelection_val, String_val, Unit) +ML_1 (gtk_file_selection_get_filename, GtkFileSelection_val, Val_string) +ML_1 (gtk_file_selection_show_fileop_buttons, GtkFileSelection_val, Unit) +ML_1 (gtk_file_selection_hide_fileop_buttons, GtkFileSelection_val, Unit) +Make_Extractor (gtk_file_selection_get, GtkFileSelection_val, ok_button, + Val_GtkWidget) +Make_Extractor (gtk_file_selection_get, GtkFileSelection_val, cancel_button, + Val_GtkWidget) +Make_Extractor (gtk_file_selection_get, GtkFileSelection_val, help_button, + Val_GtkWidget) + +/* gtkwindow.h */ + +#define GtkWindow_val(val) check_cast(GTK_WINDOW,val) +ML_1 (gtk_window_new, Window_type_val, Val_GtkWidget_window) +ML_2 (gtk_window_set_title, GtkWindow_val, String_val, Unit) +ML_3 (gtk_window_set_wmclass, GtkWindow_val, String_val, String_val, Unit) +Make_Extractor (gtk_window_get, GtkWindow_val, wmclass_name, Val_optstring) +Make_Extractor (gtk_window_get, GtkWindow_val, wmclass_class, Val_optstring) +ML_2 (gtk_window_set_focus, GtkWindow_val, GtkWidget_val, Unit) +ML_2 (gtk_window_set_default, GtkWindow_val, GtkWidget_val, Unit) +ML_4 (gtk_window_set_policy, GtkWindow_val, Bool_val, Bool_val, Bool_val, Unit) +Make_Extractor (gtk_window_get, GtkWindow_val, allow_shrink, Val_bool) +Make_Extractor (gtk_window_get, GtkWindow_val, allow_grow, Val_bool) +Make_Extractor (gtk_window_get, GtkWindow_val, auto_shrink, Val_bool) +ML_2 (gtk_window_add_accel_group, GtkWindow_val, + GtkAccelGroup_val, Unit) +ML_2 (gtk_window_remove_accel_group, GtkWindow_val, + GtkAccelGroup_val, Unit) +ML_1 (gtk_window_activate_focus, GtkWindow_val, Val_bool) +ML_1 (gtk_window_activate_default, GtkWindow_val, Val_bool) +ML_2 (gtk_window_set_modal, GtkWindow_val, Bool_val, Unit) +ML_3 (gtk_window_set_default_size, GtkWindow_val, Int_val, Int_val, Unit) +ML_2 (gtk_window_set_position, GtkWindow_val, Window_position_val, Unit) +ML_2 (gtk_window_set_transient_for, GtkWindow_val, GtkWindow_val, Unit) + +/* gtkcolorsel.h */ + +#define GtkColorSelection_val(val) check_cast(GTK_COLOR_SELECTION,val) +#define GtkColorSelectionDialog_val(val) check_cast(GTK_COLOR_SELECTION_DIALOG,val) +ML_0 (gtk_color_selection_new, Val_GtkWidget_sink) +ML_2 (gtk_color_selection_set_update_policy, GtkColorSelection_val, + Update_type_val, Unit) +ML_2 (gtk_color_selection_set_opacity, GtkColorSelection_val, + Bool_val, Unit) +value ml_gtk_color_selection_set_color (value w, value red, value green, + value blue, value opacity) +{ + double color[4]; + color[0] = Double_val(red); + color[1] = Double_val(green); + color[2] = Double_val(blue); + color[3] = Option_val(opacity,Double_val,0.0); + gtk_color_selection_set_color (GtkColorSelection_val(w), color); + return Val_unit; +} +value ml_gtk_color_selection_get_color (value w) +{ + value ret; + double color[4]; + color[3] = 0.0; + gtk_color_selection_get_color (GtkColorSelection_val(w), color); + ret = alloc (4*Double_wosize, Double_array_tag); + Store_double_field (ret, 0, color[0]); + Store_double_field (ret, 1, color[1]); + Store_double_field (ret, 2, color[2]); + Store_double_field (ret, 3, color[3]); + return ret; +} +ML_1 (gtk_color_selection_dialog_new, String_val, Val_GtkWidget_window) +Make_Extractor (gtk_color_selection_dialog, GtkColorSelectionDialog_val, ok_button, Val_GtkWidget) +Make_Extractor (gtk_color_selection_dialog, GtkColorSelectionDialog_val, cancel_button, Val_GtkWidget) +Make_Extractor (gtk_color_selection_dialog, GtkColorSelectionDialog_val, help_button, Val_GtkWidget) +Make_Extractor (gtk_color_selection_dialog, GtkColorSelectionDialog_val, colorsel, Val_GtkWidget) + +/* gtkfontsel.h */ + +#define GtkFontSelection_val(val) \ + check_cast(GTK_FONT_SELECTION,val) +ML_0 (gtk_font_selection_new, Val_GtkWidget_sink) +ML_1 (gtk_font_selection_get_font, GtkFontSelection_val, + Val_GdkFont) +ML_1 (gtk_font_selection_get_font_name, GtkFontSelection_val, + copy_string_check) +ML_2 (gtk_font_selection_set_font_name, GtkFontSelection_val, + String_val, Val_bool) +ML_9 (gtk_font_selection_set_filter, GtkFontSelection_val, + Font_filter_type_val, Flags_Font_type_val, + (gchar**), (gchar**), (gchar**), + (gchar**), (gchar**), (gchar**), Unit) +ML_bc9 (ml_gtk_font_selection_set_filter) +ML_1 (gtk_font_selection_get_preview_text, GtkFontSelection_val, + copy_string) +ML_2 (gtk_font_selection_set_preview_text, GtkFontSelection_val, + String_val, Unit) + +#define GtkFontSelectionDialog_val(val) \ + check_cast(GTK_FONT_SELECTION_DIALOG,val) +ML_1 (gtk_font_selection_dialog_new, String_option_val, Val_GtkWidget_window) +/* +ML_1 (gtk_font_selection_dialog_get_font, GtkFontSelectionDialog_val, + Val_GdkFont) +ML_1 (gtk_font_selection_dialog_get_font_name, GtkFontSelectionDialog_val, + copy_string_check) +ML_2 (gtk_font_selection_dialog_set_font_name, GtkFontSelectionDialog_val, + String_val, Val_bool) +ML_9 (gtk_font_selection_dialog_set_filter, GtkFontSelectionDialog_val, + Font_filter_type_val, Flags_Font_type_val, + (gchar**), (gchar**), (gchar**), + (gchar**), (gchar**), (gchar**), Unit) +ML_bc9 (ml_gtk_font_selection_dialog_set_filter) +ML_1 (gtk_font_selection_dialog_get_preview_text, GtkFontSelectionDialog_val, + copy_string) +ML_2 (gtk_font_selection_dialog_set_preview_text, GtkFontSelectionDialog_val, + String_val, Unit) +*/ +Make_Extractor (gtk_font_selection_dialog, GtkFontSelectionDialog_val, + fontsel, Val_GtkWidget) +Make_Extractor (gtk_font_selection_dialog, GtkFontSelectionDialog_val, + ok_button, Val_GtkWidget) +Make_Extractor (gtk_font_selection_dialog, GtkFontSelectionDialog_val, + apply_button, Val_GtkWidget) +Make_Extractor (gtk_font_selection_dialog, GtkFontSelectionDialog_val, + cancel_button, Val_GtkWidget) + +/* gtkplug.h */ + +ML_1 (gtk_plug_new, XID_val, Val_GtkWidget_window) + +/* gtkctree.h */ +#define GtkCTree_val(val) check_cast(GTK_CTREE,val) +/* Beware: this definition axpects arg1 to be a GtkCTree */ +/* +#define GtkCTreeNode_val(val) \ + (gtk_ctree_find(GtkCTree_val(arg1),NULL,(GtkCTreeNode*)(val-1)) \ + ? (GtkCTreeNode*)(val-1) : (ml_raise_gtk ("Bad GtkCTreeNode"), NULL)) +#define Val_GtkCTreeNode Val_addr +ML_2 (gtk_ctree_new, Int_val, Int_val, Val_GtkWidget_sink) +ML_3 (gtk_ctree_new_with_titles, Int_val, Int_val, (char **), + Val_GtkWidget_sink) +ML_11 (gtk_ctree_insert_node, GtkCTree_val, GtkCTreeNode_val, + GtkCTreeNode_val, (char**), Int_val, GdkPixmap_val, GdkBitmap_val, + GdkPixmap_val, GdkBitmap_val, Bool_val, Bool_val, + Val_GtkCTreeNode) +ML_2 (gtk_ctree_remove_node, GtkCTree_val, GtkCTreeNode_val, Unit) +ML_2 (gtk_ctree_is_viewable, GtkCTree_val, GtkCTreeNode_val, Val_bool) +*/ + +/* gtkpreview.h */ +/* +#define GtkPreview_val(val) GTK_PREVIEW(Pointer_val(val)) +ML_1 (gtk_preview_new, Preview_val, Val_GtkWidget_sink) +ML_3 (gtk_preview_size, GtkPreview_val, Int_val, Int_val, Unit) +ML_9 (gtk_preview_put, GtkPreview_val, GdkWindow_val, GdkGC_val, + Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) +ML_bc9 (ml_gtk_preview_put) +*/ + +/* gtkmain.h */ + +value ml_gtk_init (value argv) +{ + CAMLparam1 (argv); + int argc = Wosize_val(argv), i; + CAMLlocal1 (copy); + + copy = (argc ? alloc (argc, Abstract_tag) : Atom(0)); + for (i = 0; i < argc; i++) Field(copy,i) = Field(argv,i); + gtk_init (&argc, (char ***)©); + + argv = (argc ? alloc (argc, 0) : Atom(0)); + for (i = 0; i < argc; i++) modify(&Field(argv,i), Field(copy,i)); + CAMLreturn (argv); +} +ML_1 (gtk_exit, Int_val, Unit) +ML_0 (gtk_set_locale, Val_string) +ML_0 (gtk_main, Unit) +ML_1 (gtk_main_iteration_do, Bool_val, Val_bool) +ML_0 (gtk_main_quit, Unit) +ML_1 (gtk_grab_add, GtkWidget_val, Unit) +ML_1 (gtk_grab_remove, GtkWidget_val, Unit) +ML_0 (gtk_grab_get_current, Val_GtkWidget) +value ml_gtk_get_version (value unit) +{ + value ret = alloc_small(3,0); + Field(ret,0) = Val_int(gtk_major_version); + Field(ret,1) = Val_int(gtk_minor_version); + Field(ret,2) = Val_int(gtk_micro_version); + return ret; +} + +/* Marshalling */ + +void ml_gtk_callback_marshal (GtkObject *object, gpointer data, + guint nargs, GtkArg *args) +{ + value vargs = alloc_small(3,0); + + CAMLparam1 (vargs); + Field(vargs,0) = (value) object; + Field(vargs,1) = Val_int(nargs); + Field(vargs,2) = (value) args; + + callback (*(value*)data, vargs); + + Field(vargs,0) = Val_int(-1); + Field(vargs,1) = Val_int(-1); + CAMLreturn0; +} + +value ml_gtk_arg_shift (GtkArg *args, value index) +{ + return (value) (&args[Int_val(index)]); +} + +value ml_gtk_arg_get_type (GtkArg *arg) +{ + return Val_int (arg->type); +} + +value ml_gtk_arg_get (GtkArg *arg) +{ + CAMLparam0(); + CAMLlocal1(tmp); + value ret = Val_unit; + GtkFundamentalType type = GTK_FUNDAMENTAL_TYPE(arg->type); + int tag; + + switch (type) { + case GTK_TYPE_CHAR: + tag = 0; + tmp = Int_val(GTK_VALUE_CHAR(*arg)); + break; + case GTK_TYPE_BOOL: + tag = 1; + tmp = Val_bool(GTK_VALUE_BOOL(*arg)); + break; + case GTK_TYPE_INT: + case GTK_TYPE_ENUM: + case GTK_TYPE_UINT: + case GTK_TYPE_FLAGS: + tag = 2; + tmp = Val_int (GTK_VALUE_INT(*arg)); break; + case GTK_TYPE_LONG: + case GTK_TYPE_ULONG: + tag = 2; + tmp = Val_int (GTK_VALUE_LONG(*arg)); break; + case GTK_TYPE_FLOAT: + tag = 3; + tmp = copy_double ((double)GTK_VALUE_FLOAT(*arg)); break; + case GTK_TYPE_DOUBLE: + tag = 3; + tmp = copy_double (GTK_VALUE_DOUBLE(*arg)); break; + case GTK_TYPE_STRING: + tag = 4; + tmp = Val_option (GTK_VALUE_STRING(*arg), copy_string); break; + case GTK_TYPE_OBJECT: + tag = 5; + tmp = Val_option (GTK_VALUE_OBJECT(*arg), Val_GtkObject); break; + case GTK_TYPE_BOXED: + case GTK_TYPE_POINTER: + tag = 6; + tmp = Val_option (GTK_VALUE_POINTER(*arg), Val_pointer); break; + default: + tag = -1; + } + if (tag != -1) { + ret = alloc_small(1,tag); + Field(ret,0) = tmp; + } + CAMLreturn(ret); +} + +value ml_gtk_arg_set_retloc (GtkArg *arg, value val) +{ + value type = Fundamental_type_val(Is_block(val) ? Field(val,0) : val); + value data = (Is_block(val) ? Field(val,1) : 0); + if (GTK_FUNDAMENTAL_TYPE(arg->type) != GTK_TYPE_POINTER + && GTK_FUNDAMENTAL_TYPE(arg->type) != type) + ml_raise_gtk ("GtkArgv.Arg.set : argument type mismatch"); + switch (type) { + case GTK_TYPE_CHAR: *GTK_RETLOC_CHAR(*arg) = Int_val(data); break; + case GTK_TYPE_BOOL: *GTK_RETLOC_BOOL(*arg) = Int_val(data); break; + case GTK_TYPE_INT: + case GTK_TYPE_ENUM: *GTK_RETLOC_INT(*arg) = Int_val(data); break; + case GTK_TYPE_UINT: + case GTK_TYPE_FLAGS: *GTK_RETLOC_UINT(*arg) = Int32_val(data); break; + case GTK_TYPE_LONG: + case GTK_TYPE_ULONG: *GTK_RETLOC_LONG(*arg) = Nativeint_val(data); break; + case GTK_TYPE_FLOAT: *GTK_RETLOC_FLOAT(*arg) = Float_val(data); break; + case GTK_TYPE_DOUBLE: *GTK_RETLOC_DOUBLE(*arg) = Double_val(data); break; + case GTK_TYPE_STRING: + *GTK_RETLOC_STRING(*arg) = Option_val(data, String_val, NULL); + break; + case GTK_TYPE_BOXED: + case GTK_TYPE_POINTER: + case GTK_TYPE_OBJECT: + *GTK_RETLOC_POINTER(*arg) = Option_val(data, Pointer_val, NULL); + break; + } + return Val_unit; +} + +/* +value ml_gtk_arg_get_char (GtkArg *arg) +{ + if (GTK_FUNDAMENTAL_TYPE(arg->type) != GTK_TYPE_CHAR) + ml_raise_gtk ("argument type mismatch"); + return Val_char (GTK_VALUE_CHAR(*arg)); +} + +value ml_gtk_arg_get_bool (GtkArg *arg) +{ + if (GTK_FUNDAMENTAL_TYPE(arg->type) != GTK_TYPE_BOOL) + ml_raise_gtk ("argument type mismatch"); + return Val_bool (GTK_VALUE_BOOL(*arg)); +} + +value ml_gtk_arg_get_int (GtkArg *arg) +{ + switch (GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_INT: + case GTK_TYPE_UINT: + return Val_int (GTK_VALUE_INT(*arg)); + case GTK_TYPE_LONG: + case GTK_TYPE_ULONG: + return Val_long (GTK_VALUE_LONG(*arg)); + case GTK_TYPE_ENUM: + return Val_int (GTK_VALUE_ENUM(*arg)); + case GTK_TYPE_FLAGS: + return Val_int (GTK_VALUE_FLAGS(*arg)); + default: + ml_raise_gtk ("argument type mismatch"); + } + return Val_unit; +} +*/ +value ml_gtk_arg_get_nativeint(GtkArg *arg) { + + switch(GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_INT: + case GTK_TYPE_UINT: + return copy_nativeint (GTK_VALUE_INT(*arg)); + case GTK_TYPE_LONG: + case GTK_TYPE_ULONG: + return copy_nativeint (GTK_VALUE_LONG(*arg)); + case GTK_TYPE_ENUM: + return copy_nativeint (GTK_VALUE_ENUM(*arg)); + case GTK_TYPE_FLAGS: + return copy_nativeint (GTK_VALUE_FLAGS(*arg)); + default: + ml_raise_gtk ("argument type mismatch"); + } + return Val_unit; +} +/* +value ml_gtk_arg_get_float (GtkArg *arg) +{ + switch (GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_FLOAT: + return copy_double ((double)GTK_VALUE_FLOAT(*arg)); + case GTK_TYPE_DOUBLE: + return copy_double (GTK_VALUE_DOUBLE(*arg)); + default: + ml_raise_gtk ("argument type mismatch"); + } + return Val_unit; +} + +value ml_gtk_arg_get_string (GtkArg *arg) +{ + char *p; + if (GTK_FUNDAMENTAL_TYPE(arg->type) != GTK_TYPE_STRING) + ml_raise_gtk ("argument type mismatch"); + p = GTK_VALUE_STRING(*arg); + return Val_option (p, copy_string); +} +*/ +value ml_gtk_arg_get_pointer (GtkArg *arg) +{ + gpointer p = NULL; + switch (GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_STRING: + case GTK_TYPE_BOXED: + case GTK_TYPE_POINTER: + case GTK_TYPE_OBJECT: + p = GTK_VALUE_POINTER(*arg); break; + default: + ml_raise_gtk ("GtkArgv.get_pointer : argument type mismatch"); + } + return Val_pointer(p); +} +/* +value ml_gtk_arg_get_object (GtkArg *arg) +{ + GtkObject *p; + if (GTK_FUNDAMENTAL_TYPE(arg->type) != GTK_TYPE_OBJECT) + ml_raise_gtk ("argument type mismatch"); + p = GTK_VALUE_OBJECT(*arg); + return Val_option (p, Val_GtkObject); +} +*/ + +value ml_string_at_pointer (value ofs, value len, value ptr) +{ + char *start = ((char*)Pointer_val(ptr)) + Option_val(ofs, Int_val, 0); + int length = Option_val(len, Int_val, strlen(start)); + value ret = alloc_string(length); + memcpy ((char*)ret, start, length); + return ret; +} + +value ml_int_at_pointer (value ptr) +{ + return Val_int(*(int*)Pointer_val(ptr)); +} + +/* +value ml_gtk_arg_set_char (GtkArg *arg, value val) +{ + switch (GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_POINTER: + case GTK_TYPE_CHAR: + *GTK_RETLOC_CHAR(*arg) = Char_val(val); break; + default: + ml_raise_gtk ("argument type mismatch"); + } + return Val_unit; +} + +value ml_gtk_arg_set_bool (GtkArg *arg, value val) +{ + switch (GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_POINTER: + case GTK_TYPE_BOOL: + *GTK_RETLOC_BOOL(*arg) = Bool_val(val); break; + default: + ml_raise_gtk ("argument type mismatch"); + } + return Val_unit; +} + +value ml_gtk_arg_set_int (GtkArg *arg, value val) +{ + switch (GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_POINTER: + case GTK_TYPE_INT: + case GTK_TYPE_UINT: + *GTK_RETLOC_INT(*arg) = Int_val(val); break; + case GTK_TYPE_LONG: + case GTK_TYPE_ULONG: + *GTK_RETLOC_LONG(*arg) = Long_val(val); break; + case GTK_TYPE_ENUM: + *GTK_RETLOC_ENUM(*arg) = Int_val(val); break; + case GTK_TYPE_FLAGS: + *GTK_RETLOC_FLAGS(*arg) = Int_val(val); break; + default: + ml_raise_gtk ("argument type mismatch"); + } + return Val_unit; +} + +value ml_gtk_arg_set_nativeint (GtkArg *arg, value val) +{ + switch (GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_POINTER: + case GTK_TYPE_INT: + case GTK_TYPE_UINT: + *GTK_RETLOC_INT(*arg) = Nativeint_val(val); break; + case GTK_TYPE_LONG: + case GTK_TYPE_ULONG: + *GTK_RETLOC_LONG(*arg) = Nativeint_val(val); break; + case GTK_TYPE_ENUM: + *GTK_RETLOC_ENUM(*arg) = Nativeint_val(val); break; + case GTK_TYPE_FLAGS: + *GTK_RETLOC_FLAGS(*arg) = Nativeint_val(val); break; + default: + ml_raise_gtk ("argument type mismatch"); + } + return Val_unit; +} + +value ml_gtk_arg_set_float (GtkArg *arg, value val) +{ + switch (GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_POINTER: + case GTK_TYPE_FLOAT: + *GTK_RETLOC_FLOAT(*arg) = (float) Double_val(val); break; + case GTK_TYPE_DOUBLE: + *GTK_RETLOC_DOUBLE(*arg) = Double_val(val); break; + default: + ml_raise_gtk ("argument type mismatch"); + } + return Val_unit; +} + +value ml_gtk_arg_set_string (GtkArg *arg, value val) +{ + switch (GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_POINTER: + case GTK_TYPE_STRING: + *GTK_RETLOC_STRING(*arg) = String_val(val); break; + default: + ml_raise_gtk ("argument type mismatch"); + } + return Val_unit; +} + +value ml_gtk_arg_set_pointer (GtkArg *arg, value val) +{ + switch (GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_BOXED: + *GTK_RETLOC_BOXED(*arg) = Pointer_val(val); break; + case GTK_TYPE_POINTER: + *GTK_RETLOC_POINTER(*arg) = Pointer_val(val); break; + default: + ml_raise_gtk ("argument type mismatch"); + } + return Val_unit; +} + +value ml_gtk_arg_set_object (GtkArg *arg, value val) +{ + switch (GTK_FUNDAMENTAL_TYPE(arg->type)) { + case GTK_TYPE_POINTER: + case GTK_TYPE_OBJECT: + *GTK_RETLOC_OBJECT(*arg) = GtkObject_val(val); break; + default: + ml_raise_gtk ("argument type mismatch"); + } + return Val_unit; +} +*/ + +/* gtksignal.h */ + +value ml_gtk_signal_connect (value object, value name, value clos, value after) +{ + value *clos_p = ml_global_root_new (clos); + return Val_int (gtk_signal_connect_full + (GtkObject_val(object), String_val(name), NULL, + ml_gtk_callback_marshal, clos_p, + ml_global_root_destroy, FALSE, Bool_val(after))); +} + +ML_2 (gtk_signal_disconnect, GtkObject_val, Int_val, Unit) +ML_2 (gtk_signal_emit_stop_by_name, GtkObject_val, String_val, Unit) +ML_2 (gtk_signal_handler_block, GtkObject_val, Int_val, Unit) +ML_2 (gtk_signal_handler_unblock, GtkObject_val, Int_val, Unit) +ML_2_name (ml_gtk_signal_emit_none, gtk_signal_emit_by_name, + GtkObject_val, String_val, Unit) +ML_3_name (ml_gtk_signal_emit_int, gtk_signal_emit_by_name, + GtkObject_val, String_val, Int_val, Unit) +ML_4_name (ml_gtk_signal_emit_scroll, gtk_signal_emit_by_name, + GtkObject_val, String_val, Scroll_type_val, Double_val, Unit) + +/* gtkmain.h (again) */ + +value ml_gtk_timeout_add (value interval, value clos) +{ + value *clos_p = ml_global_root_new (clos); + return Val_int (gtk_timeout_add_full + (Int_val(interval), NULL, ml_gtk_callback_marshal, clos_p, + ml_global_root_destroy)); +} +ML_1 (gtk_timeout_remove, Int_val, Unit) + +ML_1 (gtk_rc_add_default_file, String_val, Unit) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtk.h b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtk.h new file mode 100644 index 000000000..eac3f6ea5 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtk.h @@ -0,0 +1,24 @@ +/* $Id$ */ + +#define GtkObject_val(obj) ((GtkObject*)Field(obj,1)) +value Val_GtkObject (GtkObject *w); +value Val_GtkObject_sink (GtkObject *w); +#define GtkAccelGroup_val(val) ((GtkAccelGroup*)Pointer_val(val)) +value Val_GtkAccelGroup (GtkAccelGroup *); +#define GtkStyle_val(val) ((GtkStyle*)Pointer_val(val)) +value Val_GtkStyle (GtkStyle *); + +#define Val_GtkAny(w) Val_GtkObject((GtkObject*)w) +#define Val_GtkAny_sink(w) Val_GtkObject_sink((GtkObject*)w) +#define Val_GtkWidget Val_GtkAny +#define Val_GtkWidget_sink Val_GtkAny_sink + +#ifdef GTK_NO_CHECK_CASTS +#define check_cast(f,v) f(Pointer_val(v)) +#else +#define check_cast(f,v) (Pointer_val(v) == NULL ? NULL : f(Pointer_val(v))) +#endif + +#define GtkWidget_val(val) check_cast(GTK_WIDGET,val) +#define GtkAdjustment_val(val) check_cast(GTK_ADJUSTMENT,val) +#define GtkItem_val(val) check_cast(GTK_ITEM,val) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkbin.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkbin.c new file mode 100644 index 000000000..9b797a6c9 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkbin.c @@ -0,0 +1,118 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtk_tags.h" + +/* gtkalignment.h */ + +#define GtkAlignment_val(val) check_cast(GTK_ALIGNMENT,val) +ML_4 (gtk_alignment_new, Float_val, Float_val, Float_val, Float_val, + Val_GtkWidget_sink) +value ml_gtk_alignment_set (value x, value y, + value xscale, value yscale, value val) +{ + GtkAlignment *alignment = GtkAlignment_val(val); + gtk_alignment_set (alignment, + Option_val(x, Float_val, alignment->xalign), + Option_val(y, Float_val, alignment->yalign), + Option_val(xscale, Float_val, alignment->xscale), + Option_val(yscale, Float_val, alignment->xscale)); + return Val_unit; +} + +/* gtkeventbox.h */ + +ML_0 (gtk_event_box_new, Val_GtkWidget_sink) + +/* gtkframe.h */ + +#define GtkFrame_val(val) check_cast(GTK_FRAME,val) +ML_1 (gtk_frame_new, Optstring_val, Val_GtkWidget_sink) +ML_2 (gtk_frame_set_label, GtkFrame_val, Optstring_val, Unit) +ML_3 (gtk_frame_set_label_align, GtkFrame_val, Float_val, Float_val, Unit) +ML_2 (gtk_frame_set_shadow_type, GtkFrame_val, Shadow_type_val, Unit) +Make_Extractor (gtk_frame_get, GtkFrame_val, label_xalign, copy_double) +Make_Extractor (gtk_frame_get, GtkFrame_val, label_yalign, copy_double) + +/* gtkaspectframe.h */ + +#define GtkAspectFrame_val(val) check_cast(GTK_ASPECT_FRAME,val) +ML_5 (gtk_aspect_frame_new, Optstring_val, + Float_val, Float_val, Float_val, Bool_val, Val_GtkWidget_sink) +ML_5 (gtk_aspect_frame_set, GtkAspectFrame_val, Float_val, Float_val, + Float_val, Bool_val, Unit) +Make_Extractor (gtk_aspect_frame_get, GtkAspectFrame_val, xalign, copy_double) +Make_Extractor (gtk_aspect_frame_get, GtkAspectFrame_val, yalign, copy_double) +Make_Extractor (gtk_aspect_frame_get, GtkAspectFrame_val, ratio, copy_double) +Make_Extractor (gtk_aspect_frame_get, GtkAspectFrame_val, obey_child, Val_bool) + +/* gtkhandlebox.h */ + +#define GtkHandleBox_val(val) check_cast(GTK_HANDLE_BOX,val) +ML_0 (gtk_handle_box_new, Val_GtkWidget_sink) +ML_2 (gtk_handle_box_set_shadow_type, GtkHandleBox_val, Shadow_type_val, Unit) +ML_2 (gtk_handle_box_set_handle_position, GtkHandleBox_val, Position_val, Unit) +ML_2 (gtk_handle_box_set_snap_edge, GtkHandleBox_val, Position_val, Unit) + +/* gtkinvisible.h */ +/* private class +ML_0 (gtk_invisible_new, Val_GtkWidget_sink) +*/ + +/* gtkitem.h */ + +ML_1 (gtk_item_select, GtkItem_val, Unit) +ML_1 (gtk_item_deselect, GtkItem_val, Unit) +ML_1 (gtk_item_toggle, GtkItem_val, Unit) + +/* gtkviewport.h */ + +#define GtkViewport_val(val) check_cast(GTK_VIEWPORT,val) +ML_2 (gtk_viewport_new, GtkAdjustment_val, GtkAdjustment_val, + Val_GtkWidget_sink) +ML_1 (gtk_viewport_get_hadjustment, GtkViewport_val, Val_GtkWidget_sink) +ML_1 (gtk_viewport_get_vadjustment, GtkViewport_val, Val_GtkWidget) +ML_2 (gtk_viewport_set_hadjustment, GtkViewport_val, GtkAdjustment_val, Unit) +ML_2 (gtk_viewport_set_vadjustment, GtkViewport_val, GtkAdjustment_val, Unit) +ML_2 (gtk_viewport_set_shadow_type, GtkViewport_val, Shadow_type_val, Unit) + +/* gtkscrolledwindow.h */ + +#define GtkScrolledWindow_val(val) check_cast(GTK_SCROLLED_WINDOW,val) +ML_2 (gtk_scrolled_window_new, GtkAdjustment_val ,GtkAdjustment_val, + Val_GtkWidget_sink) +ML_2 (gtk_scrolled_window_set_hadjustment, GtkScrolledWindow_val , + GtkAdjustment_val, Unit) +ML_2 (gtk_scrolled_window_set_vadjustment, GtkScrolledWindow_val , + GtkAdjustment_val, Unit) +ML_1 (gtk_scrolled_window_get_hadjustment, GtkScrolledWindow_val, + Val_GtkWidget) +ML_1 (gtk_scrolled_window_get_vadjustment, GtkScrolledWindow_val, + Val_GtkWidget) +ML_3 (gtk_scrolled_window_set_policy, GtkScrolledWindow_val, + Policy_type_val, Policy_type_val, Unit) +Make_Extractor (gtk_scrolled_window_get, GtkScrolledWindow_val, + hscrollbar_policy, Val_policy_type) +Make_Extractor (gtk_scrolled_window_get, GtkScrolledWindow_val, + vscrollbar_policy, Val_policy_type) +ML_2 (gtk_scrolled_window_set_placement, GtkScrolledWindow_val, + Corner_type_val, Unit) +ML_2 (gtk_scrolled_window_add_with_viewport, GtkScrolledWindow_val, + GtkWidget_val, Unit) + +/* gtksocket.h */ + +#define GtkSocket_val(val) check_cast(GTK_SOCKET,val) +ML_0 (gtk_socket_new, Val_GtkWidget_sink) +ML_2 (gtk_socket_steal, GtkSocket_val, XID_val, Unit) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkbutton.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkbutton.c new file mode 100644 index 000000000..a718305e6 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkbutton.c @@ -0,0 +1,75 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtk_tags.h" + +/* gtkbutton.h */ + +#define GtkButton_val(val) check_cast(GTK_BUTTON,val) +ML_0 (gtk_button_new, Val_GtkWidget_sink) +ML_1 (gtk_button_new_with_label, String_val, Val_GtkWidget_sink) +ML_1 (gtk_button_pressed, GtkButton_val, Unit) +ML_1 (gtk_button_released, GtkButton_val, Unit) +ML_1 (gtk_button_clicked, GtkButton_val, Unit) +ML_1 (gtk_button_enter, GtkButton_val, Unit) +ML_1 (gtk_button_leave, GtkButton_val, Unit) + +/* gtktogglebutton.h */ + +#define GtkToggleButton_val(val) check_cast(GTK_TOGGLE_BUTTON,val) +ML_0 (gtk_toggle_button_new, Val_GtkWidget_sink) +ML_1 (gtk_toggle_button_new_with_label, String_val, Val_GtkWidget_sink) +ML_2 (gtk_toggle_button_set_mode, GtkToggleButton_val, Bool_val, Unit) +ML_2 (gtk_toggle_button_set_active, GtkToggleButton_val, Bool_val, Unit) +ML_1 (gtk_toggle_button_toggled, GtkToggleButton_val, Unit) +Make_Extractor (gtk_toggle_button_get, GtkToggleButton_val, active, Val_bool) + +/* gtkcheckbutton.h */ + +#define GtkCheckButton_val(val) check_cast(GTK_CHECK_BUTTON,val) +ML_0 (gtk_check_button_new, Val_GtkWidget_sink) +ML_1 (gtk_check_button_new_with_label, String_val, Val_GtkWidget_sink) + +/* gtkradiobutton.h */ + +#define GtkRadioButton_val(val) check_cast(GTK_RADIO_BUTTON,val) +static GSList* button_group_val(value val) +{ + return (val == Val_unit ? NULL : + gtk_radio_button_group(GtkRadioButton_val(Field(val,0)))); +} +ML_1 (gtk_radio_button_new, button_group_val, + Val_GtkWidget_sink) +ML_2 (gtk_radio_button_new_with_label, button_group_val, + String_val, Val_GtkWidget_sink) +ML_2 (gtk_radio_button_set_group, GtkRadioButton_val, button_group_val, Unit) + +/* gtktoolbar.h */ + +#define GtkToolbar_val(val) check_cast(GTK_TOOLBAR,val) +ML_2 (gtk_toolbar_new, Orientation_val, Toolbar_style_val, Val_GtkWidget_sink) +ML_2 (gtk_toolbar_insert_space, GtkToolbar_val, Int_val, Unit) +ML_7 (gtk_toolbar_insert_element, GtkToolbar_val, Toolbar_child_val, + Insert(NULL) Optstring_val, Optstring_val, Optstring_val, GtkWidget_val, + Insert(NULL) Insert(NULL) Int_val, Val_GtkWidget) +ML_bc7 (ml_gtk_toolbar_insert_element) +ML_5 (gtk_toolbar_insert_widget, GtkToolbar_val, GtkWidget_val, + Optstring_val, Optstring_val, Int_val, Unit) +ML_2 (gtk_toolbar_set_orientation, GtkToolbar_val, Orientation_val, Unit) +ML_2 (gtk_toolbar_set_style, GtkToolbar_val, Toolbar_style_val, Unit) +ML_2 (gtk_toolbar_set_space_size, GtkToolbar_val, Int_val, Unit) +ML_2 (gtk_toolbar_set_space_style, GtkToolbar_val, Toolbar_space_style_val, Unit) +ML_2 (gtk_toolbar_set_tooltips, GtkToolbar_val, Bool_val, Unit) +ML_2 (gtk_toolbar_set_button_relief, GtkToolbar_val, Relief_style_val, Unit) +ML_1 (gtk_toolbar_get_button_relief, GtkToolbar_val, Val_relief_style) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkedit.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkedit.c new file mode 100644 index 000000000..1c64ec2c7 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkedit.c @@ -0,0 +1,126 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtk_tags.h" + +/* gtkeditable.h */ + +#define GtkEditable_val(val) check_cast(GTK_EDITABLE,val) +ML_3 (gtk_editable_select_region, GtkEditable_val, Int_val, Int_val, Unit) +value ml_gtk_editable_insert_text (value w, value s, value pos) +{ + int position = Int_val(pos); + gtk_editable_insert_text (GtkEditable_val(w), String_val(s), + string_length(s), &position); + return Val_int(position); +} +ML_3 (gtk_editable_delete_text, GtkEditable_val, Int_val, Int_val, Unit) +ML_3 (gtk_editable_get_chars, GtkEditable_val, Int_val, Int_val, + copy_string_and_free) +ML_1 (gtk_editable_cut_clipboard, GtkEditable_val, Unit) +ML_1 (gtk_editable_copy_clipboard, GtkEditable_val, Unit) +ML_1 (gtk_editable_paste_clipboard, GtkEditable_val, Unit) +ML_3 (gtk_editable_claim_selection, GtkEditable_val, Bool_val, Int_val, Unit) +ML_1 (gtk_editable_delete_selection, GtkEditable_val, Unit) +ML_1 (gtk_editable_changed, GtkEditable_val, Unit) +ML_2 (gtk_editable_set_position, GtkEditable_val, Int_val, Unit) +ML_1 (gtk_editable_get_position, GtkEditable_val, Val_int) +ML_2 (gtk_editable_set_editable, GtkEditable_val, Bool_val, Unit) +Make_Extractor (gtk_editable, GtkEditable_val, selection_start_pos, Val_int) +Make_Extractor (gtk_editable, GtkEditable_val, selection_end_pos, Val_int) +Make_Extractor (gtk_editable, GtkEditable_val, has_selection, Val_bool) + +/* gtkentry.h */ + +#define GtkEntry_val(val) check_cast(GTK_ENTRY,val) +ML_0 (gtk_entry_new, Val_GtkWidget_sink) +ML_1 (gtk_entry_new_with_max_length, (gint16)Long_val, Val_GtkWidget_sink) +ML_2 (gtk_entry_set_text, GtkEntry_val, String_val, Unit) +ML_2 (gtk_entry_append_text, GtkEntry_val, String_val, Unit) +ML_2 (gtk_entry_prepend_text, GtkEntry_val, String_val, Unit) +ML_1 (gtk_entry_get_text, GtkEntry_val, Val_string) +ML_3 (gtk_entry_select_region, GtkEntry_val, Int_val, Int_val, Unit) +ML_2 (gtk_entry_set_visibility, GtkEntry_val, Bool_val, Unit) +ML_2 (gtk_entry_set_max_length, GtkEntry_val, (gint16)Long_val, Unit) +Make_Extractor (GtkEntry, GtkEntry_val, text_length, Val_int) + +/* gtkspinbutton.h */ + +#define GtkSpinButton_val(val) check_cast(GTK_SPIN_BUTTON,val) +ML_3 (gtk_spin_button_new, GtkAdjustment_val, + Float_val, Int_val, Val_GtkWidget_sink) +ML_2 (gtk_spin_button_set_adjustment, GtkSpinButton_val, GtkAdjustment_val, + Unit) +ML_1 (gtk_spin_button_get_adjustment, GtkSpinButton_val, Val_GtkAny) +ML_2 (gtk_spin_button_set_digits, GtkSpinButton_val, Int_val, Unit) +ML_1 (gtk_spin_button_get_value_as_float, GtkSpinButton_val, copy_double) +ML_2 (gtk_spin_button_set_value, GtkSpinButton_val, Float_val, Unit) +ML_2 (gtk_spin_button_set_update_policy, GtkSpinButton_val, + Update_type_val, Unit) +ML_2 (gtk_spin_button_set_numeric, GtkSpinButton_val, Bool_val, Unit) +ML_2 (gtk_spin_button_spin, GtkSpinButton_val, + Insert (Is_long(arg2) ? Spin_type_val(arg2) : GTK_SPIN_USER_DEFINED) + (Is_long(arg2) ? 0.0 : Float_val(Field(arg2,1))) Ignore, Unit) +ML_2 (gtk_spin_button_set_wrap, GtkSpinButton_val, Bool_val, Unit) +ML_2 (gtk_spin_button_set_shadow_type, GtkSpinButton_val, Shadow_type_val, Unit) +ML_2 (gtk_spin_button_set_snap_to_ticks, GtkSpinButton_val, Bool_val, Unit) +ML_4 (gtk_spin_button_configure, GtkSpinButton_val, GtkAdjustment_val, + Float_val, Int_val, Unit) +ML_1 (gtk_spin_button_update, GtkSpinButton_val, Unit) + +/* gtktext.h */ + +#define GtkText_val(val) check_cast(GTK_TEXT,val) +ML_2 (gtk_text_new, GtkAdjustment_val, GtkAdjustment_val, Val_GtkWidget_sink) +ML_2 (gtk_text_set_word_wrap, GtkText_val, Bool_val, Unit) +ML_2 (gtk_text_set_line_wrap, GtkText_val, Bool_val, Unit) +ML_3 (gtk_text_set_adjustments, GtkText_val, + Option_val(arg2,GtkAdjustment_val,GtkText_val(arg1)->hadj) Ignore, + Option_val(arg3,GtkAdjustment_val,GtkText_val(arg1)->vadj) Ignore, + Unit) +Make_Extractor (gtk_text_get, GtkText_val, hadj, Val_GtkWidget) +Make_Extractor (gtk_text_get, GtkText_val, vadj, Val_GtkWidget) +ML_2 (gtk_text_set_point, GtkText_val, Int_val, Unit) +ML_1 (gtk_text_get_point, GtkText_val, Val_int) +ML_1 (gtk_text_get_length, GtkText_val, Val_int) +ML_1 (gtk_text_freeze, GtkText_val, Unit) +ML_1 (gtk_text_thaw, GtkText_val, Unit) +value ml_gtk_text_insert (value text, value font, value fore, value back, + value str) +{ + gtk_text_insert (GtkText_val(text), + Option_val(font,GdkFont_val,NULL), + Option_val(fore,GdkColor_val,NULL), + Option_val(back,GdkColor_val,NULL), + String_val(str), string_length(str)); + return Val_unit; +} +ML_2 (gtk_text_forward_delete, GtkText_val, Int_val, Val_int) +ML_2 (gtk_text_backward_delete, GtkText_val, Int_val, Val_int) + +/* gtkcombo.h */ + +#define GtkCombo_val(val) check_cast(GTK_COMBO,val) +ML_0 (gtk_combo_new, Val_GtkWidget_sink) +ML_3 (gtk_combo_set_value_in_list, GtkCombo_val, + Option_val(arg2, Bool_val, GtkCombo_val(arg1)->value_in_list) Ignore, + Option_val(arg3, Bool_val, GtkCombo_val(arg1)->ok_if_empty) Ignore, + Unit) +ML_2 (gtk_combo_set_use_arrows, GtkCombo_val, Bool_val, Unit) +ML_2 (gtk_combo_set_use_arrows_always, GtkCombo_val, Bool_val, Unit) +ML_2 (gtk_combo_set_case_sensitive, GtkCombo_val, Bool_val, Unit) +ML_3 (gtk_combo_set_item_string, GtkCombo_val, GtkItem_val, String_val, Unit) +ML_1 (gtk_combo_disable_activate, GtkCombo_val, Unit) +Make_Extractor (gtk_combo, GtkCombo_val, entry, Val_GtkWidget) +Make_Extractor (gtk_combo, GtkCombo_val, list, Val_GtkWidget) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkgl.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkgl.c new file mode 100644 index 000000000..5e0efd718 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkgl.c @@ -0,0 +1,54 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtkgl_tags.h" + +/* Conversion functions */ +#include "gtkgl_tags.c" + +#define GtkGLArea_val(val) ((GtkGLArea*)GtkObject_val(val)) + +value ml_gtk_gl_area_new (value list, value share) +{ + value cursor, res; + int len, i; + int *attrs; + + for (len = 0, cursor = list; cursor != Val_unit; cursor = Field(cursor,1)) + { + if (Is_block(Field(cursor,0))) len += 2; + else len++; + } + + attrs = (int*) stat_alloc ((len+1)*sizeof(int)); + + for (i = 0, cursor = list; cursor != Val_unit; cursor = Field(cursor,1)) + { + value option = Field(cursor,0); + if (Is_block(option)) { + attrs[i++] = Visual_options_val(Field(option,0)); + attrs[i++] = Int_val(Field(option,1)); + } + else attrs[i++] = Visual_options_val(option); + } + attrs[i] = GDK_GL_NONE; + + res = Val_GtkObject + ((GtkObject*)gtk_gl_area_share_new(attrs,GtkGLArea_val(share))); + stat_free(attrs); + return res; +} + +ML_1 (gtk_gl_area_make_current, GtkGLArea_val, Val_bool) +ML_1 (gtk_gl_area_swapbuffers, GtkGLArea_val, Unit) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtklist.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtklist.c new file mode 100644 index 000000000..d651ca3ab --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtklist.c @@ -0,0 +1,168 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtk_tags.h" + +static Make_Flags_val (Button_action_val) + +/* gtklistitem.h */ + +ML_0 (gtk_list_item_new, Val_GtkWidget_sink) +ML_1 (gtk_list_item_new_with_label, String_val, Val_GtkWidget_sink) + +/* gtklist.h */ + +#define GtkList_val(val) check_cast(GTK_LIST,val) +ML_0 (gtk_list_new, Val_GtkWidget_sink) +value ml_gtk_list_insert_item (value list, value item, value pos) +{ + GList *tmp_list = g_list_alloc (); + tmp_list->data = GtkWidget_val(item); + tmp_list->next = NULL; + tmp_list->prev = NULL; + gtk_list_insert_items (GtkList_val(list), tmp_list, Int_val(pos)); + return Val_unit; +} +ML_3 (gtk_list_clear_items, GtkList_val, Int_val, Int_val, Unit) +ML_2 (gtk_list_select_item, GtkList_val, Int_val, Unit) +ML_2 (gtk_list_unselect_item, GtkList_val, Int_val, Unit) +ML_2 (gtk_list_select_child, GtkList_val, GtkWidget_val, Unit) +ML_2 (gtk_list_unselect_child, GtkList_val, GtkWidget_val, Unit) +ML_2 (gtk_list_child_position, GtkList_val, GtkWidget_val, Val_int) +ML_2 (gtk_list_set_selection_mode, GtkList_val, Selection_mode_val, Unit) + +/* gtkclist.h */ + +#define GtkCList_val(val) check_cast(GTK_CLIST,val) +ML_1 (gtk_clist_new, Int_val, Val_GtkWidget_sink) +ML_1 (gtk_clist_new_with_titles, Insert(Wosize_val(arg1)) (char **), + Val_GtkWidget_sink) +Make_Extractor (gtk_clist_get, GtkCList_val, rows, Val_int) +Make_Extractor (gtk_clist_get, GtkCList_val, columns, Val_int) +Make_Extractor (gtk_clist_get, GtkCList_val, focus_row, Val_int) +ML_2 (gtk_clist_set_hadjustment, GtkCList_val, GtkAdjustment_val, Unit) +ML_2 (gtk_clist_set_vadjustment, GtkCList_val, GtkAdjustment_val, Unit) +ML_1 (gtk_clist_get_hadjustment, GtkCList_val, Val_GtkAny) +ML_1 (gtk_clist_get_vadjustment, GtkCList_val, Val_GtkAny) +ML_2 (gtk_clist_set_shadow_type, GtkCList_val, Shadow_type_val, Unit) +ML_2 (gtk_clist_set_selection_mode, GtkCList_val, Selection_mode_val, Unit) +ML_2 (gtk_clist_set_reorderable, GtkCList_val, Bool_val, Unit) +ML_2 (gtk_clist_set_use_drag_icons, GtkCList_val, Bool_val, Unit) +ML_3 (gtk_clist_set_button_actions, GtkCList_val, Int_val, + (guint8)Flags_Button_action_val, Unit) +ML_1 (gtk_clist_freeze, GtkCList_val, Unit) +ML_1 (gtk_clist_thaw, GtkCList_val, Unit) +ML_1 (gtk_clist_column_titles_show, GtkCList_val, Unit) +ML_1 (gtk_clist_column_titles_hide, GtkCList_val, Unit) +ML_2 (gtk_clist_column_title_active, GtkCList_val, Int_val, Unit) +ML_2 (gtk_clist_column_title_passive, GtkCList_val, Int_val, Unit) +ML_1 (gtk_clist_column_titles_active, GtkCList_val, Unit) +ML_1 (gtk_clist_column_titles_passive, GtkCList_val, Unit) +ML_3 (gtk_clist_set_column_title, GtkCList_val, Int_val, String_val, Unit) +ML_2 (gtk_clist_get_column_title, GtkCList_val, Int_val, Val_string) +ML_3 (gtk_clist_set_column_widget, GtkCList_val, Int_val, GtkWidget_val, Unit) +ML_2 (gtk_clist_get_column_widget, GtkCList_val, Int_val, Val_GtkWidget) +ML_3 (gtk_clist_set_column_justification, GtkCList_val, Int_val, + Justification_val, Unit) +ML_3 (gtk_clist_set_column_visibility, GtkCList_val, Int_val, Bool_val, Unit) +ML_3 (gtk_clist_set_column_resizeable, GtkCList_val, Int_val, Bool_val, Unit) +ML_3 (gtk_clist_set_column_auto_resize, GtkCList_val, Int_val, Bool_val, Unit) +ML_1 (gtk_clist_columns_autosize, GtkCList_val, Unit) +ML_2 (gtk_clist_optimal_column_width, GtkCList_val, Int_val, Val_int) +ML_3 (gtk_clist_set_column_width, GtkCList_val, Int_val, Int_val, Unit) +ML_3 (gtk_clist_set_column_min_width, GtkCList_val, Int_val, Int_val, Unit) +ML_3 (gtk_clist_set_column_max_width, GtkCList_val, Int_val, Int_val, Unit) +ML_2 (gtk_clist_set_row_height, GtkCList_val, Int_val, Unit) +ML_5 (gtk_clist_moveto, GtkCList_val, Int_val, Int_val, + Double_val, Double_val, Unit) +ML_2 (gtk_clist_row_is_visible, GtkCList_val, Int_val, Val_visibility) +ML_3 (gtk_clist_get_cell_type, GtkCList_val, Int_val, Int_val, Val_cell_type) +ML_4 (gtk_clist_set_text, GtkCList_val, Int_val, Int_val, Optstring_val, Unit) +value ml_gtk_clist_get_text (value clist, value row, value column) +{ + char *text; + if (!gtk_clist_get_text (GtkCList_val(clist), Int_val(row), + Int_val(column), &text)) + invalid_argument ("Gtk.Clist.get_text"); + return Val_optstring(text); +} +ML_5 (gtk_clist_set_pixmap, GtkCList_val, Int_val, Int_val, GdkPixmap_val, + GdkBitmap_val, Unit) +value ml_gtk_clist_get_pixmap (value clist, value row, value column) +{ + CAMLparam0 (); + GdkPixmap *pixmap; + GdkBitmap *bitmap; + CAMLlocal2 (vpixmap,vbitmap); + value ret; + + if (!gtk_clist_get_pixmap (GtkCList_val(clist), Int_val(row), + Int_val(column), &pixmap, &bitmap)) + invalid_argument ("Gtk.Clist.get_pixmap"); + vpixmap = Val_option (pixmap, Val_GdkPixmap); + vbitmap = Val_option (bitmap, Val_GdkBitmap); + + ret = alloc_small (2,0); + Field(ret,0) = vpixmap; + Field(ret,1) = vbitmap; + CAMLreturn(ret); +} +ML_7 (gtk_clist_set_pixtext, GtkCList_val, Int_val, Int_val, String_val, + (guint8)Long_val, GdkPixmap_val, GdkBitmap_val, Unit) +ML_bc7 (ml_gtk_clist_set_pixtext) +ML_3 (gtk_clist_set_foreground, GtkCList_val, Int_val, GdkColor_val, Unit) +ML_3 (gtk_clist_set_background, GtkCList_val, Int_val, GdkColor_val, Unit) +ML_3 (gtk_clist_get_cell_style, GtkCList_val, Int_val, Int_val, Val_GtkStyle) +ML_4 (gtk_clist_set_cell_style, GtkCList_val, Int_val, Int_val, GtkStyle_val, + Unit) +ML_2 (gtk_clist_get_row_style, GtkCList_val, Int_val, Val_GtkStyle) +ML_3 (gtk_clist_set_row_style, GtkCList_val, Int_val, GtkStyle_val, Unit) +ML_3 (gtk_clist_set_selectable, GtkCList_val, Int_val, Bool_val, Unit) +ML_2 (gtk_clist_get_selectable, GtkCList_val, Int_val, Val_bool) +ML_5 (gtk_clist_set_shift, GtkCList_val, Int_val, Int_val, Int_val, Int_val, + Unit) +/* ML_2 (gtk_clist_append, GtkCList_val, (char **), Val_int) */ +ML_3 (gtk_clist_insert, GtkCList_val, Int_val, (char **), Val_int) +ML_2 (gtk_clist_remove, GtkCList_val, Int_val, Unit) +value ml_gtk_clist_set_row_data (value w, value row, value data) +{ + value *data_p = ml_global_root_new (data); + gtk_clist_set_row_data_full (GtkCList_val(w), Int_val(row), + data_p, ml_global_root_destroy); + return Val_unit; +} +ML_2 (gtk_clist_get_row_data, GtkCList_val, Int_val, *(value*)Check_null) +ML_3 (gtk_clist_select_row, GtkCList_val, Int_val, Int_val, Unit) +ML_3 (gtk_clist_unselect_row, GtkCList_val, Int_val, Int_val, Unit) +ML_1 (gtk_clist_clear, GtkCList_val, Unit) +value ml_gtk_clist_get_selection_info (value clist, value x, value y) +{ + int row, column; + value ret; + if (!gtk_clist_get_selection_info (GtkCList_val(clist), Int_val(x), + Int_val(y), &row, &column)) + invalid_argument ("Gtk.Clist.get_selection_info"); + ret = alloc_small (2,0); + Field(ret,0) = row; + Field(ret,1) = column; + return ret; +} +ML_1 (gtk_clist_select_all, GtkCList_val, Unit) +ML_1 (gtk_clist_unselect_all, GtkCList_val, Unit) +ML_3 (gtk_clist_swap_rows, GtkCList_val, Int_val, Int_val, Unit) +ML_3 (gtk_clist_row_move, GtkCList_val, Int_val, Int_val, Unit) +ML_2 (gtk_clist_set_sort_column, GtkCList_val, Int_val, Unit) +ML_2 (gtk_clist_set_sort_type, GtkCList_val, Sort_type_val, Unit) +ML_1 (gtk_clist_sort, GtkCList_val, Unit) +ML_2 (gtk_clist_set_auto_sort, GtkCList_val, Bool_val, Unit) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkmenu.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkmenu.c new file mode 100644 index 000000000..355b9fea1 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkmenu.c @@ -0,0 +1,97 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtk_tags.h" + +/* gtkmenuitem.h */ + +#define GtkMenuItem_val(val) check_cast(GTK_MENU_ITEM,val) +ML_0 (gtk_menu_item_new, Val_GtkWidget_sink) +ML_0 (gtk_tearoff_menu_item_new, Val_GtkWidget_sink) +ML_1 (gtk_menu_item_new_with_label, String_val, Val_GtkWidget_sink) +ML_2 (gtk_menu_item_set_submenu, GtkMenuItem_val, GtkWidget_val, Unit) +ML_1 (gtk_menu_item_remove_submenu, GtkMenuItem_val, Unit) +ML_2 (gtk_menu_item_set_placement, GtkMenuItem_val, + Submenu_placement_val, Unit) +ML_3 (gtk_menu_item_configure, GtkMenuItem_val, Bool_val, Bool_val, Unit) +ML_1 (gtk_menu_item_activate, GtkMenuItem_val, Unit) +ML_1 (gtk_menu_item_right_justify, GtkMenuItem_val, Unit) + +/* gtkcheckmenuitem.h */ + +#define GtkCheckMenuItem_val(val) check_cast(GTK_CHECK_MENU_ITEM,val) +ML_0 (gtk_check_menu_item_new, Val_GtkWidget_sink) +ML_1 (gtk_check_menu_item_new_with_label, String_val, Val_GtkWidget_sink) +ML_2 (gtk_check_menu_item_set_active, GtkCheckMenuItem_val, Bool_val, Unit) +ML_2 (gtk_check_menu_item_set_show_toggle, GtkCheckMenuItem_val, + Bool_val, Unit) +ML_1 (gtk_check_menu_item_toggled, GtkCheckMenuItem_val, Unit) +Make_Extractor (gtk_check_menu_item_get, GtkCheckMenuItem_val, + active, Val_bool) + +/* gtkradiomenuitem.h */ + +#define GtkRadioMenuItem_val(val) check_cast(GTK_RADIO_MENU_ITEM,val) +static GSList* item_group_val(value val) +{ + return (val == Val_unit ? NULL : + gtk_radio_menu_item_group(GtkRadioMenuItem_val(Field(val,0)))); +} +ML_1 (gtk_radio_menu_item_new, item_group_val, Val_GtkWidget_sink) +ML_2 (gtk_radio_menu_item_new_with_label, item_group_val, + String_val, Val_GtkWidget_sink) +ML_2 (gtk_radio_menu_item_set_group, GtkRadioMenuItem_val, + item_group_val, Unit) + +/* gtkoptionmenu.h */ + +#define GtkOptionMenu_val(val) check_cast(GTK_OPTION_MENU,val) +ML_0 (gtk_option_menu_new, Val_GtkWidget_sink) +ML_1 (gtk_option_menu_get_menu, GtkOptionMenu_val, Val_GtkWidget_sink) +ML_2 (gtk_option_menu_set_menu, GtkOptionMenu_val, GtkWidget_val, Unit) +ML_1 (gtk_option_menu_remove_menu, GtkOptionMenu_val, Unit) +ML_2 (gtk_option_menu_set_history, GtkOptionMenu_val, Int_val, Unit) + +/* gtkmenushell.h */ + +#define GtkMenuShell_val(val) check_cast(GTK_MENU_SHELL,val) +ML_2 (gtk_menu_shell_append, GtkMenuShell_val, GtkWidget_val, Unit) +ML_2 (gtk_menu_shell_prepend, GtkMenuShell_val, GtkWidget_val, Unit) +ML_3 (gtk_menu_shell_insert, GtkMenuShell_val, GtkWidget_val, Int_val, Unit) +ML_1 (gtk_menu_shell_deactivate, GtkMenuShell_val, Unit) + +/* gtkmenu.h */ + +#define GtkMenu_val(val) check_cast(GTK_MENU,val) +ML_0 (gtk_menu_new, Val_GtkWidget_sink) +ML_5 (gtk_menu_popup, GtkMenu_val, GtkWidget_val, GtkWidget_val, + Insert(NULL) Insert(NULL) Int_val, Int_val, Unit) +ML_1 (gtk_menu_popdown, GtkMenu_val, Unit) +ML_1 (gtk_menu_get_active, GtkMenu_val, Val_GtkWidget) +ML_2 (gtk_menu_set_active, GtkMenu_val, Int_val, Unit) +ML_2 (gtk_menu_set_accel_group, GtkMenu_val, GtkAccelGroup_val, Unit) +ML_1 (gtk_menu_get_accel_group, GtkMenu_val, Val_GtkAccelGroup) +ML_1 (gtk_menu_ensure_uline_accel_group, GtkMenu_val, Val_GtkAccelGroup) +value ml_gtk_menu_attach_to_widget (value menu, value widget) +{ + gtk_menu_attach_to_widget (GtkMenu_val(menu), GtkWidget_val(widget), NULL); + return Val_unit; +} +ML_1 (gtk_menu_get_attach_widget, GtkMenu_val, Val_GtkWidget) +ML_1 (gtk_menu_detach, GtkMenu_val, Unit) + +/* gtkmenubar.h */ + +#define GtkMenuBar_val(val) check_cast(GTK_MENU_BAR,val) +ML_0 (gtk_menu_bar_new, Val_GtkWidget_sink) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkmisc.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkmisc.c new file mode 100644 index 000000000..f69f34390 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkmisc.c @@ -0,0 +1,139 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtk_tags.h" + +/* gtkgamma.h */ + +#define GtkGammaCurve_val(val) check_cast(GTK_GAMMA_CURVE,val) +ML_0 (gtk_gamma_curve_new, Val_GtkWidget_sink) +Make_Extractor (gtk_gamma_curve_get, GtkGammaCurve_val, gamma, copy_double) + +/* gtkstatusbar.h */ + +#define GtkStatusbar_val(val) check_cast(GTK_STATUSBAR,val) +ML_0 (gtk_statusbar_new, Val_GtkWidget_sink) +ML_2 (gtk_statusbar_get_context_id, GtkStatusbar_val, String_val, Val_int) +ML_3 (gtk_statusbar_push, GtkStatusbar_val, Int_val, String_val, Val_int) +ML_2 (gtk_statusbar_pop, GtkStatusbar_val, Int_val, Unit) +ML_3 (gtk_statusbar_remove, GtkStatusbar_val, Int_val, Int_val, Unit) + +/* gtkcalendar.h */ + +#define GtkCalendar_val(val) check_cast(GTK_CALENDAR,val) +ML_0 (gtk_calendar_new, Val_GtkWidget_sink) +ML_3 (gtk_calendar_select_month, GtkCalendar_val, Int_val, Int_val, Unit) +ML_2 (gtk_calendar_select_day, GtkCalendar_val, Int_val, Unit) +ML_2 (gtk_calendar_mark_day, GtkCalendar_val, Int_val, Unit) +ML_2 (gtk_calendar_unmark_day, GtkCalendar_val, Int_val, Unit) +ML_1 (gtk_calendar_clear_marks, GtkCalendar_val, Unit) +Make_Flags_val (Calendar_display_options_val) +ML_2 (gtk_calendar_display_options, GtkCalendar_val, + Flags_Calendar_display_options_val, Unit) +value ml_gtk_calendar_get_date (value w) +{ + guint year, month, day; + value ret; + + gtk_calendar_get_date (GtkCalendar_val(w), &year, &month, &day); + ret = alloc_small (3, 0); + Field(ret,0) = Val_int(year); + Field(ret,1) = Val_int(month); + Field(ret,2) = Val_int(day); + return ret; +} +ML_1 (gtk_calendar_freeze, GtkCalendar_val, Unit) +ML_1 (gtk_calendar_thaw, GtkCalendar_val, Unit) + +/* gtkdrawingarea.h */ + +#define GtkDrawingArea_val(val) check_cast(GTK_DRAWING_AREA,val) +ML_0 (gtk_drawing_area_new, Val_GtkWidget_sink) +ML_3 (gtk_drawing_area_size, GtkDrawingArea_val, Int_val, Int_val, Unit) + +/* gtkmisc.h */ + +#define GtkMisc_val(val) check_cast(GTK_MISC,val) +ML_3 (gtk_misc_set_alignment, GtkMisc_val, Double_val, Double_val, Unit) +ML_3 (gtk_misc_set_padding, GtkMisc_val, Int_val, Int_val, Unit) +Make_Extractor (gtk_misc_get, GtkMisc_val, xalign, copy_double) +Make_Extractor (gtk_misc_get, GtkMisc_val, yalign, copy_double) +Make_Extractor (gtk_misc_get, GtkMisc_val, xpad, Val_int) +Make_Extractor (gtk_misc_get, GtkMisc_val, ypad, Val_int) + +/* gtkarrow.h */ + +#define GtkArrow_val(val) check_cast(GTK_ARROW,val) +ML_2 (gtk_arrow_new, Arrow_type_val, Shadow_type_val, Val_GtkWidget_sink) +ML_3 (gtk_arrow_set, GtkArrow_val, Arrow_type_val, Shadow_type_val, Unit) + +/* gtkimage.h */ + +#define GtkImage_val(val) check_cast(GTK_IMAGE,val) +ML_2 (gtk_image_new, GdkImage_val, + Option_val (arg2, GdkBitmap_val, NULL) Ignore, Val_GtkWidget_sink) +ML_3 (gtk_image_set, GtkImage_val, GdkImage_val, + Option_val (arg2, GdkBitmap_val, NULL) Ignore, Unit) + +/* gtklabel.h */ + +#define GtkLabel_val(val) check_cast(GTK_LABEL,val) +ML_1 (gtk_label_new, String_val, Val_GtkWidget_sink) +ML_2 (gtk_label_set_text, GtkLabel_val, String_val, Unit) +ML_2 (gtk_label_set_pattern, GtkLabel_val, String_val, Unit) +ML_2 (gtk_label_set_justify, GtkLabel_val, Justification_val, Unit) +ML_2 (gtk_label_set_line_wrap, GtkLabel_val, Bool_val, Unit) +Make_Extractor (gtk_label_get, GtkLabel_val, label, Val_string) + +/* gtktipsquery.h */ + +#define GtkTipsQuery_val(val) check_cast(GTK_TIPS_QUERY,val) +ML_0 (gtk_tips_query_new, Val_GtkWidget_sink) +ML_1 (gtk_tips_query_start_query, GtkTipsQuery_val, Unit) +ML_1 (gtk_tips_query_stop_query, GtkTipsQuery_val, Unit) +ML_2 (gtk_tips_query_set_caller, GtkTipsQuery_val, GtkWidget_val, Unit) +ML_3 (gtk_tips_query_set_labels, GtkTipsQuery_val, + String_val, String_val, Unit) +value ml_gtk_tips_query_set_emit_always (value w, value arg) +{ + GtkTipsQuery_val(w)->emit_always = Bool_val(arg); + return Val_unit; +} +Make_Extractor (gtk_tips_query_get, GtkTipsQuery_val, emit_always, Val_bool) +Make_Extractor (gtk_tips_query_get, GtkTipsQuery_val, caller, Val_GtkWidget) +Make_Extractor (gtk_tips_query_get, GtkTipsQuery_val, label_inactive, + Val_string) +Make_Extractor (gtk_tips_query_get, GtkTipsQuery_val, label_no_tip, + Val_string) + +/* gtkpixmap.h */ + +#define GtkPixmap_val(val) check_cast(GTK_PIXMAP,val) +ML_2 (gtk_pixmap_new, GdkPixmap_val, + Option_val (arg2, GdkBitmap_val, NULL) Ignore, + Val_GtkWidget_sink) +value ml_gtk_pixmap_set (value val, value pixmap, value mask) +{ + GtkPixmap *w = GtkPixmap_val(val); + gtk_pixmap_set (w, Option_val(pixmap,GdkPixmap_val,w->pixmap), + Option_val(mask,GdkBitmap_val,w->mask)); + return Val_unit; +} +Make_Extractor (GtkPixmap, GtkPixmap_val, pixmap, Val_GdkPixmap) +Make_Extractor (GtkPixmap, GtkPixmap_val, mask, Val_GdkBitmap) + +/* gtk[hv]separator.h */ + +ML_0 (gtk_hseparator_new, Val_GtkWidget_sink) +ML_0 (gtk_vseparator_new, Val_GtkWidget_sink) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtknew.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtknew.c new file mode 100644 index 000000000..a75c1fb1f --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtknew.c @@ -0,0 +1,180 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" + +static value ml_class_init=0; + +static void class_init (value class) +{ + callback(ml_class_init, class); +} + + +value set_ml_class_init (value class_func) +{ + if (!ml_class_init) register_global_root (&ml_class_init); + ml_class_init = class_func; + return Val_unit; +} + +value ml_gtk_type_new (value type) +{ + return Val_GtkWidget_sink(gtk_type_new(Int_val(type))); +} + + +struct widget_info { + guint size; + guint class_size; + guint (*get_type_func)(void); +} +widget_info_array[] = { + { sizeof(GtkObject), sizeof(GtkObjectClass), gtk_object_get_type }, + { sizeof(GtkWidget), sizeof(GtkWidgetClass), gtk_widget_get_type }, + { sizeof(GtkMisc), sizeof(GtkMiscClass), gtk_misc_get_type }, + { sizeof(GtkLabel), sizeof(GtkLabelClass), gtk_label_get_type }, + { sizeof(GtkAccelLabel), sizeof(GtkAccelLabelClass), gtk_accel_label_get_type }, + { sizeof(GtkTipsQuery), sizeof(GtkTipsQueryClass), gtk_tips_query_get_type }, + { sizeof(GtkArrow), sizeof(GtkArrowClass), gtk_arrow_get_type }, + { sizeof(GtkImage), sizeof(GtkImageClass), gtk_image_get_type }, + { sizeof(GtkPixmap), sizeof(GtkPixmapClass), gtk_pixmap_get_type }, + { sizeof(GtkContainer), sizeof(GtkContainerClass), gtk_container_get_type }, + { sizeof(GtkBin), sizeof(GtkBinClass), gtk_bin_get_type }, + { sizeof(GtkAlignment), sizeof(GtkAlignmentClass), gtk_alignment_get_type }, + { sizeof(GtkFrame), sizeof(GtkFrameClass), gtk_frame_get_type }, + { sizeof(GtkAspectFrame), sizeof(GtkAspectFrameClass), gtk_aspect_frame_get_type }, + { sizeof(GtkButton), sizeof(GtkButtonClass), gtk_button_get_type }, + { sizeof(GtkToggleButton), sizeof(GtkToggleButtonClass), gtk_toggle_button_get_type }, + { sizeof(GtkCheckButton), sizeof(GtkCheckButtonClass), gtk_check_button_get_type }, + { sizeof(GtkRadioButton), sizeof(GtkRadioButtonClass), gtk_radio_button_get_type }, + { sizeof(GtkOptionMenu), sizeof(GtkOptionMenuClass), gtk_option_menu_get_type }, + { sizeof(GtkItem), sizeof(GtkItemClass), gtk_item_get_type }, + { sizeof(GtkMenuItem), sizeof(GtkMenuItemClass), gtk_menu_item_get_type }, + { sizeof(GtkCheckMenuItem), sizeof(GtkCheckMenuItemClass), gtk_check_menu_item_get_type }, + { sizeof(GtkRadioMenuItem), sizeof(GtkRadioMenuItemClass), gtk_radio_menu_item_get_type }, + { sizeof(GtkTearoffMenuItem), sizeof(GtkTearoffMenuItemClass), gtk_tearoff_menu_item_get_type }, + { sizeof(GtkListItem), sizeof(GtkListItemClass), gtk_list_item_get_type }, + { sizeof(GtkTreeItem), sizeof(GtkTreeItemClass), gtk_tree_item_get_type }, + { sizeof(GtkWindow), sizeof(GtkWindowClass), gtk_window_get_type }, + { sizeof(GtkColorSelectionDialog), sizeof(GtkColorSelectionDialogClass), gtk_color_selection_dialog_get_type }, + { sizeof(GtkDialog), sizeof(GtkDialogClass), gtk_dialog_get_type }, + { sizeof(GtkInputDialog), sizeof(GtkInputDialogClass), gtk_input_dialog_get_type }, + { sizeof(GtkFileSelection), sizeof(GtkFileSelectionClass), gtk_file_selection_get_type }, + { sizeof(GtkFontSelectionDialog), sizeof(GtkFontSelectionDialogClass), gtk_font_selection_dialog_get_type }, + { sizeof(GtkPlug), sizeof(GtkPlugClass), gtk_plug_get_type }, + { sizeof(GtkEventBox), sizeof(GtkEventBoxClass), gtk_event_box_get_type }, + { sizeof(GtkHandleBox), sizeof(GtkHandleBoxClass), gtk_handle_box_get_type }, + { sizeof(GtkScrolledWindow), sizeof(GtkScrolledWindowClass), gtk_scrolled_window_get_type }, + { sizeof(GtkViewport), sizeof(GtkViewportClass), gtk_viewport_get_type }, + { sizeof(GtkBox), sizeof(GtkBoxClass), gtk_box_get_type }, + { sizeof(GtkButtonBox), sizeof(GtkButtonBoxClass), gtk_button_box_get_type }, + { sizeof(GtkHButtonBox), sizeof(GtkHButtonBoxClass), gtk_hbutton_box_get_type }, + { sizeof(GtkVButtonBox), sizeof(GtkVButtonBoxClass), gtk_vbutton_box_get_type }, + { sizeof(GtkVBox), sizeof(GtkVBoxClass), gtk_vbox_get_type }, + { sizeof(GtkColorSelection), sizeof(GtkColorSelectionClass), gtk_color_selection_get_type }, + { sizeof(GtkGammaCurve), sizeof(GtkGammaCurveClass), gtk_gamma_curve_get_type }, + { sizeof(GtkHBox), sizeof(GtkHBoxClass), gtk_hbox_get_type }, + { sizeof(GtkCombo), sizeof(GtkComboClass), gtk_combo_get_type }, + { sizeof(GtkStatusbar), sizeof(GtkStatusbarClass), gtk_statusbar_get_type }, + { sizeof(GtkCList), sizeof(GtkCListClass), gtk_clist_get_type }, + { sizeof(GtkCTree), sizeof(GtkCTreeClass), gtk_ctree_get_type }, + { sizeof(GtkFixed), sizeof(GtkFixedClass), gtk_fixed_get_type }, + { sizeof(GtkNotebook), sizeof(GtkNotebookClass), gtk_notebook_get_type }, + { sizeof(GtkFontSelection), sizeof(GtkFontSelectionClass), gtk_font_selection_get_type }, + { sizeof(GtkPaned), sizeof(GtkPanedClass), gtk_paned_get_type }, + { sizeof(GtkHPaned), sizeof(GtkHPanedClass), gtk_hpaned_get_type }, + { sizeof(GtkVPaned), sizeof(GtkVPanedClass), gtk_vpaned_get_type }, + { sizeof(GtkLayout), sizeof(GtkLayoutClass), gtk_layout_get_type }, + { sizeof(GtkList), sizeof(GtkListClass), gtk_list_get_type }, + { sizeof(GtkMenuShell), sizeof(GtkMenuShellClass), gtk_menu_shell_get_type }, + { sizeof(GtkMenuBar), sizeof(GtkMenuBarClass), gtk_menu_bar_get_type }, + { sizeof(GtkMenu), sizeof(GtkMenuClass), gtk_menu_get_type }, + { sizeof(GtkPacker), sizeof(GtkPackerClass), gtk_packer_get_type }, + { sizeof(GtkSocket), sizeof(GtkSocketClass), gtk_socket_get_type }, + { sizeof(GtkTable), sizeof(GtkTableClass), gtk_table_get_type }, + { sizeof(GtkToolbar), sizeof(GtkToolbarClass), gtk_toolbar_get_type }, + { sizeof(GtkTree), sizeof(GtkTreeClass), gtk_tree_get_type }, + { sizeof(GtkCalendar), sizeof(GtkCalendarClass), gtk_calendar_get_type }, + { sizeof(GtkDrawingArea), sizeof(GtkDrawingAreaClass), gtk_drawing_area_get_type }, + { sizeof(GtkCurve), sizeof(GtkCurveClass), gtk_curve_get_type }, + { sizeof(GtkEditable), sizeof(GtkEditableClass), gtk_editable_get_type }, + { sizeof(GtkEntry), sizeof(GtkEntryClass), gtk_entry_get_type }, + { sizeof(GtkSpinButton), sizeof(GtkSpinButtonClass), gtk_spin_button_get_type }, + { sizeof(GtkText), sizeof(GtkTextClass), gtk_text_get_type }, + { sizeof(GtkRuler), sizeof(GtkRulerClass), gtk_ruler_get_type }, + { sizeof(GtkHRuler), sizeof(GtkHRulerClass), gtk_hruler_get_type }, + { sizeof(GtkVRuler), sizeof(GtkVRulerClass), gtk_vruler_get_type }, + { sizeof(GtkRange), sizeof(GtkRangeClass), gtk_range_get_type }, + { sizeof(GtkScale), sizeof(GtkScaleClass), gtk_scale_get_type }, + { sizeof(GtkHScale), sizeof(GtkHScaleClass), gtk_hscale_get_type }, + { sizeof(GtkVScale), sizeof(GtkVScaleClass), gtk_vscale_get_type }, + { sizeof(GtkScrollbar), sizeof(GtkScrollbarClass), gtk_scrollbar_get_type }, + { sizeof(GtkHScrollbar), sizeof(GtkHScrollbarClass), gtk_hscrollbar_get_type }, + { sizeof(GtkVScrollbar), sizeof(GtkVScrollbarClass), gtk_vscrollbar_get_type }, + { sizeof(GtkSeparator), sizeof(GtkSeparatorClass), gtk_separator_get_type }, + { sizeof(GtkHSeparator), sizeof(GtkHSeparatorClass), gtk_hseparator_get_type }, + { sizeof(GtkVSeparator), sizeof(GtkVSeparatorClass), gtk_vseparator_get_type }, + { sizeof(GtkPreview), sizeof(GtkPreviewClass), gtk_preview_get_type }, + { sizeof(GtkProgress), sizeof(GtkProgressClass), gtk_progress_get_type }, + { sizeof(GtkProgressBar), sizeof(GtkProgressBarClass), gtk_progress_bar_get_type }, + { sizeof(GtkData), sizeof(GtkDataClass), gtk_data_get_type }, + { sizeof(GtkAdjustment), sizeof(GtkAdjustmentClass), gtk_adjustment_get_type }, + { sizeof(GtkTooltips), sizeof(GtkTooltipsClass), gtk_tooltips_get_type }, + { sizeof(GtkItemFactory), sizeof(GtkItemFactoryClass), gtk_item_factory_get_type } +}; + + +value ml_gtk_type_unique (value name, value parent, value nsignals) +{ + struct widget_info * wi; + GtkTypeInfo ttt_info; + + wi = widget_info_array + Int_val(parent); + ttt_info.type_name = String_val(name); + ttt_info.object_size = wi->size; + ttt_info.class_size = wi->class_size + Int_val(nsignals)*sizeof(void *); + ttt_info.class_init_func = (GtkClassInitFunc) class_init; + ttt_info.object_init_func = (GtkObjectInitFunc) NULL; + ttt_info.reserved_1 = NULL; + ttt_info.reserved_2 = NULL; + ttt_info.base_class_init_func = (GtkClassInitFunc) NULL; + + return Val_int(gtk_type_unique(wi->get_type_func (), &ttt_info)); +} + +static guint sig[100]; + +value ml_gtk_object_class_add_signals (value class, value signals, + value nsignals) +{ + int i; + for (i=0; iclass_size+Int_val(num)*sizeof(void *); + return Val_int(gtk_signal_new (String_val(name), Int_val(run_type), + ((GtkObjectClass *)classe)->type, offset, + gtk_signal_default_marshaller, GTK_TYPE_NONE, 0)); + *(((int *)classe)+offset) = 0; +} diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkpack.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkpack.c new file mode 100644 index 000000000..b089b882e --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkpack.c @@ -0,0 +1,229 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtk_tags.h" + +static Make_Flags_val (Attach_options_val) + +/* gtkbox.h */ + +#define GtkBox_val(val) check_cast(GTK_BOX,val) +ML_5 (gtk_box_pack_start, GtkBox_val, GtkWidget_val, Bool_val, Bool_val, + Int_val, Unit) +ML_5 (gtk_box_pack_end, GtkBox_val, GtkWidget_val, Bool_val, Bool_val, + Int_val, Unit) +ML_2 (gtk_box_set_homogeneous, GtkBox_val, Bool_val, Unit) +ML_2 (gtk_box_set_spacing, GtkBox_val, Int_val, Unit) +ML_3 (gtk_box_reorder_child, GtkBox_val, GtkWidget_val, Int_val, Unit) +value ml_gtk_box_query_child_packing (value box, value child) +{ + int expand, fill; + unsigned int padding; + GtkPackType pack_type; + value ret; + gtk_box_query_child_packing (GtkBox_val(box), GtkWidget_val(child), + &expand, &fill, &padding, &pack_type); + ret = alloc_small(4,0); + Field(ret,0) = Val_bool(expand); + Field(ret,1) = Val_bool(fill); + Field(ret,2) = Val_int(padding); + Field(ret,3) = Val_pack_type(pack_type); + return ret; +} +value ml_gtk_box_set_child_packing (value vbox, value vchild, value vexpand, + value vfill, value vpadding, value vpack) +{ + GtkBox *box = GtkBox_val(vbox); + GtkWidget *child = GtkWidget_val(vchild); + int expand, fill; + unsigned int padding; + GtkPackType pack; + gtk_box_query_child_packing (box, child, &expand, &fill, &padding, &pack); + gtk_box_set_child_packing (box, child, + Option_val(vexpand, Bool_val, expand), + Option_val(vfill, Bool_val, fill), + Option_val(vpadding, Int_val, padding), + Option_val(vpack, Pack_type_val, pack)); + return Val_unit; +} +ML_bc6 (ml_gtk_box_set_child_packing) + +ML_2 (gtk_hbox_new, Bool_val, Int_val, Val_GtkWidget_sink) +ML_2 (gtk_vbox_new, Bool_val, Int_val, Val_GtkWidget_sink) + +/* gtkbbox.h */ + +#define GtkButtonBox_val(val) check_cast(GTK_BUTTON_BOX,val) +Make_Extractor (gtk_button_box_get, GtkButtonBox_val, spacing, Val_int) +Make_Extractor (gtk_button_box_get, GtkButtonBox_val, child_min_width, Val_int) +Make_Extractor (gtk_button_box_get, GtkButtonBox_val, child_min_height, + Val_int) +Make_Extractor (gtk_button_box_get, GtkButtonBox_val, child_ipad_x, Val_int) +Make_Extractor (gtk_button_box_get, GtkButtonBox_val, child_ipad_y, Val_int) +Make_Extractor (gtk_button_box_get, GtkButtonBox_val, layout_style, + Val_button_box_style) +ML_2 (gtk_button_box_set_spacing, GtkButtonBox_val, Int_val, Unit) +ML_3 (gtk_button_box_set_child_size, GtkButtonBox_val, + Int_val, Int_val, Unit) +ML_3 (gtk_button_box_set_child_ipadding, GtkButtonBox_val, + Int_val, Int_val, Unit) +ML_2 (gtk_button_box_set_layout, GtkButtonBox_val, Button_box_style_val, Unit) +ML_2 (gtk_button_box_set_child_size_default, Int_val, Int_val, Unit) +ML_2 (gtk_button_box_set_child_ipadding_default, Int_val, Int_val, Unit) + +ML_0 (gtk_hbutton_box_new, Val_GtkWidget_sink) +ML_0 (gtk_vbutton_box_new, Val_GtkWidget_sink) + +/* gtkfixed.h */ + +#define GtkFixed_val(val) check_cast(GTK_FIXED,val) +ML_0 (gtk_fixed_new, Val_GtkWidget_sink) +ML_4 (gtk_fixed_put, GtkFixed_val, GtkWidget_val, (gint16)Long_val, (gint16)Long_val, Unit) +ML_4 (gtk_fixed_move, GtkFixed_val, GtkWidget_val, (gint16)Long_val, (gint16)Long_val, Unit) + +/* gtklayout.h */ + +#define GtkLayout_val(val) check_cast(GTK_LAYOUT,val) +ML_2 (gtk_layout_new, GtkAdjustment_val, GtkAdjustment_val, Val_GtkWidget_sink) +ML_4 (gtk_layout_put, GtkLayout_val, GtkWidget_val, Int_val, Int_val, Unit) +ML_4 (gtk_layout_move, GtkLayout_val, GtkWidget_val, Int_val, Int_val, Unit) +ML_3 (gtk_layout_set_size, GtkLayout_val, Int_val, Int_val, Unit) +ML_1 (gtk_layout_get_hadjustment, GtkLayout_val, Val_GtkAny) +ML_1 (gtk_layout_get_vadjustment, GtkLayout_val, Val_GtkAny) +ML_2 (gtk_layout_set_hadjustment, GtkLayout_val, GtkAdjustment_val, Unit) +ML_2 (gtk_layout_set_vadjustment, GtkLayout_val, GtkAdjustment_val, Unit) +ML_1 (gtk_layout_freeze, GtkLayout_val, Unit) +ML_1 (gtk_layout_thaw, GtkLayout_val, Unit) +Make_Extractor (gtk_layout_get, GtkLayout_val, width, Val_int) +Make_Extractor (gtk_layout_get, GtkLayout_val, height, Val_int) + +/* gtknotebook.h */ + +#define GtkNotebook_val(val) check_cast(GTK_NOTEBOOK,val) +ML_0 (gtk_notebook_new, Val_GtkWidget_sink) + +ML_5 (gtk_notebook_insert_page_menu, GtkNotebook_val, GtkWidget_val, + GtkWidget_val, GtkWidget_val, Int_val, Unit) +ML_2 (gtk_notebook_remove_page, GtkNotebook_val, Int_val, Unit) + +ML_2 (gtk_notebook_set_tab_pos, GtkNotebook_val, Position_val, Unit) +ML_2 (gtk_notebook_set_homogeneous_tabs, GtkNotebook_val, Bool_val, Unit) +ML_2 (gtk_notebook_set_show_tabs, GtkNotebook_val, Bool_val, Unit) +ML_2 (gtk_notebook_set_show_border, GtkNotebook_val, Bool_val, Unit) +ML_2 (gtk_notebook_set_scrollable, GtkNotebook_val, Bool_val, Unit) +ML_2 (gtk_notebook_set_tab_border, GtkNotebook_val, Int_val, Unit) +ML_1 (gtk_notebook_popup_enable, GtkNotebook_val, Unit) +ML_1 (gtk_notebook_popup_disable, GtkNotebook_val, Unit) + +ML_1 (gtk_notebook_get_current_page, GtkNotebook_val, Val_int) +ML_2 (gtk_notebook_set_page, GtkNotebook_val, Int_val, Unit) +ML_2 (gtk_notebook_get_nth_page, GtkNotebook_val, Int_val, Val_GtkWidget) +ML_2 (gtk_notebook_page_num, GtkNotebook_val, GtkWidget_val, Val_int) +ML_1 (gtk_notebook_next_page, GtkNotebook_val, Unit) +ML_1 (gtk_notebook_prev_page, GtkNotebook_val, Unit) + +ML_2 (gtk_notebook_get_tab_label, GtkNotebook_val, GtkWidget_val, + Val_GtkWidget) +ML_3 (gtk_notebook_set_tab_label, GtkNotebook_val, GtkWidget_val, + GtkWidget_val, Unit) +ML_2 (gtk_notebook_get_menu_label, GtkNotebook_val, GtkWidget_val, + Val_GtkWidget) +ML_3 (gtk_notebook_set_menu_label, GtkNotebook_val, GtkWidget_val, + GtkWidget_val, Unit) +ML_3 (gtk_notebook_reorder_child, GtkNotebook_val, GtkWidget_val, + Int_val, Unit) + + +/* gtkpacker.h */ + +Make_OptFlags_val(Packer_options_val) + +#define GtkPacker_val(val) check_cast(GTK_PACKER,val) +ML_0 (gtk_packer_new, Val_GtkWidget_sink) +ML_10 (gtk_packer_add, GtkPacker_val, GtkWidget_val, + Option_val(arg3,Side_type_val,GTK_SIDE_TOP) Ignore, + Option_val(arg4,Anchor_type_val,GTK_ANCHOR_CENTER) Ignore, + OptFlags_Packer_options_val, + Option_val(arg6,Int_val,GtkPacker_val(arg1)->default_border_width) Ignore, + Option_val(arg7,Int_val,GtkPacker_val(arg1)->default_pad_x) Ignore, + Option_val(arg8,Int_val,GtkPacker_val(arg1)->default_pad_y) Ignore, + Option_val(arg9,Int_val,GtkPacker_val(arg1)->default_i_pad_x) Ignore, + Option_val(arg10,Int_val,GtkPacker_val(arg1)->default_i_pad_y) Ignore, + Unit) +ML_bc10 (ml_gtk_packer_add) +ML_5 (gtk_packer_add_defaults, GtkPacker_val, GtkWidget_val, + Option_val(arg3,Side_type_val,GTK_SIDE_TOP) Ignore, + Option_val(arg4,Anchor_type_val,GTK_ANCHOR_CENTER) Ignore, + OptFlags_Packer_options_val, Unit) +ML_10 (gtk_packer_set_child_packing, GtkPacker_val, GtkWidget_val, + Option_val(arg3,Side_type_val,GTK_SIDE_TOP) Ignore, + Option_val(arg4,Anchor_type_val,GTK_ANCHOR_CENTER) Ignore, + OptFlags_Packer_options_val, + Option_val(arg6,Int_val,GtkPacker_val(arg1)->default_border_width) Ignore, + Option_val(arg7,Int_val,GtkPacker_val(arg1)->default_pad_x) Ignore, + Option_val(arg8,Int_val,GtkPacker_val(arg1)->default_pad_y) Ignore, + Option_val(arg9,Int_val,GtkPacker_val(arg1)->default_i_pad_x) Ignore, + Option_val(arg10,Int_val,GtkPacker_val(arg1)->default_i_pad_y) Ignore, + Unit) +ML_bc10 (ml_gtk_packer_set_child_packing) +ML_3 (gtk_packer_reorder_child, GtkPacker_val, GtkWidget_val, + Int_val, Unit) +ML_2 (gtk_packer_set_spacing, GtkPacker_val, Int_val, Unit) +value ml_gtk_packer_set_defaults (value w, value border_width, + value pad_x, value pad_y, + value i_pad_x, value i_pad_y) +{ + GtkPacker *p = GtkPacker_val(w); + if (Is_block(border_width)) + gtk_packer_set_default_border_width (p,Int_val(Field(border_width,0))); + if (Is_block(pad_x) || Is_block(pad_y)) + gtk_packer_set_default_pad + (p, Option_val(pad_x,Int_val,p->default_pad_x), + Option_val(pad_y,Int_val,p->default_pad_y)); + if (Is_block(i_pad_x) || Is_block(i_pad_y)) + gtk_packer_set_default_ipad + (p, Option_val(pad_x,Int_val,p->default_i_pad_x), + Option_val(pad_y,Int_val,p->default_i_pad_y)); + return Val_unit; +} +ML_bc6 (ml_gtk_packer_set_defaults) + +/* gtkpaned.h */ + +#define GtkPaned_val(val) check_cast(GTK_PANED,val) +ML_0 (gtk_hpaned_new, Val_GtkWidget_sink) +ML_0 (gtk_vpaned_new, Val_GtkWidget_sink) +ML_2 (gtk_paned_add1, GtkPaned_val, GtkWidget_val, Unit) +ML_2 (gtk_paned_add2, GtkPaned_val, GtkWidget_val, Unit) +ML_2 (gtk_paned_set_handle_size, GtkPaned_val, (gint16)Int_val, Unit) +ML_2 (gtk_paned_set_gutter_size, GtkPaned_val, (gint16)Int_val, Unit) +Make_Extractor (gtk_paned, GtkPaned_val, child1, Val_GtkWidget) +Make_Extractor (gtk_paned, GtkPaned_val, child2, Val_GtkWidget) +Make_Extractor (gtk_paned, GtkPaned_val, handle_size, Val_int) +Make_Extractor (gtk_paned, GtkPaned_val, gutter_size, Val_int) + +/* gtktable.h */ + +#define GtkTable_val(val) check_cast(GTK_TABLE,val) +ML_3 (gtk_table_new, Int_val, Int_val, Int_val, Val_GtkWidget_sink) +ML_10 (gtk_table_attach, GtkTable_val, GtkWidget_val, + Int_val, Int_val, Int_val, Int_val, + Flags_Attach_options_val, Flags_Attach_options_val, + Int_val, Int_val, Unit) +ML_bc10 (ml_gtk_table_attach) +ML_3 (gtk_table_set_row_spacing, GtkTable_val, Int_val, Int_val, Unit) +ML_3 (gtk_table_set_col_spacing, GtkTable_val, Int_val, Int_val, Unit) +ML_2 (gtk_table_set_row_spacings, GtkTable_val, Int_val, Unit) +ML_2 (gtk_table_set_col_spacings, GtkTable_val, Int_val, Unit) +ML_2 (gtk_table_set_homogeneous, GtkTable_val, Bool_val, Unit) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkrange.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkrange.c new file mode 100644 index 000000000..642d26909 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkrange.c @@ -0,0 +1,88 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtk_tags.h" + +/* gtkprogress.h */ + +#define GtkProgress_val(val) check_cast(GTK_PROGRESS,val) +ML_2 (gtk_progress_set_show_text, GtkProgress_val, Bool_val, Unit) +ML_3 (gtk_progress_set_text_alignment, GtkProgress_val, + Option_val(arg2,Float_val,(GtkProgress_val(arg1))->x_align) Ignore, + Option_val(arg3,Float_val,(GtkProgress_val(arg1))->y_align) Ignore, Unit) +ML_2 (gtk_progress_set_format_string, GtkProgress_val, String_val, Unit) +ML_2 (gtk_progress_set_adjustment, GtkProgress_val, GtkAdjustment_val, Unit) +ML_4 (gtk_progress_configure, GtkProgress_val, + Float_val, Float_val, Float_val, Unit) +ML_2 (gtk_progress_set_percentage, GtkProgress_val, Float_val, Unit) +ML_2 (gtk_progress_set_value, GtkProgress_val, Float_val, Unit) +ML_1 (gtk_progress_get_value, GtkProgress_val, copy_double) +ML_1 (gtk_progress_get_current_percentage, GtkProgress_val, copy_double) +ML_2 (gtk_progress_set_activity_mode, GtkProgress_val, Bool_val, Unit) +ML_1 (gtk_progress_get_current_text, GtkProgress_val, Val_string) +Make_Extractor (gtk_progress_get, GtkProgress_val, adjustment, + Val_GtkAny) + +/* gtkprogressbar.h */ + +#define GtkProgressBar_val(val) check_cast(GTK_PROGRESS_BAR,val) +ML_0 (gtk_progress_bar_new, Val_GtkWidget_sink) +ML_1 (gtk_progress_bar_new_with_adjustment, GtkAdjustment_val, + Val_GtkWidget_sink) +ML_2 (gtk_progress_bar_set_bar_style, GtkProgressBar_val, + Progress_bar_style_val, Unit) +ML_2 (gtk_progress_bar_set_discrete_blocks, GtkProgressBar_val, Int_val, Unit) +ML_2 (gtk_progress_bar_set_activity_step, GtkProgressBar_val, Int_val, Unit) +ML_2 (gtk_progress_bar_set_activity_blocks, GtkProgressBar_val, Int_val, Unit) +ML_2 (gtk_progress_bar_set_orientation, GtkProgressBar_val, + Progress_bar_orientation_val, Unit) +/* ML_2 (gtk_progress_bar_update, GtkProgressBar_val, Float_val, Unit) */ + +/* gtkrange.h */ + +#define GtkRange_val(val) check_cast(GTK_RANGE,val) +ML_1 (gtk_range_get_adjustment, GtkRange_val, Val_GtkAny) +ML_2 (gtk_range_set_adjustment, GtkRange_val, GtkAdjustment_val, Unit) +ML_2 (gtk_range_set_update_policy, GtkRange_val, Update_type_val, Unit) + +/* gtkscale.h */ + +#define GtkScale_val(val) check_cast(GTK_SCALE,val) +ML_2 (gtk_scale_set_digits, GtkScale_val, Int_val, Unit) +ML_2 (gtk_scale_set_draw_value, GtkScale_val, Bool_val, Unit) +ML_2 (gtk_scale_set_value_pos, GtkScale_val, Position_val, Unit) +ML_1 (gtk_scale_get_value_width, GtkScale_val, Val_int) +ML_1 (gtk_scale_draw_value, GtkScale_val, Unit) +ML_1 (gtk_hscale_new, GtkAdjustment_val, Val_GtkWidget_sink) +ML_1 (gtk_vscale_new, GtkAdjustment_val, Val_GtkWidget_sink) + +/* gtkscrollbar.h */ + +ML_1 (gtk_hscrollbar_new, GtkAdjustment_val, Val_GtkWidget_sink) +ML_1 (gtk_vscrollbar_new, GtkAdjustment_val, Val_GtkWidget_sink) + +/* gtkruler.h */ + +#define GtkRuler_val(val) check_cast(GTK_RULER,val) +ML_2 (gtk_ruler_set_metric, GtkRuler_val, Metric_type_val, Unit) +ML_5 (gtk_ruler_set_range, GtkRuler_val, Float_val, + Float_val, Float_val, Float_val, Unit) +Make_Extractor (gtk_ruler_get, GtkRuler_val, lower, copy_double) +Make_Extractor (gtk_ruler_get, GtkRuler_val, upper, copy_double) +Make_Extractor (gtk_ruler_get, GtkRuler_val, position, copy_double) +Make_Extractor (gtk_ruler_get, GtkRuler_val, max_size, copy_double) +ML_1 (gtk_ruler_draw_ticks, GtkRuler_val, Unit) +ML_1 (gtk_ruler_draw_pos, GtkRuler_val, Unit) +ML_0 (gtk_hruler_new, Val_GtkWidget_sink) +ML_0 (gtk_vruler_new, Val_GtkWidget_sink) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtktree.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtktree.c new file mode 100644 index 000000000..a1239c2a7 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtktree.c @@ -0,0 +1,53 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtk_tags.h" + +/* gtktreeitem.h */ + +#define GtkTreeItem_val(val) check_cast(GTK_TREE_ITEM,val) +ML_0 (gtk_tree_item_new, Val_GtkWidget_sink) +ML_1 (gtk_tree_item_new_with_label, String_val, Val_GtkWidget_sink) +ML_2 (gtk_tree_item_set_subtree, GtkTreeItem_val, GtkWidget_val, Unit) +ML_1 (gtk_tree_item_remove_subtree, GtkTreeItem_val, Unit) +ML_1 (gtk_tree_item_expand, GtkTreeItem_val, Unit) +ML_1 (gtk_tree_item_collapse, GtkTreeItem_val, Unit) +ML_1 (GTK_TREE_ITEM_SUBTREE, GtkTreeItem_val, Val_GtkWidget) + +/* gtktree.h */ + +#define GtkTree_val(val) check_cast(GTK_TREE,val) +ML_0 (gtk_tree_new, Val_GtkWidget_sink) +ML_3 (gtk_tree_insert, GtkTree_val, GtkWidget_val, Int_val, Unit) +ML_3 (gtk_tree_clear_items, GtkTree_val, Int_val, Int_val, Unit) +ML_2 (gtk_tree_select_item, GtkTree_val, Int_val, Unit) +ML_2 (gtk_tree_unselect_item, GtkTree_val, Int_val, Unit) +ML_2 (gtk_tree_child_position, GtkTree_val, GtkWidget_val, Val_int) +ML_2 (gtk_tree_set_selection_mode, GtkTree_val, Selection_mode_val, Unit) +ML_2 (gtk_tree_set_view_mode, GtkTree_val, Tree_view_mode_val, Unit) +ML_2 (gtk_tree_set_view_lines, GtkTree_val, Bool_val, Unit) + +static value val_gtkany (gpointer p) { return Val_GtkAny(p); } +value ml_gtk_tree_selection (value tree) +{ + GList *selection = GTK_TREE_SELECTION(GtkTree_val(tree)); + return Val_GList(selection, val_gtkany); +} +static gpointer gtkobject_val (value val) { return GtkObject_val(val); } +value ml_gtk_tree_remove_items (value tree, value items) +{ + GList *items_list = GList_val (items, gtkobject_val); + gtk_tree_remove_items (GtkTree_val(tree), items_list); + return Val_unit; +} diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkxmhtml.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkxmhtml.c new file mode 100644 index 000000000..54bd51ed0 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/ml_gtkxmhtml.c @@ -0,0 +1,76 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" +#include "ml_glib.h" +#include "ml_gdk.h" +#include "ml_gtk.h" +#include "gtkxmhtml_tags.h" + +/* conversion functions */ + +#include "gtkxmhtml_tags.c" + +Make_Flags_val (Line_type_val) + +#define GtkXmHTML_val(val) ((GtkXmHTML*)GtkObject_val(val)) + +ML_0 (gtk_xmhtml_new, Val_GtkAny_sink) +ML_1 (gtk_xmhtml_freeze, GtkXmHTML_val, Unit) +ML_1 (gtk_xmhtml_thaw, GtkXmHTML_val, Unit) +ML_2 (gtk_xmhtml_source, GtkXmHTML_val, String_val, Unit) +ML_2 (gtk_xmhtml_set_string_direction, GtkXmHTML_val, String_direction_val, + Unit) +ML_2 (gtk_xmhtml_set_alignment, GtkXmHTML_val, Alignment_val, Unit) +/* ML_2 (gtk_xmhtml_outline, GtkXmHTML_val, Bool_val, Unit) */ +ML_3 (gtk_xmhtml_set_font_familty, GtkXmHTML_val, String_val, String_val, Unit) +ML_3 (gtk_xmhtml_set_font_familty_fixed, GtkXmHTML_val, String_val, String_val, + Unit) +ML_2 (gtk_xmhtml_set_font_charset, GtkXmHTML_val, String_val, Unit) +ML_2 (gtk_xmhtml_set_allow_body_colors, GtkXmHTML_val, Bool_val, Unit) +ML_2 (gtk_xmhtml_set_hilight_on_enter, GtkXmHTML_val, Bool_val, Unit) +ML_2 (gtk_xmhtml_set_anchor_underline_type, GtkXmHTML_val, Flags_Line_type_val, + Unit) +ML_2 (gtk_xmhtml_set_anchor_visited_underline_type, GtkXmHTML_val, + Flags_Line_type_val, Unit) +ML_2 (gtk_xmhtml_set_anchor_target_underline_type, GtkXmHTML_val, + Flags_Line_type_val, Unit) +ML_2 (gtk_xmhtml_set_allow_color_switching, GtkXmHTML_val, Bool_val, Unit) +ML_2 (gtk_xmhtml_set_dithering, GtkXmHTML_val, Dither_type_val, Unit) +ML_2 (gtk_xmhtml_set_allow_font_switching, GtkXmHTML_val, Bool_val, Unit) +ML_2 (gtk_xmhtml_set_max_image_colors, GtkXmHTML_val, Int_val, Unit) +ML_2 (gtk_xmhtml_set_allow_images, GtkXmHTML_val, Bool_val, Unit) +ML_4 (gtk_xmhtml_set_plc_intervals, GtkXmHTML_val, Int_val, Int_val, Int_val, + Unit) +/* ML_2 (gtk_xmhtml_set_def_body_image_url, GtkXmHTML_val, String_val, Unit) */ +ML_2 (gtk_xmhtml_set_anchor_buttons, GtkXmHTML_val, Bool_val, Unit) +value ml_gtk_xmhtml_set_anchor_cursor(value html, value cursor) +{ + gtk_xmhtml_set_anchor_cursor + (GtkXmHTML_val(html), Option_val(cursor, GdkCursor_val, NULL), + Bool_val(cursor)); + return Val_unit; +} +ML_2 (gtk_xmhtml_set_topline, GtkXmHTML_val, Int_val, Unit) +ML_1 (gtk_xmhtml_get_topline, GtkXmHTML_val, Val_int) +ML_2 (gtk_xmhtml_set_freeze_animations, GtkXmHTML_val, Bool_val, Unit) +/* ML_1 (gtk_xmhtml_get_source, GtkXmHTML_val, copy_string) */ +ML_2 (gtk_xmhtml_set_screen_gamma, GtkXmHTML_val, Float_val, Unit) +/* ML_2 (gtk_xmhtml_set_event_proc, GtkXmHTML_val, ???, Unit) */ +ML_2 (gtk_xmhtml_set_perfect_colors, GtkXmHTML_val, Bool_val, Unit) +ML_2 (gtk_xmhtml_set_uncompress_command, GtkXmHTML_val, String_val, Unit) +ML_2 (gtk_xmhtml_set_strict_checking, GtkXmHTML_val, Bool_val, Unit) +ML_2 (gtk_xmhtml_set_bad_html_warnings, GtkXmHTML_val, Bool_val, Unit) +ML_2 (gtk_xmhtml_set_allow_form_coloring, GtkXmHTML_val, Bool_val, Unit) +ML_2 (gtk_xmhtml_set_imagemap_draw, GtkXmHTML_val, Bool_val, Unit) +ML_2 (gtk_xmhtml_set_mime_type, GtkXmHTML_val, String_val, Unit) +ML_2 (gtk_xmhtml_set_alpha_processing, GtkXmHTML_val, Bool_val, Unit) +ML_2 (gtk_xmhtml_set_rgb_conv_mode, GtkXmHTML_val, Dither_type_val, Unit) diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/varcc.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/varcc.ml new file mode 100644 index 000000000..100bee331 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/varcc.ml @@ -0,0 +1,157 @@ +(* $Id$ *) + +(* Compile a list of variant tags into CPP defines *) + +(* hash_variant, from ctype.ml *) + +let hash_variant s = + let accu = ref 0 in + for i = 0 to String.length s - 1 do + accu := 223 * !accu + Char.code s.[i] + done; + (* reduce to 31 bits *) + accu := !accu land (1 lsl 31 - 1); + (* make it signed for 64 bits architectures *) + if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu + +open Genlex + +let lexer = make_lexer ["type"; "public"; "="; "["; "]"; "`"; "|"] + +let may_string = parser + [< ' String s >] -> s + | [< >] -> "" + +let may_bar = parser + [< ' Kwd "|" >] -> () + | [< >] -> () + +let rec ident_list = parser + [< ' Kwd "`"; ' Ident x; trans = may_string; _ = may_bar; s >] -> + (x, trans) :: ident_list s + | [< >] -> [] + +let static = ref false +let may_public = parser + [< ' Kwd "public" >] -> true + | [< ' Kwd "private" >] -> false + | [< >] -> not !static + +open Printf + +let hashes = Hashtbl.create 57 + +let declaration ~hc ~cc = parser + [< ' Kwd "type"; public = may_public; ' Ident name; ' Kwd "="; + prefix = may_string; ' Kwd "["; _ = may_bar; + tags = ident_list; ' Kwd "]"; suffix = may_string >] -> + let oh x = fprintf hc x and oc x = fprintf cc x in + (* Output tag values to headers *) + let first = ref true in + List.iter tags ~f: + begin fun (tag, _) -> + let hash = hash_variant tag in + try + let tag' = Hashtbl.find hashes hash in + if tag <> tag' then + failwith (String.concat ~sep:" " ["Doublon tag:";tag;"and";tag']) + with Not_found -> + Hashtbl.add ~key:hash ~data:tag hashes; + if !first then begin + oh "/* %s : tags and macros */\n" name; first := false + end; + oh "#define MLTAG_%s\tVal_int(%d)\n" tag hash; + end; + (* compute C name *) + let ctag tag trans = + if trans <> "" then trans else + let tag = + if tag.[0] = '_' then + String.sub tag ~pos:1 ~len:(String.length tag -1) + else tag + in + match + if prefix = "" then None, "" + else + Some (prefix.[String.length prefix - 1]), + String.sub prefix ~pos:0 ~len:(String.length prefix - 1) + with + Some '#', prefix -> + prefix ^ String.uncapitalize tag ^ suffix + | Some '^', prefix -> + prefix ^ String.uppercase tag ^ suffix + | _ -> + prefix ^ tag ^ suffix + and cname = + String.capitalize name + in + let tags = + Sort.list tags + ~order:(fun (tag1,_) (tag2,_) -> hash_variant tag1 < hash_variant tag2) + in + (* Output table to code file *) + oc "/* %s : conversion table */\n" name; + let static = if not public then "static " else "" in + oc "%slookup_info ml_table_%s[] = {\n" static name; + oc " { 0, %d },\n" (List.length tags); + List.iter tags ~f: + begin fun (tag,trans) -> + oc " { MLTAG_%s, %s },\n" tag (ctag tag trans) + end; + oc "};\n\n"; + (* Output macros to headers *) + if not !first then oh "\n"; + if public then oh "extern lookup_info ml_table_%s[];\n" name; + oh "#define Val_%s(data) ml_lookup_from_c (ml_table_%s, data)\n" + name name; + oh "#define %s_val(key) ml_lookup_to_c (ml_table_%s, key)\n\n" + cname name; + | [< >] -> raise End_of_file + + +let process ic ~hc ~cc = + let chars = Stream.of_channel ic in + let s = lexer chars in + try + while true do declaration s ~hc ~cc done + with End_of_file -> () + | Stream.Error err -> + failwith + (Printf.sprintf "Parsing error \"%s\" at character %d on input stream" + err (Stream.count chars)) + +let main () = + let inputs = ref [] in + let header = ref "" in + let code = ref "" in + Arg.parse ~errmsg:"usage: varcc [options] file.var" ~keywords: + [ "-h", Arg.String ((:=) header), "file to output macros (file.h)"; + "-c", Arg.String ((:=) code), + "file to output conversion tables (file.c)"; + "-static", Arg.Set static, "do not export conversion tables" ] + ~others:(fun s -> inputs := s :: !inputs); + let inputs = List.rev !inputs in + begin match inputs with + | [] -> + if !header = "" then header := "a.h"; + if !code = "" then code := "a.c" + | ip :: _ -> + let rad = + if Filename.check_suffix ip ".var" then Filename.chop_extension ip + else ip in + if !header = "" then header := rad ^ ".h"; + if !code = "" then code := rad ^ ".c" + end; + let hc = open_out !header and cc = open_out !code in + let chars = Stream.of_channel stdin in + if inputs = [] then process stdin ~hc ~cc else begin + List.iter inputs ~f: + begin fun file -> + let ic = open_in file in + try process ic ~hc ~cc; close_in ic + with exn -> close_in ic; prerr_endline ("Error in " ^ file); raise exn + end + end; + close_out hc; close_out cc + +let _ = Printexc.print main () diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/wrappers.c b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/wrappers.c new file mode 100644 index 000000000..ee0f56797 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/wrappers.c @@ -0,0 +1,90 @@ +/* $Id$ */ + +#include +#include +#include +#include +#include +#include + +#include "wrappers.h" + +value copy_memblock_indirected (void *src, asize_t size) +{ + value ret = alloc (Wosize_asize(size)+2, Abstract_tag); + if (!src) ml_raise_null_pointer (); + + Field(ret,1) = 2; + memcpy (&Field(ret,2), src, size); + return ret; +} + +value ml_some (value v) +{ + CAMLparam1(v); + value ret = alloc_small(1,0); + Field(ret,0) = v; + CAMLreturn(ret); +} + +void ml_raise_null_pointer () +{ + static value * exn = NULL; + if (exn == NULL) + exn = caml_named_value ("null_pointer"); + raise_constant (*exn); +} + +value Val_pointer (void *ptr) +{ + value ret = alloc_small (2, Abstract_tag); + if (!ptr) ml_raise_null_pointer (); + Field(ret,1) = (value)ptr; + return ret; +} + +value copy_string_check (const char*str) +{ + if (!str) ml_raise_null_pointer (); + return copy_string ((char*) str); +} + +value copy_string_or_null (const char*str) +{ + return copy_string (str ? (char*) str : ""); +} + +value *ml_global_root_new (value v) +{ + value *p = stat_alloc(sizeof(value)); + *p = v; + register_global_root (p); + return p; +} + +void ml_global_root_destroy (void *data) +{ + remove_global_root ((value *)data); + stat_free (data); +} + +value ml_lookup_from_c (lookup_info *table, int data) +{ + int i; + for (i = table[0].data; i > 0; i--) + if (table[i].data == data) return table[i].key; + invalid_argument ("ml_lookup_from_c"); +} + +int ml_lookup_to_c (lookup_info *table, value key) +{ + int first = 1, last = table[0].data, current; + + while (first < last) { + current = (first+last)/2; + if (table[current].key >= key) last = current; + else first = current + 1; + } + if (table[first].key == key) return table[first].data; + invalid_argument ("ml_lookup_to_c"); +} diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/wrappers.h b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/wrappers.h new file mode 100644 index 000000000..2006bcbd5 --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/wrappers.h @@ -0,0 +1,225 @@ +/* $Id$ */ + +#ifndef _wrappers_ +#define _wrappers_ + +#include +#include + +value copy_memblock_indirected (void *src, asize_t size); +value ml_some (value); +void ml_raise_null_pointer (void) Noreturn; +value Val_pointer (void *); +value copy_string_check (const char*); +value copy_string_or_null (const char *); + +value *ml_global_root_new (value v); +void ml_global_root_destroy (void *data); + +typedef struct { value key; int data; } lookup_info; +value ml_lookup_from_c (lookup_info *table, int data); +int ml_lookup_to_c (lookup_info *table, value key); + +/* Wrapper generators */ + +#define ML_0(cname, conv) \ +value ml_##cname (value unit) { return conv (cname ()); } +#define ML_1(cname, conv1, conv) \ +value ml_##cname (value arg1) { return conv (cname (conv1 (arg1))); } +#define ML_1_post(cname, conv1, conv, post) \ +value ml_##cname (value arg1) \ +{ value ret = conv (cname (conv1(arg1))); post; return ret; } +#define ML_2(cname, conv1, conv2, conv) \ +value ml_##cname (value arg1, value arg2) \ +{ return conv (cname (conv1(arg1), conv2(arg2))); } +#define ML_2_name(mlname, cname, conv1, conv2, conv) \ +value mlname (value arg1, value arg2) \ +{ return conv (cname (conv1(arg1), conv2(arg2))); } +#define ML_3(cname, conv1, conv2, conv3, conv) \ +value ml_##cname (value arg1, value arg2, value arg3) \ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3))); } +#define ML_3_name(mlname, cname, conv1, conv2, conv3, conv) \ +value mlname (value arg1, value arg2, value arg3) \ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3))); } +#define ML_4(cname, conv1, conv2, conv3, conv4, conv) \ +value ml_##cname (value arg1, value arg2, value arg3, value arg4) \ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4))); } +#define ML_4_name(mlname, cname, conv1, conv2, conv3, conv4, conv) \ +value mlname (value arg1, value arg2, value arg3, value arg4) \ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4))); } +#define ML_5(cname, conv1, conv2, conv3, conv4, conv5, conv) \ +value ml_##cname (value arg1, value arg2, value arg3, value arg4, value arg5) \ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ + conv5(arg5))); } +#define ML_6(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv) \ +value ml_##cname (value arg1, value arg2, value arg3, value arg4, value arg5, \ + value arg6) \ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ + conv5(arg5), conv6(arg6))); } +#define ML_7(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv) \ +value ml_##cname (value arg1, value arg2, value arg3, value arg4, value arg5, \ + value arg6, value arg7) \ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ + conv5(arg5), conv6(arg6), conv7(arg7))); } +#define ML_8(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ + conv) \ +value ml_##cname (value arg1, value arg2, value arg3, value arg4, value arg5, \ + value arg6, value arg7, value arg8) \ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ + conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8))); } +#define ML_9(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ + conv9, conv) \ +value ml_##cname (value arg1, value arg2, value arg3, value arg4, value arg5, \ + value arg6, value arg7, value arg8, value arg9) \ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ + conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8), \ + conv9(arg9))); } +#define ML_10(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ + conv9, conv10, conv) \ +value ml_##cname (value arg1, value arg2, value arg3, value arg4, value arg5, \ + value arg6, value arg7, value arg8, value arg9, value arg10)\ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ + conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8), \ + conv9(arg9), conv10(arg10))); } +#define ML_11(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ + conv9, conv10, conv11, conv) \ +value ml_##cname (value arg1, value arg2, value arg3, value arg4, value arg5, \ + value arg6, value arg7, value arg8, value arg9, value arg10,\ + value arg11) \ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ + conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8), \ + conv9(arg9), conv10(arg10), conv11(arg11))); } +#define ML_12(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ + conv9, conv10, conv11, conv12, conv) \ +value ml_##cname (value arg1, value arg2, value arg3, value arg4, value arg5, \ + value arg6, value arg7, value arg8, value arg9, value arg10,\ + value arg11, value arg12) \ +{ return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ + conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8), \ + conv9(arg9), conv10(arg10), conv11(arg11), \ + conv12(arg12))); } + +/* Use with care: needs the argument index */ +#define Ignore(x) +#define Insert(x) (x), +#define Split(x,f,g) f(x), g(x) Ignore +#define Split3(x,f,g,h) f(x), g(x), h(x) Ignore +#define Pair(x,f,g) f(Field(x,0)), g(Field(x,1)) Ignore +#define Triple(x,f,g,h) f(Field(x,0)), g(Field(x,1)), h(Field(x,2)) Ignore + +/* For more than 5 arguments */ +#define ML_bc6(cname) \ +value cname##_bc (value *argv, int argn) \ +{ return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5]); } +#define ML_bc7(cname) \ +value cname##_bc (value *argv, int argn) \ +{ return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6]); } +#define ML_bc8(cname) \ +value cname##_bc (value *argv, int argn) \ +{ return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ + argv[7]); } +#define ML_bc9(cname) \ +value cname##_bc (value *argv, int argn) \ +{ return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ + argv[7],argv[8]); } +#define ML_bc10(cname) \ +value cname##_bc (value *argv, int argn) \ +{ return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ + argv[7],argv[8],argv[9]); } +#define ML_bc11(cname) \ +value cname##_bc (value *argv, int argn) \ +{ return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ + argv[7],argv[8],argv[9],argv[10]); } +#define ML_bc12(cname) \ +value cname##_bc (value *argv, int argn) \ +{ return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ + argv[7],argv[8],argv[9],argv[10],argv[11]); } + +/* result conversion */ +#define Unit(x) ((x), Val_unit) +#define Id(x) x +#define Val_char Val_int + +/* parameter conversion */ +#define Bool_ptr(x) ((long) x - 1) +#define Char_val Int_val +#define Float_val(x) ((float)Double_val(x)) + +#define Option_val(val,unwrap,default) \ +((long)val-1 ? unwrap(Field(val,0)) : default) +#define String_option_val(s) Option_val(s,String_val,NULL) + +/* Utility */ + +#define Copy_array(ret,l,src,conv) \ + if (!l) ret = Atom(0); \ + else if (l <= Max_young_wosize) { int i; ret = alloc_tuple(l); \ + for(i=0;ifield); } + +#define Make_Setter(name,conv1,conv2,field) \ +value ml_##name##_##field (value val, value new) \ +{ (conv1(val))->field = conv2(new); return Val_unit; } + +#define Make_Array_Extractor(name,conv1,conv2,field,conv) \ +value ml_##name##_##field (value val, value index) \ +{ return conv ((conv1(val))->field[conv2(index)]); } + +#define Make_Array_Setter(name,conv1,conv2,conv3,field) \ +value ml_##name##_##field (value val, value index, value new) \ +{ (conv1(val))->field[conv2(index)] = conv3(new); return Val_unit; } + +/* ML value is [flag list] */ +#define Make_Flags_val(conv) \ +int Flags_##conv (value list) \ +{ int flags = 0L; \ + while Is_block(list) { flags |= conv(Field(list,0)); list = Field(list,1); }\ + return flags; } + +/* ML value is [flag list option] */ +#define Make_OptFlags_val(conv) \ +int OptFlags_##conv (value list) \ +{ int flags = 0L; \ + if Is_block(list) list = Field(list,0); \ + while Is_block(list) { flags |= conv(Field(list,0)); list = Field(list,1); }\ + return flags; } + +#define Val_copy(val) copy_memblock_indirected (&val, sizeof(val)) +#define Val_string copy_string_check +#define Val_optstring copy_string_or_null +#define Optstring_val(v) (string_length(v) ? String_val(v) : (char*)NULL) +#define Val_option(v,f) (v ? ml_some(f(v)) : Val_unit) + +#define Check_null(v) (v ? v : (ml_raise_null_pointer (), v)) + +#endif /* _wrappers_ */