fltkhs 0.4.0.5 → 0.4.0.6

raw patch · 17 files changed

+386/−113 lines, 17 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +61/−13
• c-src/Fl_CallbackC.cpp +36/−0
• c-src/Fl_CallbackC.h +5/−0
• c-src/Fl_Menu_BarC.cpp +22/−0
• c-src/Fl_Menu_BarC.h +19/−0
• c-src/Fl_Sys_Menu_BarC.cpp +7/−0
• c-src/Fl_Sys_Menu_BarC.h +0/−1
• c-src/Fl_Types.h +1/−0
• c-src/Makefile.in +1/−0
• fltkhs.cabal +2/−1
• src/Graphics/UI/FLTK/LowLevel/Clock.chs +9/−1
• src/Graphics/UI/FLTK/LowLevel/FLTKHS.hs +2/−0
• src/Graphics/UI/FLTK/LowLevel/Hierarchy.hs +19/−3
• src/Graphics/UI/FLTK/LowLevel/MenuBar.chs +72/−0
• src/Graphics/UI/FLTK/LowLevel/MenuItem.chs +49/−29
• src/Graphics/UI/FLTK/LowLevel/MenuPrim.chs +51/−63
• src/Graphics/UI/FLTK/LowLevel/SysMenuBar.chs +30/−2

@@ -5,33 +5,81 @@  NOTE: As of version 0.4.0.0, due to the introduction of closed type families, only GHC >= 7.8.1 is supported. -Abbreviated installation instructions are for Linux and Mac are:+Quick Install+-------------+### Linux and *BSD+Install FLTK-1.3.3 from source: -- Download [FLTK 1.3.3] [2].-- Install with: ```-    > ./configure --enable-shared-    > make-    > make install+   > wget http://fltk.org/pub/fltk/1.3.3/fltk-1.3.3-source.tar.gz+   > tar -zxvf fltk-1.3.3-source.tar.gz+   > cd fltk-1.3.3+   > configure --enable-shared+   > make+   > sudo make install+   > fltk-config --version+   1.3.3 ``` -- Install via the `fltkhs-hello-world` skeleton application:+Build the FLTKHS skeleton project:+ ```-    > git clone https://github.com/deech/fltkhs-hello-world-    > cd fltkhs-hello-world-    > stack build+   > git clone http://github.com/deech/fltkhs-hello-world+   > cd fltkhs-hello-world+   > stack install+   # About 6-8 minutes passes ...+   > stack exec fltkhs-hello-world ``` -- Test your installation by invoking: 'stack exec fltkhs-hello-world'.+### OSX Yosemite only -The rest of the documentation (including installation instructions for Windows and API usage) is located in the [FLTKHS module] [3]. This is the primary module that needs to be imported by every Fltkhs app and the entry point into the application.+Install FLTK-1.3.3 from Brew: +```+   > brew install autoconf+   > brew install fltk+   > fltk-config --version+   1.3.3+```+Build the FLTKHS skeleton project:++```+   > git clone http://github.com/deech/fltkhs-hello-world+   > cd fltkhs-hello-world+   > stack install+   # About 6-8 minutes passes ...+   > stack exec fltkhs-hello-world+```++### OSX El Capitan only++Install the development version of FLTK from Brew:++```+  > brew install --devel fltk+  > fltk-config --version+  1.3.4+```+Build the FLTKHS skeleton project:++```+   > git clone http://github.com/deech/fltkhs-hello-world+   > cd fltkhs-hello-world+   > stack install+   # About 6-8 minutes passes ...+   > stack exec fltkhs-hello-world+```++### Windows++Please see the [detailed Windows installation instructions](http://hackage.haskell.org/package/fltkhs/docs/Graphics-UI-FLTK-LowLevel-FLTKHS.html#g:7)+ Screenshots -----------  [Drawing with FLTKHS](images/arc-windows.png) -[A table of widgets](images/widget-table.png)+[A table of widgets](images/widget-table-windows.png)  [A complex tree](images/tree-complex-windows.png) Done completely using Fluid. Notice how tree nodes can be arbitrary widgets. 

