From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: X-Original-To: caml-list@sympa.inria.fr Delivered-To: caml-list@sympa.inria.fr Received: from mail2-relais-roc.national.inria.fr (mail2-relais-roc.national.inria.fr [192.134.164.83]) by sympa.inria.fr (Postfix) with ESMTPS id E3DA07EE4B for ; Fri, 4 Oct 2013 16:14:51 +0200 (CEST) Received-SPF: None (mail2-smtp-roc.national.inria.fr: no sender authenticity information available from domain of garrigue@math.nagoya-u.ac.jp) identity=pra; client-ip=133.6.130.5; receiver=mail2-smtp-roc.national.inria.fr; envelope-from="garrigue@math.nagoya-u.ac.jp"; x-sender="garrigue@math.nagoya-u.ac.jp"; x-conformance=sidf_compatible Received-SPF: None (mail2-smtp-roc.national.inria.fr: no sender authenticity information available from domain of garrigue@math.nagoya-u.ac.jp) identity=mailfrom; client-ip=133.6.130.5; receiver=mail2-smtp-roc.national.inria.fr; envelope-from="garrigue@math.nagoya-u.ac.jp"; x-sender="garrigue@math.nagoya-u.ac.jp"; x-conformance=sidf_compatible Received-SPF: None (mail2-smtp-roc.national.inria.fr: no sender authenticity information available from domain of postmaster@mailhost.math.nagoya-u.ac.jp) identity=helo; client-ip=133.6.130.5; receiver=mail2-smtp-roc.national.inria.fr; envelope-from="garrigue@math.nagoya-u.ac.jp"; x-sender="postmaster@mailhost.math.nagoya-u.ac.jp"; x-conformance=sidf_compatible X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: AmABAHrMTlKFBoIFnGdsb2JhbABZgz/CGoEwDgEBAQEBCBQJPIIlAQEEASccATUCAwsLGBwSVxmIAAWoQYRWAoVLiQ0Hj1EHFoMJgQSJOoZxh1mBL5QD X-IPAS-Result: AmABAHrMTlKFBoIFnGdsb2JhbABZgz/CGoEwDgEBAQEBCBQJPIIlAQEEASccATUCAwsLGBwSVxmIAAWoQYRWAoVLiQ0Hj1EHFoMJgQSJOoZxh1mBL5QD X-IronPort-AV: E=Sophos;i="4.90,1033,1371074400"; d="diff'?scan'208";a="35605147" Received: from rabbit.math.nagoya-u.ac.jp (HELO mailhost.math.nagoya-u.ac.jp) ([133.6.130.5]) by mail2-smtp-roc.national.inria.fr with ESMTP; 04 Oct 2013 16:14:48 +0200 Received: from mailhost.math.nagoya-u.ac.jp (localhost [127.0.0.1]) by mailhost.math.nagoya-u.ac.jp (Postfix) with ESMTP id 3469963B6; Fri, 4 Oct 2013 23:14:42 +0900 (JST) Received: from mailhost.math.nagoya-u.ac.jp (localhost [127.0.0.1]) by mailhost.math.nagoya-u.ac.jp (Postfix) with ESMTP id A4BE23A0E; Fri, 4 Oct 2013 23:14:41 +0900 (JST) DomainKey-Signature: h=Received:Content-Type:Mime-Version:Subject:From:In-Reply-To:Date:Cc:Message-Id:References:To:X-Mailer; b=; c=nofws; d=math.nagoya-u.ac.jp; q=; s=alpha Received: from tet.garrigue.jp (58x158x128x157.ap58.ftth.ucom.ne.jp [58.158.128.157]) by mailhost.math.nagoya-u.ac.jp (Postfix) with ESMTPSA id 526883997; Fri, 4 Oct 2013 23:14:41 +0900 (JST) Content-Type: multipart/mixed; boundary="Apple-Mail=_3F6CDCB6-75DC-4C83-9F79-08D9FAAA5DF3" Mime-Version: 1.0 (Mac OS X Mail 6.6 \(1510\)) From: Jacques Garrigue In-Reply-To: <524E0AAD.9000909@colba.net> Date: Fri, 4 Oct 2013 23:14:40 +0900 Cc: caml-list@inria.fr Message-Id: <8F7C01DD-62CF-42F9-9124-E0F39324E21F@math.nagoya-u.ac.jp> References: <524E0AAD.9000909@colba.net> To: eliot@colba.net X-Mailer: Apple Mail (2.1510) Subject: Re: [Caml-list] Adding ttk (tile tk) bindings to labltk --Apple-Mail=_3F6CDCB6-75DC-4C83-9F79-08D9FAAA5DF3 Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset=windows-1252 On 2013/10/04, at 9:24, Eliot Handelman wrote: > On 10/03/2013 05:45 AM, Tim Cuthbertson wrote: >>=20 >> Does anyone know if it's possible to add ttk widgets to labltk? Is there= a library other than labltk that I should be using for ttk? >=20 > It is for me -- here's how I got LabelFrame going: >=20 > open Tk > open Protocol >=20 > let tokenize strings =3D > Arr.of_list (L1.map (fun s -> TkToken s) strings) >=20 > let tk_command string_list =3D > Protocol.tkCommand (tokenize string_list) >=20 > let tk_eval string_list =3D > Protocol.tkEval (tokenize string_list) >=20 > let after ms =3D > tk_command [ "after"; string_of_int ms] >=20 > module LabelFrame =3D struct > let id =3D ref 0 > let create ?(text =3D "") top =3D > let i =3D int !id in > incr id; > let lf_name =3D (Widget.name top) ^ ".labelframe" ^ i in > tk_command > ["ttk::labelframe"; lf_name; > "-text"; text > ]; > Protocol.cTKtoCAMLwidget lf_name > end >=20 > best, This code could easily be generated by tkcompiler (i.e. adding it to WIdget= .src), but for the use of :: inside the name, as it isn't a valid ocaml name. The simplest is probably to slightly modify tkcompiler to handle namespaces. [=85] Well I tried that approach, and at this point it's rather painful. The additions to Widget.src are minimal, but the widget types are hardcoded, so you end up by having to modify more things than you should. A bit of refactoring would solve that. Jacques Garrigue Here is the patch to just to modify tkcompiler and add ttk_labelframe. --Apple-Mail=_3F6CDCB6-75DC-4C83-9F79-08D9FAAA5DF3 Content-Disposition: attachment; filename=ttk_labelframe.diff Content-Type: application/octet-stream; x-unix-mode=0644; name="ttk_labelframe.diff" Content-Transfer-Encoding: 7bit diff --git a/Widgets.src b/Widgets.src index e662682..8f8b50f 100644 --- a/Widgets.src +++ b/Widgets.src @@ -2302,3 +2302,11 @@ module Encoding { function () system_set ["encoding"; "system"; string] function (string) system_get ["encoding"; "system"] } + +% ttk::labelframe +widget "ttk::labelframe" { + function (string) after [int] +} +subtype option("ttk::labelframe") { + Text +} diff --git a/camltk/modules b/camltk/modules index f9fabde..6f5e521 100644 --- a/camltk/modules +++ b/camltk/modules @@ -1,5 +1,5 @@ -CWIDGETOBJS= cBell.cmo cScale.cmo cWinfo.cmo cScrollbar.cmo cEntry.cmo cListbox.cmo cWm.cmo cTkwait.cmo cGrab.cmo cFont.cmo cCanvas.cmo cImage.cmo cClipboard.cmo cLabel.cmo cResource.cmo cMessage.cmo cText.cmo cImagephoto.cmo cOption.cmo cFrame.cmo cSelection.cmo cDialog.cmo cPlace.cmo cPixmap.cmo cMenubutton.cmo cRadiobutton.cmo cFocus.cmo cPack.cmo cImagebitmap.cmo cEncoding.cmo cOptionmenu.cmo cCheckbutton.cmo cTkvars.cmo cPalette.cmo cMenu.cmo cButton.cmo cToplevel.cmo cGrid.cmo -cBell.ml cScale.ml cWinfo.ml cScrollbar.ml cEntry.ml cListbox.ml cWm.ml cTkwait.ml cGrab.ml cFont.ml cCanvas.ml cImage.ml cClipboard.ml cLabel.ml cResource.ml cMessage.ml cText.ml cImagephoto.ml cOption.ml cFrame.ml cSelection.ml cDialog.ml cPlace.ml cPixmap.ml cMenubutton.ml cRadiobutton.ml cFocus.ml cPack.ml cImagebitmap.ml cEncoding.ml cOptionmenu.ml cCheckbutton.ml cTkvars.ml cPalette.ml cMenu.ml cButton.ml cToplevel.ml cGrid.ml : _tkgen.ml +CWIDGETOBJS= cBell.cmo cScale.cmo cWinfo.cmo cScrollbar.cmo cEntry.cmo cListbox.cmo cWm.cmo cTkwait.cmo cGrab.cmo cFont.cmo cCanvas.cmo cImage.cmo cClipboard.cmo cLabel.cmo cResource.cmo cMessage.cmo cText.cmo cImagephoto.cmo cOption.cmo cFrame.cmo cSelection.cmo cDialog.cmo cPlace.cmo cTtk_labelframe.cmo cPixmap.cmo cMenubutton.cmo cRadiobutton.cmo cFocus.cmo cPack.cmo cImagebitmap.cmo cEncoding.cmo cOptionmenu.cmo cCheckbutton.cmo cTkvars.cmo cPalette.cmo cMenu.cmo cButton.cmo cToplevel.cmo cGrid.cmo +cBell.ml cScale.ml cWinfo.ml cScrollbar.ml cEntry.ml cListbox.ml cWm.ml cTkwait.ml cGrab.ml cFont.ml cCanvas.ml cImage.ml cClipboard.ml cLabel.ml cResource.ml cMessage.ml cText.ml cImagephoto.ml cOption.ml cFrame.ml cSelection.ml cDialog.ml cPlace.ml cTtk_labelframe.ml cPixmap.ml cMenubutton.ml cRadiobutton.ml cFocus.ml cPack.ml cImagebitmap.ml cEncoding.ml cOptionmenu.ml cCheckbutton.ml cTkvars.ml cPalette.ml cMenu.ml cButton.ml cToplevel.ml cGrid.ml : _tkgen.ml cBell.cmo : cBell.ml cBell.cmi : cBell.mli @@ -47,6 +47,8 @@ cDialog.cmo : cDialog.ml cDialog.cmi : cDialog.mli cPlace.cmo : cPlace.ml cPlace.cmi : cPlace.mli +cTtk_labelframe.cmo : cTtk_labelframe.ml +cTtk_labelframe.cmi : cTtk_labelframe.mli cPixmap.cmo : cPixmap.ml cPixmap.cmi : cPixmap.mli cMenubutton.cmo : cMenubutton.ml @@ -77,4 +79,4 @@ cToplevel.cmo : cToplevel.ml cToplevel.cmi : cToplevel.mli cGrid.cmo : cGrid.ml cGrid.cmi : cGrid.mli -camltk.cmo : cTk.cmo cBell.cmo cScale.cmo cWinfo.cmo cScrollbar.cmo cEntry.cmo cListbox.cmo cWm.cmo cTkwait.cmo cGrab.cmo cFont.cmo cCanvas.cmo cImage.cmo cClipboard.cmo cLabel.cmo cResource.cmo cMessage.cmo cText.cmo cImagephoto.cmo cOption.cmo cFrame.cmo cSelection.cmo cDialog.cmo cPlace.cmo cPixmap.cmo cMenubutton.cmo cRadiobutton.cmo cFocus.cmo cPack.cmo cImagebitmap.cmo cEncoding.cmo cOptionmenu.cmo cCheckbutton.cmo cTkvars.cmo cPalette.cmo cMenu.cmo cButton.cmo cToplevel.cmo cGrid.cmo +camltk.cmo : cTk.cmo cBell.cmo cScale.cmo cWinfo.cmo cScrollbar.cmo cEntry.cmo cListbox.cmo cWm.cmo cTkwait.cmo cGrab.cmo cFont.cmo cCanvas.cmo cImage.cmo cClipboard.cmo cLabel.cmo cResource.cmo cMessage.cmo cText.cmo cImagephoto.cmo cOption.cmo cFrame.cmo cSelection.cmo cDialog.cmo cPlace.cmo cTtk_labelframe.cmo cPixmap.cmo cMenubutton.cmo cRadiobutton.cmo cFocus.cmo cPack.cmo cImagebitmap.cmo cEncoding.cmo cOptionmenu.cmo cCheckbutton.cmo cTkvars.cmo cPalette.cmo cMenu.cmo cButton.cmo cToplevel.cmo cGrid.cmo diff --git a/compiler/compile.ml b/compiler/compile.ml index 029cce7..18c95ab 100644 --- a/compiler/compile.ml +++ b/compiler/compile.ml @@ -80,6 +80,15 @@ let count ~item:x l = List.iter ~f:(fun y -> if x = y then incr count) l; !count +let caml_name s = + let b = Buffer.create (String.length s) in + for i = 0 to String.length s - 1 do + let c = s.[i] in + if c <> ':' then Buffer.add_char b c + else if i > 0 && s.[i-1] = ':' then Buffer.add_char b '_' + done; + Buffer.contents b + (* Extract all types from a template *) let rec types_of_template = function StringArg _ -> [] @@ -108,10 +117,10 @@ let ppMLtype ?(any=false) ?(return=false) ?(def=false) ?(counter=ref 0) = | String -> "string" (* new *) | List (Subtype (sup, sub)) -> - if !Flags.camltk then "(* " ^ sub ^ " *) " ^ sup ^ " list" + if !Flags.camltk then "(* " ^ sub ^ " *) " ^ caml_name sup ^ " list" else begin if return then - sub ^ "_" ^ sup ^ " list" + caml_name sub ^ "_" ^ caml_name sup ^ " list" else begin try let typdef = Hashtbl.find types_table sup in @@ -145,7 +154,8 @@ let ppMLtype ?(any=false) ?(return=false) ?(def=false) ?(counter=ref 0) = String.concat ~sep:" * " (List.map tyl ~f:(fun (l, t) -> typelabel l ^ ppMLtype t)) | Subtype ("widget", sub) -> - if !Flags.camltk then "(* " ^ sub ^" *) widget" else sub ^ " widget" + if !Flags.camltk then "(* " ^ sub ^" *) widget" else + caml_name sub ^ " widget" | UserDefined "widget" -> if !Flags.camltk then "widget" else begin @@ -182,7 +192,8 @@ let ppMLtype ?(any=false) ?(return=false) ?(def=false) ?(counter=ref 0) = with Not_found -> s end | Subtype (s, s') -> - if !Flags.camltk then "(* " ^ s' ^ " *) " ^ s else s' ^ "_" ^ s + if !Flags.camltk then "(* " ^ s' ^ " *) " ^ caml_name s else + caml_name s' ^ "_" ^ caml_name s | Function (Product tyl) -> raise (Failure "Function (Product tyl) ? ppMLtype") | Function (Record tyl) -> @@ -300,13 +311,13 @@ let camltk_write_type ~intf:w ~impl:w' name ~def:typdef = (sort_components typdef.constructors); w "\n\n"; (* The set of all constructors *) - w' ("let "^name^"_any_table = ["); + w' ("let "^caml_name name^"_any_table = ["); write_constructor_set ~w:w' ~sep:"; " (sort_components typdef.constructors); w' ("]\n\n"); (* The subset of constructors for each subtype *) List.iter ~f:(function (s,l) -> - w' ("let "^name^"_"^s^"_table = ["); + w' ("let "^caml_name name^"_"^caml_name s^"_table = ["); write_constructor_set ~w:w' ~sep:"; " (sort_components l); w' ("]\n\n")) typdef.subtypes @@ -576,7 +587,7 @@ let rec converterCAMLtoTK ~context_widget argname ty = | Subtype ("widget", s') -> if !Flags.camltk then let name = "cCAMLtoTKwidget " in - let args = "widget_"^s'^"_table "^argname in + let args = "widget_"^caml_name s'^"_table "^argname in let args = if requires_widget_context "widget" then context_widget^" "^args @@ -584,7 +595,7 @@ let rec converterCAMLtoTK ~context_widget argname ty = name^args else begin let name = "cCAMLtoTKwidget " in - let args = "(" ^ argname ^ " : " ^ s' ^ " widget)" in + let args = "(" ^ argname ^ " : " ^ caml_name s' ^ " widget)" in name ^ args end | Subtype (s, s') -> @@ -594,9 +605,10 @@ let rec converterCAMLtoTK ~context_widget argname ty = in let args = if !Flags.camltk then begin - s^"_"^s'^"_table "^argname + caml_name s^"_"^caml_name s'^"_table "^argname end else begin - if safetype then "(" ^ argname ^ " : [< " ^ s' ^ "_" ^ s ^ "])" + if safetype then + "(" ^ argname ^ " : [< " ^ caml_name s' ^ "_" ^ caml_name s ^ "])" else argname end in @@ -842,7 +854,7 @@ let rec write_result_parsing ~w = function | MultipleToken -> w (converterTKtoCAML ~arg:"(splitlist res)" ty) let labltk_write_function ~w def = - w ("let " ^ def.ml_name); + w ("let " ^ caml_name def.ml_name); (* a bit approximative *) let context_widget = match def.template with ListArg (TypeArg(_, UserDefined("widget")) :: _) -> "v1" @@ -891,7 +903,7 @@ let labltk_write_function ~w def = w "\n\n" let camltk_write_function ~w def = - w ("let " ^ def.ml_name); + w ("let " ^ caml_name def.ml_name); (* a bit approximative *) let context_widget = match def.template with ListArg (TypeArg(_, UserDefined("widget")) :: _) -> "v1" @@ -969,8 +981,9 @@ let write_function ~w def = ;; let labltk_write_create ~w clas = + let oclas = caml_name clas in w ("let create ?name =\n"); - w (" " ^ clas ^ "_options_optionals (fun opts parent ->\n"); + w (" " ^ oclas ^ "_options_optionals (fun opts parent ->\n"); w (" let w = new_atom \"" ^ clas ^ "\" ~parent ?name in\n"); w " tkCommand [|"; w ("TkToken \"" ^ clas ^ "\";\n"); @@ -1044,7 +1057,8 @@ let write_catch_optionals ~w clas ~def:typdef = if typdef.subtypes = [] then () else List.iter typdef.subtypes ~f: begin fun (subclass, classdefs) -> - w ("let " ^ subclass ^ "_" ^ clas ^ "_optionals f = fun\n"); + w ("let " ^ caml_name subclass ^ "_" ^ caml_name clas ^ + "_optionals f = fun\n"); let tklabels = List.map ~f:gettklabel classdefs in let l = List.map classdefs ~f: @@ -1062,7 +1076,7 @@ let write_catch_optionals ~w clas ~def:typdef = let v = List.map l ~f: begin fun (si, s) -> - "(maycons ccCAMLtoTK" ^ clas ^ "_" ^ s ^ " " ^ si + "(maycons ccCAMLtoTK" ^ caml_name clas ^ "_" ^ caml_name s ^ " " ^ si end in w (String.concat ~sep:"\n" p); w " ->\n"; diff --git a/compiler/intf.ml b/compiler/intf.ml index 42ad1b3..7f92259 100644 --- a/compiler/intf.ml +++ b/compiler/intf.ml @@ -49,7 +49,7 @@ let labltk_write_create_p ~w wname = end)) with Not_found -> fatal_error "in write_create_p" end; - w (" ->\n 'a widget -> " ^ wname ^ " widget\n"); + w (" ->\n 'a widget -> " ^ caml_name wname ^ " widget\n"); w "(** [create ?name parent options...] creates a new widget with\n"; w " parent [parent] and new patch component [name], if specified. *)\n\n" ;; diff --git a/compiler/maincompile.ml b/compiler/maincompile.ml index 74b144d..7b370a2 100644 --- a/compiler/maincompile.ml +++ b/compiler/maincompile.ml @@ -166,6 +166,7 @@ let option_hack oc = let realname name = (* module name fix for camltk *) + let name = caml_name name in if !Flags.camltk then "c" ^ String.capitalize name else name ;; @@ -290,7 +291,7 @@ let compile () = Hashtbl.iter (fun name _ -> let cname = realname name in output_string oc (Printf.sprintf "module %s = %s;;\n" - (String.capitalize name) + (String.capitalize (caml_name name)) (String.capitalize cname))) module_table; close_out oc end else begin @@ -311,13 +312,14 @@ module Timer = Timer;;\n\ Hashtbl.iter (fun name _ -> let cname = realname name in output_string oc (Printf.sprintf "module %s = %s;;\n" - (String.capitalize name) + (String.capitalize (caml_name name)) (String.capitalize cname))) module_table; (* widget typer *) output_string oc "\n(** Widget typers *)\n\nopen Widget\n\n"; Hashtbl.iter (fun name def -> match def.module_type with | Widget -> + let name = caml_name name in output_string oc (Printf.sprintf "let %s (w : any widget) =\n" name); output_string oc (Printf.sprintf diff --git a/compiler/parser.mly b/compiler/parser.mly index 6dc7aff..0471273 100644 --- a/compiler/parser.mly +++ b/compiler/parser.mly @@ -306,7 +306,12 @@ ParserArity : { MultipleToken } ; - +ModuleName : + IDENT + { $1 } + | STRING + { $1 } +; entry : TYPE ParserArity TypeName LBRACE Constructors RBRACE @@ -315,15 +320,15 @@ entry : { enter_type $4 $3 $6 ~variant: true } | TYPE ParserArity TypeName EXTERNAL { enter_external_type $3 $2 } -| SUBTYPE ParserArity OPTION LPAREN IDENT RPAREN LBRACE AbbrevConstructors RBRACE +| SUBTYPE ParserArity OPTION LPAREN ModuleName RPAREN LBRACE AbbrevConstructors RBRACE { enter_subtype "options" $2 $5 $8 } | SUBTYPE ParserArity TypeName LPAREN IDENT RPAREN LBRACE AbbrevConstructors RBRACE { enter_subtype $3 $2 $5 $8 } | Command { enter_function $1 } -| WIDGET IDENT LBRACE WidgetComponents RBRACE +| WIDGET ModuleName LBRACE WidgetComponents RBRACE { enter_widget $2 $4 } -| MODULE IDENT LBRACE ModuleComponents RBRACE +| MODULE ModuleName LBRACE ModuleComponents RBRACE { enter_module (String.uncapitalize $2) $4 } | EOF { raise End_of_file } diff --git a/labltk/modules b/labltk/modules index 6298817..aafadae 100644 --- a/labltk/modules +++ b/labltk/modules @@ -1,5 +1,5 @@ -WIDGETOBJS= bell.cmo scale.cmo winfo.cmo scrollbar.cmo entry.cmo listbox.cmo wm.cmo tkwait.cmo grab.cmo font.cmo canvas.cmo image.cmo clipboard.cmo label.cmo message.cmo text.cmo imagephoto.cmo option.cmo frame.cmo selection.cmo dialog.cmo place.cmo pixmap.cmo menubutton.cmo radiobutton.cmo focus.cmo pack.cmo imagebitmap.cmo encoding.cmo optionmenu.cmo checkbutton.cmo tkvars.cmo palette.cmo menu.cmo button.cmo toplevel.cmo grid.cmo -bell.ml scale.ml winfo.ml scrollbar.ml entry.ml listbox.ml wm.ml tkwait.ml grab.ml font.ml canvas.ml image.ml clipboard.ml label.ml message.ml text.ml imagephoto.ml option.ml frame.ml selection.ml dialog.ml place.ml pixmap.ml menubutton.ml radiobutton.ml focus.ml pack.ml imagebitmap.ml encoding.ml optionmenu.ml checkbutton.ml tkvars.ml palette.ml menu.ml button.ml toplevel.ml grid.ml : _tkgen.ml +WIDGETOBJS= bell.cmo scale.cmo winfo.cmo scrollbar.cmo entry.cmo listbox.cmo wm.cmo tkwait.cmo grab.cmo font.cmo canvas.cmo image.cmo clipboard.cmo label.cmo message.cmo text.cmo imagephoto.cmo option.cmo frame.cmo selection.cmo dialog.cmo place.cmo ttk_labelframe.cmo pixmap.cmo menubutton.cmo radiobutton.cmo focus.cmo pack.cmo imagebitmap.cmo encoding.cmo optionmenu.cmo checkbutton.cmo tkvars.cmo palette.cmo menu.cmo button.cmo toplevel.cmo grid.cmo +bell.ml scale.ml winfo.ml scrollbar.ml entry.ml listbox.ml wm.ml tkwait.ml grab.ml font.ml canvas.ml image.ml clipboard.ml label.ml message.ml text.ml imagephoto.ml option.ml frame.ml selection.ml dialog.ml place.ml ttk_labelframe.ml pixmap.ml menubutton.ml radiobutton.ml focus.ml pack.ml imagebitmap.ml encoding.ml optionmenu.ml checkbutton.ml tkvars.ml palette.ml menu.ml button.ml toplevel.ml grid.ml : _tkgen.ml bell.cmo : bell.ml bell.cmi : bell.mli @@ -45,6 +45,8 @@ dialog.cmo : dialog.ml dialog.cmi : dialog.mli place.cmo : place.ml place.cmi : place.mli +ttk_labelframe.cmo : ttk_labelframe.ml +ttk_labelframe.cmi : ttk_labelframe.mli pixmap.cmo : pixmap.ml pixmap.cmi : pixmap.mli menubutton.cmo : menubutton.ml diff --git a/support/rawwidget.ml b/support/rawwidget.ml index d4344ad..48d4a0c 100644 --- a/support/rawwidget.ml +++ b/support/rawwidget.ml @@ -47,6 +47,7 @@ and scale and scrollbar and text and toplevel +and ttk_labelframe let forget_type w = (Obj.magic (w : 'a raw_widget) : raw_any raw_widget) let coe = forget_type @@ -122,6 +123,7 @@ and widget_scale_table = [ "scale" ] and widget_scrollbar_table = [ "scrollbar" ] and widget_text_table = [ "text" ] and widget_toplevel_table = [ "toplevel" ] +and widget_ttk_labelframe_table = [ "ttk::labelframe" ] let new_suffix clas n = try diff --git a/support/rawwidget.mli b/support/rawwidget.mli index e9f82ef..c9ac895 100644 --- a/support/rawwidget.mli +++ b/support/rawwidget.mli @@ -37,6 +37,7 @@ and scale and scrollbar and text and toplevel +and ttk_labelframe val forget_type : 'a raw_widget -> raw_any raw_widget val coe : 'a raw_widget -> raw_any raw_widget @@ -100,6 +101,7 @@ val widget_scale_table : string list val widget_scrollbar_table : string list val widget_text_table : string list val widget_toplevel_table : string list +val widget_ttk_labelframe_table : string list val chk_sub : string -> 'a list -> 'a -> unit val check_class : 'a raw_widget -> string list -> unit diff --git a/support/widget.mli b/support/widget.mli index 7761f2f..9d85050 100644 --- a/support/widget.mli +++ b/support/widget.mli @@ -37,6 +37,7 @@ and scale and scrollbar and text and toplevel +and ttk_labelframe val forget_type : 'a widget -> any widget val coe : 'a widget -> any widget @@ -100,6 +101,7 @@ val widget_scale_table : string list val widget_scrollbar_table : string list val widget_text_table : string list val widget_toplevel_table : string list +val widget_ttk_labelframe_table : string list val chk_sub : string -> 'a list -> 'a -> unit val check_class : 'a widget -> string list -> unit --Apple-Mail=_3F6CDCB6-75DC-4C83-9F79-08D9FAAA5DF3--