diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_fl_group.cpp | 13 | ||||
| -rw-r--r-- | src/c_fl_group.h | 4 | ||||
| -rw-r--r-- | src/c_fl_help_view.cpp | 12 | ||||
| -rw-r--r-- | src/c_fl_text_editor.cpp | 24 | ||||
| -rw-r--r-- | src/c_fl_text_editor.h | 4 | ||||
| -rw-r--r-- | src/c_fl_tooltip.cpp | 34 | ||||
| -rw-r--r-- | src/c_fl_tooltip.h | 10 | ||||
| -rw-r--r-- | src/fltk-tooltips.adb | 75 | ||||
| -rw-r--r-- | src/fltk-tooltips.ads | 27 | ||||
| -rw-r--r-- | src/fltk-widgets-groups-text_displays-text_editors.adb | 46 | ||||
| -rw-r--r-- | src/fltk-widgets-groups-text_displays-text_editors.ads | 14 | ||||
| -rw-r--r-- | src/fltk-widgets-groups.adb | 46 | ||||
| -rw-r--r-- | src/fltk-widgets-groups.ads | 14 |
13 files changed, 186 insertions, 137 deletions
diff --git a/src/c_fl_group.cpp b/src/c_fl_group.cpp index 71ae7df..890fd9a 100644 --- a/src/c_fl_group.cpp +++ b/src/c_fl_group.cpp @@ -103,14 +103,13 @@ int fl_group_children(GROUP g) { -//unsigned int flt_group_get_clip_children(GROUP g) { -// return reinterpret_cast<Fl_Group*>(g)->clip_children(); -//} - +unsigned int fl_group_get_clip_children(GROUP g) { + return reinterpret_cast<Fl_Group*>(g)->clip_children(); +} -//void fl_group_set_clip_children(GROUP g, int c) { -// reinterpret_cast<Fl_Group*>(g)->clip_children(c); -//} +void fl_group_set_clip_children(GROUP g, int c) { + reinterpret_cast<Fl_Group*>(g)->clip_children(c); +} diff --git a/src/c_fl_group.h b/src/c_fl_group.h index 5eaa333..57f5e4c 100644 --- a/src/c_fl_group.h +++ b/src/c_fl_group.h @@ -32,8 +32,8 @@ extern "C" int fl_group_find(GROUP g, WIDGET item); extern "C" int fl_group_children(GROUP g); -//extern "C" unsigned int fl_group_get_clip_children(GROUP g); -//extern "C" void fl_group_set_clip_children(GROUP g, int c); +extern "C" unsigned int fl_group_get_clip_children(GROUP g); +extern "C" void fl_group_set_clip_children(GROUP g, int c); extern "C" void * fl_group_get_resizable(GROUP g); diff --git a/src/c_fl_help_view.cpp b/src/c_fl_help_view.cpp index 50d5d58..6275052 100644 --- a/src/c_fl_help_view.cpp +++ b/src/c_fl_help_view.cpp @@ -175,19 +175,19 @@ void fl_help_view_set_textsize(HELPVIEW v, int s) { void fl_help_view_draw(HELPVIEW v) { - #if FL_ABI_VERSION >= 10303 +#if FL_ABI_VERSION >= 10303 reinterpret_cast<My_Help_View*>(v)->Fl_Help_View::draw(); - #else +#else reinterpret_cast<My_Help_View*>(v)->Fl_Group::draw(); - #endif +#endif } int fl_help_view_handle(HELPVIEW v, int e) { - #if FL_ABI_VERSION >= 10303 +#if FL_ABI_VERSION >= 10303 return reinterpret_cast<My_Help_View*>(v)->Fl_Help_View::handle(e); - #else +#else return reinterpret_cast<My_Help_View*>(v)->Fl_Group::handle(e); - #endif +#endif } diff --git a/src/c_fl_text_editor.cpp b/src/c_fl_text_editor.cpp index 8c33afa..b7e3f3e 100644 --- a/src/c_fl_text_editor.cpp +++ b/src/c_fl_text_editor.cpp @@ -279,13 +279,23 @@ void fl_text_editor_set_insert_mode(TEXTEDITOR te, int i) { -//int fl_text_editor_get_tab_nav(TEXTEDITOR te) { -// return reinterpret_cast<Fl_Text_Editor*>(te)->tab_nav(); -//} - -//void fl_text_editor_set_tab_nav(TEXTEDITOR te, int t) { -// reinterpret_cast<Fl_Text_Editor*>(te)->tab_nav(t); -//} +int fl_text_editor_get_tab_nav(TEXTEDITOR te) { +#if FLTK_ABI_VERSION >= 10304 + return reinterpret_cast<Fl_Text_Editor*>(te)->tab_nav(); +#else + (void)(te); + return 0; +#endif +} + +void fl_text_editor_set_tab_nav(TEXTEDITOR te, int t) { +#if FLTK_ABI_VERSION >= 10304 + reinterpret_cast<Fl_Text_Editor*>(te)->tab_nav(t); +#else + (void)(te); + (void)(t); +#endif +} diff --git a/src/c_fl_text_editor.h b/src/c_fl_text_editor.h index 305b04b..e25922f 100644 --- a/src/c_fl_text_editor.h +++ b/src/c_fl_text_editor.h @@ -82,8 +82,8 @@ extern "C" int fl_text_editor_get_insert_mode(TEXTEDITOR te); extern "C" void fl_text_editor_set_insert_mode(TEXTEDITOR te, int i); -//extern "C" int fl_text_editor_get_tab_nav(TEXTEDITOR te); -//extern "C" void fl_text_editor_set_tab_nav(TEXTEDITOR te, int t); +extern "C" int fl_text_editor_get_tab_nav(TEXTEDITOR te); +extern "C" void fl_text_editor_set_tab_nav(TEXTEDITOR te, int t); extern "C" void fl_text_editor_draw(TEXTEDITOR te); diff --git a/src/c_fl_tooltip.cpp b/src/c_fl_tooltip.cpp index 5a3ed6e..768b357 100644 --- a/src/c_fl_tooltip.cpp +++ b/src/c_fl_tooltip.cpp @@ -27,6 +27,10 @@ void fl_tooltip_enable(int v) { Fl_Tooltip::enable(v); } +void fl_tooltip_disable() { + Fl_Tooltip::disable(); +} + void fl_tooltip_enter_area(void * i, int x, int y, int w, int h, const char * t) { Fl_Tooltip::enter_area(reinterpret_cast<Fl_Widget*>(i),x,y,w,h,t); } @@ -65,25 +69,37 @@ int fl_tooltip_get_margin_height(void) { return Fl_Tooltip::margin_height(); } -//void fl_tooltip_set_margin_height(int v) { -// Fl_Tooltip::margin_height(v); -//} +void fl_tooltip_set_margin_height(int v) { +#if FLTK_ABI_VERSION >= 10301 + Fl_Tooltip::margin_height(v); +#else + (void)(v); +#endif +} int fl_tooltip_get_margin_width(void) { return Fl_Tooltip::margin_width(); } -//void fl_tooltip_set_margin_width(int v) { -// Fl_Tooltip::margin_width(v); -//} +void fl_tooltip_set_margin_width(int v) { +#if FLTK_ABI_VERSION >= 10301 + Fl_Tooltip::margin_width(v); +#else + (void)(v); +#endif +} int fl_tooltip_get_wrap_width(void) { return Fl_Tooltip::wrap_width(); } -//void fl_tooltip_set_wrap_width(int v) { -// Fl_Tooltip::wrap_width(v); -//} +void fl_tooltip_set_wrap_width(int v) { +#if FLTK_ABI_VERSION >= 10301 + Fl_Tooltip::wrap_width(v); +#else + (void)(v); +#endif +} diff --git a/src/c_fl_tooltip.h b/src/c_fl_tooltip.h index 407e361..055a11f 100644 --- a/src/c_fl_tooltip.h +++ b/src/c_fl_tooltip.h @@ -8,12 +8,11 @@ #define FL_TOOLTIP_GUARD - - extern "C" void * fl_tooltip_get_current(void); extern "C" void fl_tooltip_set_current(void * i); extern "C" int fl_tooltip_enabled(void); extern "C" void fl_tooltip_enable(int v); +extern "C" void fl_tooltip_disable(); extern "C" void fl_tooltip_enter_area(void * i, int x, int y, int w, int h, const char * t); @@ -26,11 +25,11 @@ extern "C" void fl_tooltip_set_hoverdelay(float v); extern "C" unsigned int fl_tooltip_get_color(void); extern "C" void fl_tooltip_set_color(unsigned int v); extern "C" int fl_tooltip_get_margin_height(void); -//extern "C" void fl_tooltip_set_margin_height(int v); +extern "C" void fl_tooltip_set_margin_height(int v); extern "C" int fl_tooltip_get_margin_width(void); -//extern "C" void fl_tooltip_set_margin_width(int v); +extern "C" void fl_tooltip_set_margin_width(int v); extern "C" int fl_tooltip_get_wrap_width(void); -//extern "C" void fl_tooltip_set_wrap_width(int v); +extern "C" void fl_tooltip_set_wrap_width(int v); extern "C" unsigned int fl_tooltip_get_textcolor(void); @@ -43,3 +42,4 @@ extern "C" void fl_tooltip_set_size(int v); #endif + diff --git a/src/fltk-tooltips.adb b/src/fltk-tooltips.adb index 3b488cc..84e4160 100644 --- a/src/fltk-tooltips.adb +++ b/src/fltk-tooltips.adb @@ -17,6 +17,10 @@ use type package body FLTK.Tooltips is + ------------------------ + -- Functions From C -- + ------------------------ + function fl_tooltip_get_current return Storage.Integer_Address; pragma Import (C, fl_tooltip_get_current, "fl_tooltip_get_current"); @@ -37,6 +41,10 @@ package body FLTK.Tooltips is pragma Import (C, fl_tooltip_enable, "fl_tooltip_enable"); pragma Inline (fl_tooltip_enable); + procedure fl_tooltip_disable; + pragma Import (C, fl_tooltip_disable, "fl_tooltip_disable"); + pragma Inline (fl_tooltip_disable); + procedure fl_tooltip_enter_area (I : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int; @@ -85,30 +93,30 @@ package body FLTK.Tooltips is pragma Import (C, fl_tooltip_get_margin_height, "fl_tooltip_get_margin_height"); pragma Inline (fl_tooltip_get_margin_height); - -- procedure fl_tooltip_set_margin_height - -- (V : in Interfaces.C.int); - -- pragma Import (C, fl_tooltip_set_margin_height, "fl_tooltip_set_margin_height"); - -- pragma Inline (fl_tooltip_set_margin_height); + procedure fl_tooltip_set_margin_height + (V : in Interfaces.C.int); + pragma Import (C, fl_tooltip_set_margin_height, "fl_tooltip_set_margin_height"); + pragma Inline (fl_tooltip_set_margin_height); function fl_tooltip_get_margin_width return Interfaces.C.int; pragma Import (C, fl_tooltip_get_margin_width, "fl_tooltip_get_margin_width"); pragma Inline (fl_tooltip_get_margin_width); - -- procedure fl_tooltip_set_margin_width - -- (V : in Interfaces.C.int); - -- pragma Import (C, fl_tooltip_set_margin_width, "fl_tooltip_set_margin_width"); - -- pragma Inline (fl_tooltip_set_margin_width); + procedure fl_tooltip_set_margin_width + (V : in Interfaces.C.int); + pragma Import (C, fl_tooltip_set_margin_width, "fl_tooltip_set_margin_width"); + pragma Inline (fl_tooltip_set_margin_width); function fl_tooltip_get_wrap_width return Interfaces.C.int; pragma Import (C, fl_tooltip_get_wrap_width, "fl_tooltip_get_wrap_width"); pragma Inline (fl_tooltip_get_wrap_width); - -- procedure fl_tooltip_set_wrap_width - -- (V : in Interfaces.C.int); - -- pragma Import (C, fl_tooltip_set_wrap_width, "fl_tooltip_set_wrap_width"); - -- pragma Inline (fl_tooltip_set_wrap_width); + procedure fl_tooltip_set_wrap_width + (V : in Interfaces.C.int); + pragma Import (C, fl_tooltip_set_wrap_width, "fl_tooltip_set_wrap_width"); + pragma Inline (fl_tooltip_set_wrap_width); @@ -158,6 +166,10 @@ package body FLTK.Tooltips is + ----------------------- + -- API Subprograms -- + ----------------------- + function Get_Target return access FLTK.Widgets.Widget'Class is @@ -187,12 +199,18 @@ package body FLTK.Tooltips is procedure Set_Enabled - (To : in Boolean) is + (To : in Boolean := True) is begin fl_tooltip_enable (Boolean'Pos (To)); end Set_Enabled; + procedure Disable is + begin + fl_tooltip_disable; + end Disable; + + procedure Enter_Area (Item : in FLTK.Widgets.Widget'Class; X, Y, W, H : in Integer; @@ -261,11 +279,11 @@ package body FLTK.Tooltips is end Get_Margin_Height; - -- procedure Set_Margin_Height - -- (To : in Natural) is - -- begin - -- fl_tooltip_set_margin_height (Interfaces.C.int (To)); - -- end Set_Margin_Height; + procedure Set_Margin_Height + (To : in Natural) is + begin + fl_tooltip_set_margin_height (Interfaces.C.int (To)); + end Set_Margin_Height; function Get_Margin_Width @@ -275,11 +293,11 @@ package body FLTK.Tooltips is end Get_Margin_Width; - -- procedure Set_Margin_Width - -- (To : in Natural) is - -- begin - -- fl_tooltip_set_margin_width (Interfaces.C.int (To)); - -- end Set_Margin_Width; + procedure Set_Margin_Width + (To : in Natural) is + begin + fl_tooltip_set_margin_width (Interfaces.C.int (To)); + end Set_Margin_Width; function Get_Wrap_Width @@ -289,11 +307,11 @@ package body FLTK.Tooltips is end Get_Wrap_Width; - -- procedure Set_Wrap_Width - -- (To : in Natural) is - -- begin - -- fl_tooltip_set_wrap_width (Interfaces.C.int (To)); - -- end Set_Wrap_Width; + procedure Set_Wrap_Width + (To : in Natural) is + begin + fl_tooltip_set_wrap_width (Interfaces.C.int (To)); + end Set_Wrap_Width; @@ -342,3 +360,4 @@ package body FLTK.Tooltips is end FLTK.Tooltips; + diff --git a/src/fltk-tooltips.ads b/src/fltk-tooltips.ads index 6b7642c..4162358 100644 --- a/src/fltk-tooltips.ads +++ b/src/fltk-tooltips.ads @@ -22,7 +22,9 @@ package FLTK.Tooltips is return Boolean; procedure Set_Enabled - (To : in Boolean); + (To : in Boolean := True); + + procedure Disable; procedure Enter_Area (Item : in FLTK.Widgets.Widget'Class; @@ -56,20 +58,20 @@ package FLTK.Tooltips is function Get_Margin_Height return Natural; - -- procedure Set_Margin_Height - -- (To : in Natural); + procedure Set_Margin_Height + (To : in Natural); function Get_Margin_Width return Natural; - -- procedure Set_Margin_Width - -- (To : in Natural); + procedure Set_Margin_Width + (To : in Natural); function Get_Wrap_Width return Natural; - -- procedure Set_Wrap_Width - -- (To : in Natural); + procedure Set_Wrap_Width + (To : in Natural); @@ -100,24 +102,22 @@ private pragma Inline (Set_Target); pragma Inline (Is_Enabled); pragma Inline (Set_Enabled); + pragma Inline (Disable); pragma Inline (Enter_Area); - pragma Inline (Get_Delay); pragma Inline (Set_Delay); pragma Inline (Get_Hover_Delay); pragma Inline (Set_Hover_Delay); - pragma Inline (Get_Background_Color); pragma Inline (Set_Background_Color); pragma Inline (Get_Margin_Height); - -- pragma Inline (Set_Margin_Height); + pragma Inline (Set_Margin_Height); pragma Inline (Get_Margin_Width); - -- pragma Inline (Set_Margin_Width); + pragma Inline (Set_Margin_Width); pragma Inline (Get_Wrap_Width); - -- pragma Inline (Set_Wrap_Width); - + pragma Inline (Set_Wrap_Width); pragma Inline (Get_Text_Color); pragma Inline (Set_Text_Color); @@ -129,3 +129,4 @@ private end FLTK.Tooltips; + diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb index 3cb60de..c3fea47 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.adb +++ b/src/fltk-widgets-groups-text_displays-text_editors.adb @@ -317,17 +317,17 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is - -- function fl_text_editor_get_tab_nav - -- (TE : in Storage.Integer_Address) - -- return Interfaces.C.int; - -- pragma Import (C, fl_text_editor_get_tab_nav, "fl_text_editor_get_tab_nav"); - -- pragma Inline (fl_text_editor_get_tab_nav); + function fl_text_editor_get_tab_nav + (TE : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_text_editor_get_tab_nav, "fl_text_editor_get_tab_nav"); + pragma Inline (fl_text_editor_get_tab_nav); - -- procedure fl_text_editor_set_tab_nav - -- (TE : in Storage.Integer_Address; - -- T : in Interfaces.C.int); - -- pragma Import (C, fl_text_editor_set_tab_nav, "fl_text_editor_set_tab_nav"); - -- pragma Inline (fl_text_editor_set_tab_nav); + procedure fl_text_editor_set_tab_nav + (TE : in Storage.Integer_Address; + T : in Interfaces.C.int); + pragma Import (C, fl_text_editor_set_tab_nav, "fl_text_editor_set_tab_nav"); + pragma Inline (fl_text_editor_set_tab_nav); @@ -983,20 +983,22 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is - -- function Get_Tab_Nav_Mode - -- (This : in Text_Editor) - -- return Tab_Navigation is - -- begin - -- return Tab_Navigation'Val (fl_text_editor_get_tab_nav (This.Void_Ptr)); - -- end Get_Tab_Nav_Mode; + function Get_Tab_Mode + (This : in Text_Editor) + return Tab_Navigation is + begin + return Tab_Navigation'Val (fl_text_editor_get_tab_nav (This.Void_Ptr)); + exception + when Constraint_Error => raise Internal_FLTK_Error; + end Get_Tab_Mode; - -- procedure Set_Tab_Nav_Mode - -- (This : in out Text_Editor; - -- To : in Tab_Navigation) is - -- begin - -- fl_text_editor_set_tab_nav (This.Void_Ptr, Tab_Navigation'Pos (To)); - -- end Set_Tab_Nav_Mode; + procedure Set_Tab_Mode + (This : in out Text_Editor; + To : in Tab_Navigation) is + begin + fl_text_editor_set_tab_nav (This.Void_Ptr, Tab_Navigation'Pos (To)); + end Set_Tab_Mode; diff --git a/src/fltk-widgets-groups-text_displays-text_editors.ads b/src/fltk-widgets-groups-text_displays-text_editors.ads index 6520d69..36c945d 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.ads +++ b/src/fltk-widgets-groups-text_displays-text_editors.ads @@ -20,7 +20,7 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is type Insert_Mode is (Before, After); - -- type Tab_Navigation is (Insert_Char, Widget_Focus); + type Tab_Navigation is (Insert_Char, Widget_Focus); type Key_Func is access procedure (This : in out Text_Editor'Class); @@ -309,13 +309,13 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is - -- function Get_Tab_Nav_Mode - -- (This : in Text_Editor) - -- return Tab_Navigation; + function Get_Tab_Mode + (This : in Text_Editor) + return Tab_Navigation; - -- procedure Set_Tab_Nav_Mode - -- (This : in out Text_Editor; - -- To : in Tab_Navigation); + procedure Set_Tab_Mode + (This : in out Text_Editor; + To : in Tab_Navigation); diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb index 491bd0d..4641dd1 100644 --- a/src/fltk-widgets-groups.adb +++ b/src/fltk-widgets-groups.adb @@ -95,17 +95,17 @@ package body FLTK.Widgets.Groups is - -- function fl_group_get_clip_children - -- (G : in Storage.Integer_Address) - -- return Interfaces.C.unsigned; - -- pragma Import (C, fl_group_get_clip_children, "fl_group_get_clip_children"); - -- pragma Inline (fl_group_get_clip_children); + function fl_group_get_clip_children + (G : in Storage.Integer_Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_group_get_clip_children, "fl_group_get_clip_children"); + pragma Inline (fl_group_get_clip_children); - -- procedure fl_group_set_clip_children - -- (G : in Storage.Integer_Address; - -- C : in Interfaces.C.unsigned); - -- pragma Import (C, fl_group_set_clip_children, "fl_group_set_clip_children"); - -- pragma Inline (fl_group_set_clip_children); + procedure fl_group_set_clip_children + (G : in Storage.Integer_Address; + C : in Interfaces.C.int); + pragma Import (C, fl_group_set_clip_children, "fl_group_set_clip_children"); + pragma Inline (fl_group_set_clip_children); @@ -413,20 +413,22 @@ package body FLTK.Widgets.Groups is - -- function Get_Clip_Mode - -- (This : in Group) - -- return Clip_Mode is - -- begin - -- return Clip_Mode'Val (fl_group_get_clip_children (This.Void_Ptr)); - -- end Get_Clip_Mode; + function Get_Clip_Mode + (This : in Group) + return Clip_Mode is + begin + return Clip_Mode'Val (fl_group_get_clip_children (This.Void_Ptr)); + exception + when Constraint_Error => raise Internal_FLTK_Error; + end Get_Clip_Mode; - -- procedure Set_Clip_Mode - -- (This : in out Group; - -- Mode : in Clip_Mode) is - -- begin - -- fl_group_set_clip_children (This.Void_Ptr, Clip_Mode'Pos (Mode)); - -- end Set_Clip_Mode; + procedure Set_Clip_Mode + (This : in out Group; + Mode : in Clip_Mode := Clip) is + begin + fl_group_set_clip_children (This.Void_Ptr, Clip_Mode'Pos (Mode)); + end Set_Clip_Mode; diff --git a/src/fltk-widgets-groups.ads b/src/fltk-widgets-groups.ads index f7b2173..9212085 100644 --- a/src/fltk-widgets-groups.ads +++ b/src/fltk-widgets-groups.ads @@ -28,7 +28,7 @@ package FLTK.Widgets.Groups is subtype Extended_Index is Natural; No_Index : constant Extended_Index := Extended_Index'First; - -- type Clip_Mode is (No_Clip, Clip); + type Clip_Mode is (No_Clip, Clip); type Cursor is private; @@ -116,13 +116,13 @@ package FLTK.Widgets.Groups is - -- function Get_Clip_Mode - -- (This : in Group) - -- return Clip_Mode; + function Get_Clip_Mode + (This : in Group) + return Clip_Mode; - -- procedure Set_Clip_Mode - -- (This : in out Group; - -- Mode : in Clip_Mode); + procedure Set_Clip_Mode + (This : in out Group; + Mode : in Clip_Mode := Clip); |