@@ -85,6 +85,24 @@     return menu_->insert(index,name,shortcut,NULL,p,flags);   } }+int C_to_Fl_Callback::menu_insert(Fl_Sys_Menu_Bar* menu_, int index, char* name, int shortcut, int flags){+  if (this->callback) {+    return menu_->insert(index,name,shortcut,intercept,this,flags);+  }+  else {+    void* p = 0;+    return menu_->insert(index,name,shortcut,NULL,p,flags);+  }+}+int C_to_Fl_Callback::menu_insert(Fl_Sys_Menu_Bar* menu_, int index, char* name, char* shortcut, int flags){+  if (this->callback) {+    return menu_->insert(index,name,shortcut,intercept,this,flags);+  }+  else {+    void* p = 0;+    return menu_->insert(index,name,shortcut,NULL,p,flags);+  }+} int C_to_Fl_Callback::menu_add(Fl_Menu_Item* item, char* name, int shortcut, int flags){   if (this->callback) {     return item->add(name, shortcut, intercept, this, flags);@@ -113,6 +131,24 @@   } } int C_to_Fl_Callback::menu_add(Fl_Menu_* menu_, char* name, int shortcut, int flags){+  if (this->callback) {+    return menu_->add(name,shortcut,intercept,this,flags);+  }+  else {+    void* p = 0;+    return menu_->add(name,shortcut,NULL,p,flags);+  }+}+int C_to_Fl_Callback::menu_add(Fl_Sys_Menu_Bar* menu_, char* name, char* shortcut, int flags){+  if (this->callback) {+    return menu_->add(name,shortcut,intercept,this,flags);+  }+  else {+    void* p = 0;+    return menu_->add(name,shortcut,NULL,p,flags);+  }+}+int C_to_Fl_Callback::menu_add(Fl_Sys_Menu_Bar* menu_, char* name, int shortcut, int flags){   if (this->callback) {     return menu_->add(name,shortcut,intercept,this,flags);   }

@@ -10,6 +10,7 @@ #include <FL/Fl_Widget.H> #include <FL/Fl_Menu_Item.H> #include <FL/Fl_Menu_.H>+#include <FL/Fl_Sys_Menu_Bar.H> #include <FL/Fl_Text_Buffer.H> #include <FL/Fl_Text_Editor.H> #include <FL/Fl_File_Chooser.H>@@ -62,10 +63,14 @@   int menu_insert(Fl_Menu_Item* item, int index, char* name, int shortcut, int flags = 0);   int menu_insert(Fl_Menu_* menu_, int index, char* name, int shortcut, int flags = 0);   int menu_insert(Fl_Menu_* menu_, int index, char* name, char* shortcut, int flags = 0);+  int menu_insert(Fl_Sys_Menu_Bar* menu_, int index, char* name, int shortcut, int flags = 0);+  int menu_insert(Fl_Sys_Menu_Bar* menu_, int index, char* name, char* shortcut, int flags = 0);   int menu_add(Fl_Menu_Item* item, char* name, int shortcut, int flags = 0);   int menu_add(Fl_Menu_Item* item, char* name, char* shortcut, int flags = 0);   int menu_add(Fl_Menu_* menu,char* name, char* shortcut, int flags = 0);   int menu_add(Fl_Menu_* menu,char* name, int shortcut, int flags = 0);+  int menu_add(Fl_Sys_Menu_Bar* menu,char* name, char* shortcut, int flags = 0);+  int menu_add(Fl_Sys_Menu_Bar* menu,char* name, int shortcut, int flags = 0); }; #endif #endif /* __FL_CALLBACK_C__ */

@@ -0,0 +1,22 @@+#include "Fl_Menu_BarC.h"+#include "UtilsC.h"+#ifdef __cplusplus+EXPORT {+#endif+  FL_EXPORT_C(int,Fl_Menu_Bar_handle )(fl_Menu_Bar menu_bar, int event){+    return (static_cast<Fl_Menu_Bar*>(menu_bar))->handle(event);+  }+  FL_EXPORT_C(fl_Menu_Bar, Fl_Menu_Bar_New_WithLabel)(int x, int y, int w, int h, const char* label) {+    Fl_Menu_Bar* menu_bar = new Fl_Menu_Bar(x,y,w,h,label);+    return (static_cast<fl_Menu_Bar>(menu_bar));+  }+  FL_EXPORT_C(fl_Menu_Bar, Fl_Menu_Bar_New)(int x, int y, int w, int h) {+    Fl_Menu_Bar* menu_bar = new Fl_Menu_Bar(x,y,w,h,0);+    return (fl_Menu_Bar)menu_bar;+  }+  FL_EXPORT_C(void   , Fl_Menu_Bar_Destroy)(fl_Menu_Bar menu_bar){+    delete (static_cast<Fl_Menu_Bar*>(menu_bar));+  }+#ifdef __cplusplus+}+#endif

@@ -0,0 +1,19 @@+#ifndef __FL_MENU_BAR_C__+#define __FL_MENU_BAR_C__+#ifdef __cplusplus+// always include the FL/*.H headers before local headers+// Fl_Widget is included transitively and needed for+// the callback mechanism included below to work.+#include "FL/Fl.H"+#include "FL/Fl_Menu_Bar.H"+#include "Fl_CallbackC.h"+EXPORT {+#endif+  FL_EXPORT_C(int,          Fl_Menu_Bar_handle)(fl_Group self, int event);+  FL_EXPORT_C(fl_Menu_Bar,   Fl_Menu_Bar_New_WithLabel)(int x, int y, int w, int h, const char* label);+  FL_EXPORT_C(fl_Menu_Bar   , Fl_Menu_Bar_New)(int x, int y, int w, int h);+  FL_EXPORT_C(void   , Fl_Menu_Bar_Destroy)(fl_Menu_Bar menu_bar);+#ifdef __cplusplus+}+#endif+#endif /* __FL_MENU_BAR_C__ */

@@ -321,6 +321,10 @@     C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb);     return callback_interceptor->menu_insert((static_cast<Fl_Sys_Menu_Bar*>(sys_menu_bar)),index,name,shortcut, flags);   }+  FL_EXPORT_C(int,Fl_Sys_Menu_Bar_insert_with_shortcutname_flags)(fl_Sys_Menu_Bar menu_,int index,char* name,char* shortcut,fl_Callback* cb,int flags){+    C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb);+    return callback_interceptor->menu_insert((static_cast<Fl_Sys_Menu_Bar*>(menu_)),index, name,shortcut,flags);+  }   FL_EXPORT_C(int,Fl_Sys_Menu_Bar_insert_with_user_data_flags)(fl_Sys_Menu_Bar sys_menu_bar,int index,char* name,int shortcut,fl_Callback* cb,void* user_data,int flags){     C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb, user_data);     return callback_interceptor->menu_insert((static_cast<Fl_Sys_Menu_Bar*>(sys_menu_bar)),index,name,shortcut,flags);@@ -332,6 +336,9 @@   FL_EXPORT_C(int,Fl_Sys_Menu_Bar_add_with_user_data)(fl_Sys_Menu_Bar sys_menu_bar,char* name,int shortcut,fl_Callback* cb,void* user_data){     C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb, user_data);     return callback_interceptor->menu_add((static_cast<Fl_Sys_Menu_Bar*>(sys_menu_bar)),name,shortcut,0);+  }+  FL_EXPORT_C(int, Fl_Sys_Menu_Bar_add_with_name)(fl_Sys_Menu_Bar menu_,  char* name){+    return (static_cast<Fl_Sys_Menu_Bar*>(menu_))->add(name);   }   FL_EXPORT_C(int,Fl_Sys_Menu_Bar_add_with_flags)(fl_Sys_Menu_Bar sys_menu_bar,char* name,int shortcut,fl_Callback* cb,int flags){     C_to_Fl_Callback* callback_interceptor = new C_to_Fl_Callback(cb);

@@ -7,7 +7,6 @@ #include "FL/Fl.H" #include "FL/Fl_Sys_Menu_Bar.H" #include "Fl_CallbackC.h"-#include "Fl_Menu_C.h" EXPORT { #endif   /* Inherited from Fl_Widget */

@@ -456,6 +456,7 @@   typedef void* fl_Single_Window;   typedef void* fl_Slider;   typedef void* fl_Spinner;+  typedef void* fl_Menu_Bar;   typedef void* fl_Sys_Menu_Bar;   typedef void* fl_Table;   typedef void* fl_Table_Row;

@@ -86,6 +86,7 @@ 	fl_show_colormapC.cpp \ 	Fl_Single_WindowC.cpp \ 	Fl_SliderC.cpp \+	Fl_Menu_BarC.cpp \ 	Fl_Sys_Menu_BarC.cpp \ 	Fl_TableC.cpp \ 	Fl_Table_RowC.cpp \

@@ -1,5 +1,5 @@ name : fltkhs-version : 0.4.0.5+version : 0.4.0.6 synopsis : FLTK bindings description:     Low level bindings for the FLTK GUI toolkit. For installation and quick start instruction please scroll all the way down to the README.@@ -55,6 +55,7 @@                    Graphics.UI.FLTK.LowLevel.Browser                    Graphics.UI.FLTK.LowLevel.SelectBrowser                    Graphics.UI.FLTK.LowLevel.SysMenuBar+                   Graphics.UI.FLTK.LowLevel.MenuBar                    Graphics.UI.FLTK.LowLevel.Choice                    Graphics.UI.FLTK.LowLevel.MenuButton                    Graphics.UI.FLTK.LowLevel.Image

@@ -39,7 +39,7 @@   DigitalClock = FL_DIGITAL_CLOCK }; #endc-{# enum ClockType {} #}+{# enum ClockType {} deriving (Show) #} newtype Hour = Hour Int newtype Minute = Minute Int newtype Second = Second Int@@ -89,6 +89,14 @@ {#fun Fl_Clock_handle as menu_Handle' { id `Ptr ()', id `CInt' } -> `Int' #} instance (impl ~ (Event -> IO Int)) => Op (Handle ()) Clock orig impl where   runOp _ _ menu_ event = withRef menu_ (\p -> menu_Handle' p (fromIntegral . fromEnum $ event))++{# fun Fl_Clock_set_type as setType' { id `Ptr ()',`Word8' } -> `()' #}+instance (impl ~ (ClockType ->  IO ())) => Op (SetType ()) Clock orig impl where+  runOp _ _ clock type'' = withRef clock $ \clockPtr -> setType' clockPtr (fromIntegral (fromEnum type''))++{# fun Fl_Clock_type as type' { id `Ptr ()' } -> `Word8' #}+instance (impl ~ ( IO (ClockType))) => Op (GetType_ ()) Clock orig impl where+   runOp _ _ clock = withRef clock $ \clockPtr -> type' clockPtr >>= return . toEnum . fromIntegral  -- $Clockfunctions --

@@ -104,6 +104,7 @@          module Graphics.UI.FLTK.LowLevel.SingleWindow,          module Graphics.UI.FLTK.LowLevel.Slider,          module Graphics.UI.FLTK.LowLevel.Spinner,+         module Graphics.UI.FLTK.LowLevel.MenuBar,          module Graphics.UI.FLTK.LowLevel.SysMenuBar,          module Graphics.UI.FLTK.LowLevel.Tabs,          module Graphics.UI.FLTK.LowLevel.Table,@@ -174,6 +175,7 @@ import Graphics.UI.FLTK.LowLevel.NiceSlider import Graphics.UI.FLTK.LowLevel.MenuItem import Graphics.UI.FLTK.LowLevel.MenuPrim+import Graphics.UI.FLTK.LowLevel.MenuBar import Graphics.UI.FLTK.LowLevel.SysMenuBar import Graphics.UI.FLTK.LowLevel.Choice import Graphics.UI.FLTK.LowLevel.MenuButton

@@ -529,6 +529,8 @@          setTextcolor,          DownBox,          downBox,+         -- * MenuBar+         MenuBar,          -- * SysMenuBar          SysMenuBar,          -- * Choice,@@ -2290,8 +2292,17 @@ MAKE_METHOD(SetTextcolor,setTextcolor) MAKE_METHOD(DownBox,downBox) +data CMenuBar parent+type MenuBar = CMenuBar MenuPrim+type MenuBarFuncs =+  (Destroy+  (Handle+  ()))+type instance Functions MenuBar = MenuBarFuncs++ data CSysMenuBar parent-type SysMenuBar = CSysMenuBar MenuPrim+type SysMenuBar = CSysMenuBar MenuBar type SysMenuBarFuncs =   (Destroy   (SetMenu@@ -2305,7 +2316,10 @@   (GetMode   (SetShortcut   (Handle-  ()))))))))))))+  (Add+  (AddName+  (Insert+  ())))))))))))))))  type instance Functions SysMenuBar = SysMenuBarFuncs @@ -3094,7 +3108,9 @@   (GetValue   (GetValueSinceEpoch   (SetValue-  ()))))+  (SetType+  (GetType_+  ()))))))   type instance Functions Clock = ClockFuncs

@@ -0,0 +1,72 @@+{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Graphics.UI.FLTK.LowLevel.MenuBar+    (+     menuBarNew,+     -- * Hierarchy+     --+     -- $hierarchy++     -- * Functions+     --+     -- $functions+    )+where+#include "Fl_ExportMacros.h"+#include "Fl_Types.h"+#include "Fl_Menu_BarC.h"+import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum)+import Foreign.C.Types+import Graphics.UI.FLTK.LowLevel.Widget+import Graphics.UI.FLTK.LowLevel.Fl_Enumerations+import Graphics.UI.FLTK.LowLevel.Fl_Types+import Graphics.UI.FLTK.LowLevel.Utils+import Graphics.UI.FLTK.LowLevel.Dispatch+import Graphics.UI.FLTK.LowLevel.Hierarchy+import Graphics.UI.FLTK.LowLevel.MenuItem+import qualified Data.ByteString.Char8 as C++{# fun Fl_Menu_Bar_New as widgetNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #}+{# fun Fl_Menu_Bar_New_WithLabel as widgetNewWithLabel' { `Int',`Int',`Int',`Int',unsafeToCString `String'} -> `Ptr ()' id #}+menuBarNew :: Rectangle -> Maybe String -> IO (Ref MenuBar)+menuBarNew rectangle l' =+    let (x_pos, y_pos, width, height) = fromRectangle rectangle+    in case l' of+        Nothing -> widgetNew' x_pos y_pos width height >>=+                             toRef+        Just l -> widgetNewWithLabel' x_pos y_pos width height l >>=+                             toRef++{# fun Fl_Menu_Bar_Destroy as widgetDestroy' { id `Ptr ()' } -> `()' supressWarningAboutRes #}+instance (impl ~ (IO ())) => Op (Destroy ()) MenuBar orig impl where+  runOp _ _ menuBar = swapRef menuBar $+                          \menuBarPtr ->+                             widgetDestroy' menuBarPtr >>+                             return nullPtr+{#fun Fl_Menu_Bar_handle as menuBarHandle' { id `Ptr ()', id `CInt' } -> `Int' #}+instance (impl ~ (Event -> IO Int)) => Op (Handle ()) MenuBar orig impl where+  runOp _ _ menuBar event = withRef menuBar (\p -> menuBarHandle' p (fromIntegral . fromEnum $ event))+++-- $functions+--+-- @+--+-- destroy :: 'Ref' 'MenuBar' -> 'IO' ()+--+-- handle :: 'Ref' 'MenuBar' -> 'Event' -> 'IO' 'Int'+--+-- @++-- $hierarchy+--+-- @+-- "Graphics.UI.FLTK.LowLevel.Widget"+--  |+--  v+-- "Graphics.UI.FLTK.LowLevel.MenuPrim"+--  |+--  v+-- "Graphics.UI.FLTK.LowLevel.MenuBar"+--+-- @

@@ -3,6 +3,7 @@ module Graphics.UI.FLTK.LowLevel.MenuItem   (    menuItemNew,+   addMenuItem,    MenuItemIndex(..),    MenuItemName(..),    MenuItemPointer(..),@@ -235,40 +236,59 @@ instance (impl ~ (Ref Widget  ->  IO ())) => Op (DoCallback ()) MenuItem orig impl where   runOp _ _ menu_item o = withRef menu_item $ \menu_itemPtr -> withRef o $ \oPtr -> doCallback' menu_itemPtr oPtr +addMenuItem ::+  (Parent menuItem MenuItem) =>+  Either (Ref MenuPrim) (Ref MenuItem) ->+  String ->+  Maybe Shortcut ->+  Maybe (Ref menuItem -> IO ()) ->+  MenuItemFlags ->+  (Ptr () -> String -> CInt -> FunPtr CallbackWithUserDataPrim -> Int -> IO Int) ->+  (Ptr () -> String -> String -> FunPtr CallbackWithUserDataPrim -> Int -> IO Int) ->+  IO (MenuItemIndex)+addMenuItem refMenuOrMenuItem name shortcut cb flags addWithFlags addWithShortcutnameFlags =+     either+       (\menu -> withRef menu (go "Menu_.add: Shortcut format string cannot be empty" ))+       (\menuItem -> withRef menuItem (go "MenuItem.add: Shortcut format string cannot be empty"))+       refMenuOrMenuItem+    where+      go :: String -> Ptr () -> IO MenuItemIndex+      go errorMsg menu_Ptr = do+        let combinedFlags = menuItemFlagsToInt flags+        ptr <- maybe (return (castPtrToFunPtr nullPtr)) toCallbackPrim cb+        idx' <- case shortcut of+                 Just s' -> case s' of+                   KeySequence (ShortcutKeySequence modifiers char) ->+                     addWithFlags+                      menu_Ptr+                      name+                      (keySequenceToCInt modifiers char)+                      (castFunPtr ptr)+                      combinedFlags+                   KeyFormat format' ->+                     if (not $ null format') then+                       addWithShortcutnameFlags+                       menu_Ptr+                       name+                       format'+                       (castFunPtr ptr)+                       combinedFlags+                     else error errorMsg+                 Nothing ->+                     addWithFlags+                      menu_Ptr+                      name+                      0+                      (castFunPtr ptr)+                      combinedFlags+        return (MenuItemIndex idx')+ {# fun Fl_Menu_Item_insert_with_flags as insertWithFlags' { id `Ptr ()',`Int', unsafeToCString `String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} {# fun Fl_Menu_Item_add_with_flags as addWithFlags' { id `Ptr ()', unsafeToCString `String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} {# fun Fl_Menu_Item_add_with_shortcutname_flags as addWithShortcutnameFlags' { id `Ptr ()', unsafeToCString `String', unsafeToCString `String',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} instance (Parent a MenuItem, impl ~ (String -> Maybe Shortcut -> Maybe (Ref a -> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Add ()) MenuItem orig impl where   runOp _ _ menu_item name shortcut cb flags =-    withRef menu_item $ \menu_itemPtr -> do-      let combinedFlags = menuItemFlagsToInt flags-      ptr <- maybe (return nullFunPtr) toCallbackPrim cb-      idx' <- case shortcut of-               Just s' -> case s' of-                 KeySequence (ShortcutKeySequence modifiers char) ->-                   addWithFlags'-                     menu_itemPtr-                     name-                     (keySequenceToCInt modifiers char)-                     (castFunPtr ptr)-                     combinedFlags-                 KeyFormat format' ->-                   if (not $ null format') then-                     addWithShortcutnameFlags'-                       menu_itemPtr-                       name-                       format'-                       (castFunPtr ptr)-                       combinedFlags-                   else error "menuItemAdd: shortcut format string cannot be empty"-               Nothing ->-                  addWithFlags'-                    menu_itemPtr-                    name-                    0-                    (castFunPtr ptr)-                    combinedFlags-      return (MenuItemIndex idx')+    addMenuItem (Right menu_item) name shortcut cb flags addWithFlags' addWithShortcutnameFlags'  instance (Parent a MenuItem, impl ~ (Int -> String -> Maybe ShortcutKeySequence -> (Ref a -> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Insert ()) MenuItem orig impl where   runOp _ _ menu_item index' name ks cb flags =

@@ -3,7 +3,8 @@ module Graphics.UI.FLTK.LowLevel.MenuPrim     (      menu_New,-     menu_Custom+     menu_Custom,+     insertMenuItem      -- * Hierarchy      --      -- $hierarchy@@ -157,42 +158,56 @@ instance (Parent a MenuItem, impl ~ (Ref a->  IO ())) => Op (Copy ()) MenuPrim orig impl where   runOp _ _ menu_ m = withRef menu_ $ \menu_Ptr -> withRef m $ \mPtr -> copy' menu_Ptr mPtr +insertMenuItem ::+  (Parent a MenuPrim) =>+  Ref MenuPrim ->+  Int ->+  String ->+  Maybe Shortcut ->+  (Ref a -> IO ()) ->+  MenuItemFlags ->+  (Ptr () -> Int -> String -> CInt -> FunPtr CallbackWithUserDataPrim -> Int -> IO Int) ->+  (Ptr () -> Int -> String  -> String -> FunPtr CallbackWithUserDataPrim -> Int -> IO Int) ->+  IO (MenuItemIndex)+insertMenuItem menu_ index' name shortcut cb flags insertWithFlags'' insertWithShortcutnameFlags'' =+  withRef menu_ $ \menu_Ptr -> do+    let combinedFlags = menuItemFlagsToInt flags+    ptr <- toCallbackPrim cb+    idx' <- case shortcut of+             Just s' -> case s' of+               KeySequence (ShortcutKeySequence modifiers char) ->+                 insertWithFlags''+                  menu_Ptr+                  index'+                  name+                  (keySequenceToCInt modifiers char)+                  (castFunPtr ptr)+                  combinedFlags+               KeyFormat format' ->+                 if (not $ null format') then+                   insertWithShortcutnameFlags''+                     menu_Ptr+                     index'+                     name+                     format'+                     (castFunPtr ptr)+                     combinedFlags+                 else error "Fl_Menu_.menu_insert: shortcut format string cannot be empty"+             Nothing ->+               insertWithFlags''+                 menu_Ptr+                 index'+                 name+                 0+                 (castFunPtr ptr)+                 combinedFlags+    return (MenuItemIndex idx')+ {# fun Fl_Menu__insert_with_flags as insertWithFlags' { id `Ptr ()',`Int',unsafeToCString `String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #} {# fun Fl_Menu__insert_with_shortcutname_flags as insertWithShortcutnameFlags' { id `Ptr ()',`Int',unsafeToCString `String', unsafeToCString `String',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} instance (Parent a MenuPrim, impl ~ ( Int -> String -> Maybe Shortcut -> (Ref a -> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Insert ()) MenuPrim orig impl where-  runOp _ _ menu_ index' name shortcut cb flags =-    withRef menu_ $ \menu_Ptr -> do-      let combinedFlags = menuItemFlagsToInt flags-      ptr <- toCallbackPrim cb-      idx' <- case shortcut of-               Just s' -> case s' of-                 KeySequence (ShortcutKeySequence modifiers char) ->-                   insertWithFlags'-                    menu_Ptr-                    index'-                    name-                    (keySequenceToCInt modifiers char)-                    (castFunPtr ptr)-                    combinedFlags-                 KeyFormat format' ->-                   if (not $ null format') then-                     insertWithShortcutnameFlags'-                       menu_Ptr-                       index'-                       name-                       format'-                       (castFunPtr ptr)-                       combinedFlags-                   else error "Fl_Menu_.menu_insert: shortcut format string cannot be empty"-               Nothing ->-                 insertWithFlags'-                   menu_Ptr-                   index'-                   name-                   0-                   (castFunPtr ptr)-                   combinedFlags-      return (MenuItemIndex idx')+  runOp _ _ menu_ index' name shortcut cb flags = insertMenuItem menu_ index' name shortcut cb flags insertWithFlags' insertWithShortcutnameFlags'+ {# fun Fl_Menu__add_with_name as add' { id `Ptr ()',unsafeToCString `String'} -> `()' #} instance (impl ~ (String -> IO ())) => Op (AddName ()) MenuPrim orig impl where   runOp _ _ menu_ name' = withRef menu_ $ \menu_Ptr -> add' menu_Ptr name'@@ -200,35 +215,8 @@ {# fun Fl_Menu__add_with_shortcutname_flags as addWithShortcutnameFlags' { id `Ptr ()', unsafeToCString `String', unsafeToCString `String',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #} instance (Parent a MenuItem, impl ~ ( String -> Maybe Shortcut -> Maybe (Ref a-> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Add ()) MenuPrim orig (impl) where   runOp _ _ menu_ name shortcut cb flags =-    withRef menu_ $ \menu_Ptr -> do-      let combinedFlags = menuItemFlagsToInt flags-      ptr <- maybe (return (castPtrToFunPtr nullPtr)) toCallbackPrim cb-      idx' <- case shortcut of-               Just s' -> case s' of-                 KeySequence (ShortcutKeySequence modifiers char) ->-                   addWithFlags'-                    menu_Ptr-                    name-                    (keySequenceToCInt modifiers char)-                    (castFunPtr ptr)-                    combinedFlags-                 KeyFormat format' ->-                   if (not $ null format') then-                     addWithShortcutnameFlags'-                     menu_Ptr-                     name-                     format'-                     (castFunPtr ptr)-                     combinedFlags-                   else error "Fl_Menu_.menu_add: Shortcut format string cannot be empty"-               Nothing ->-                   addWithFlags'-                    menu_Ptr-                    name-                    0-                    (castFunPtr ptr)-                    combinedFlags-      return (MenuItemIndex idx')+    addMenuItem (Left menu_) name shortcut cb flags addWithFlags' addWithShortcutnameFlags'+ {# fun Fl_Menu__size as size' { id `Ptr ()' } -> `Int' #} instance (impl ~ ( IO (Int))) => Op (GetSize ()) MenuPrim orig impl where   runOp _ _ menu_ = withRef menu_ $ \menu_Ptr -> size' menu_Ptr

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, EmptyDataDecls, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}+{-# LANGUAGE CPP, EmptyDataDecls, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Graphics.UI.FLTK.LowLevel.SysMenuBar     (@@ -23,6 +23,8 @@ import Graphics.UI.FLTK.LowLevel.Utils import Graphics.UI.FLTK.LowLevel.Dispatch import Graphics.UI.FLTK.LowLevel.Hierarchy+import Graphics.UI.FLTK.LowLevel.MenuItem+import Graphics.UI.FLTK.LowLevel.MenuPrim  {# fun Fl_Sys_Menu_Bar_New as sysMenuBarNew' { `Int',`Int',`Int',`Int' } -> `Ptr ()' id #} {# fun Fl_Sys_Menu_Bar_New_WithLabel as sysMenuBarNewWithLabel' { `Int',`Int',`Int',`Int', unsafeToCString `String'} -> `Ptr ()' id #}@@ -75,9 +77,28 @@         withRefs items $ \menu_itemsPtr ->             menuWithM' menu_Ptr menu_itemsPtr (length items) +{# fun Fl_Sys_Menu_Bar_add_with_name as add' { id `Ptr ()',unsafeToCString `String'} -> `()' #}+instance (impl ~ (String -> IO ())) => Op (AddName ()) SysMenuBar orig impl where+  runOp _ _ menu_ name' = withRef menu_ $ \menu_Ptr -> add' menu_Ptr name'++{# fun Fl_Sys_Menu_Bar_add_with_flags as addWithFlags' { id `Ptr ()',unsafeToCString `String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #}+{# fun Fl_Sys_Menu_Bar_add_with_shortcutname_flags as addWithShortcutnameFlags' { id `Ptr ()', unsafeToCString `String', unsafeToCString `String',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #}+instance (Parent a MenuItem, impl ~ ( String -> Maybe Shortcut -> Maybe (Ref a-> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Add ()) SysMenuBar orig (impl) where+  runOp _ _ menu_ name shortcut cb flags =+    addMenuItem (Left (safeCast menu_)) name shortcut cb flags addWithFlags' addWithShortcutnameFlags'++{# fun Fl_Sys_Menu_Bar_insert_with_flags as insertWithFlags' { id `Ptr ()',`Int',unsafeToCString `String',id `CInt',id `FunPtr CallbackWithUserDataPrim',`Int'} -> `Int' #}+{# fun Fl_Sys_Menu_Bar_insert_with_shortcutname_flags as insertWithShortcutnameFlags' { id `Ptr ()',`Int',unsafeToCString `String', unsafeToCString `String',id `FunPtr CallbackWithUserDataPrim',`Int' } -> `Int' #}+instance (Parent a MenuPrim, impl ~ ( Int -> String -> Maybe Shortcut -> (Ref a -> IO ()) -> MenuItemFlags -> IO (MenuItemIndex))) => Op (Insert ()) SysMenuBar orig impl where+  runOp _ _ menu_ index' name shortcut cb flags = insertMenuItem (safeCast menu_) index' name shortcut cb flags insertWithFlags' insertWithShortcutnameFlags'+ -- $functions -- @ --+-- add:: ('Parent' a 'MenuItem') => 'Ref' 'SysMenuBar' -> 'String' -> 'Maybe' 'Shortcut' -> 'Maybe' ('Ref' a-> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('MenuItemIndex')+--+-- addName :: 'Ref' 'SysMenuBar' -> 'String' -> 'IO' ()+-- -- clear :: 'Ref' 'SysMenuBar' -> 'IO' () -- -- clearSubmenu :: 'Ref' 'SysMenuBar' -> 'Int' -> 'IO' ('Int')@@ -90,6 +111,8 @@ -- -- handle :: 'Ref' 'SysMenuBar' -> 'Event' -> 'IO' 'Int' --+-- insert:: ('Parent' a 'MenuPrim') => 'Ref' 'SysMenuBar' -> 'Int' -> 'String' -> 'Maybe' 'Shortcut' -> ('Ref' a -> 'IO' ()) -> 'MenuItemFlags' -> 'IO' ('MenuItemIndex')+-- -- remove :: 'Ref' 'SysMenuBar' -> 'Int' -> 'IO' () -- -- replace :: 'Ref' 'SysMenuBar' -> 'Int' -> 'String' -> 'IO' ()@@ -99,7 +122,8 @@ -- setMode :: 'Ref' 'SysMenuBar' -> 'Int' -> 'Int' -> 'IO' () -- -- setShortcut :: 'Ref' 'SysMenuBar' -> 'Int' -> 'ShortcutKeySequence' -> 'IO' ()-+--+-- @  -- $hierarchy -- @@@ -109,5 +133,9 @@ -- "Graphics.UI.FLTK.LowLevel.MenuPrim" --  | --  v+-- "Graphics.UI.FLTK.LowLevel.MenuBar"+--  |+--  v -- "Graphics.UI.FLTK.LowLevel.SysMenuBar"+-- -- @