diff options
| -rw-r--r-- | doc/fl.html | 12 | ||||
| -rw-r--r-- | src/fltk-asks.adb | 10 | ||||
| -rw-r--r-- | src/fltk-draw.adb | 8 | ||||
| -rw-r--r-- | src/fltk-environment.adb | 2 | ||||
| -rw-r--r-- | src/fltk-text_buffers.adb | 18 | ||||
| -rw-r--r-- | src/fltk-widgets-groups-browsers.adb | 8 | ||||
| -rw-r--r-- | src/fltk-widgets-groups-help_views.adb | 2 | ||||
| -rw-r--r-- | src/fltk.ads | 5 |
8 files changed, 44 insertions, 21 deletions
diff --git a/doc/fl.html b/doc/fl.html index 09b1a3b..db60f5b 100644 --- a/doc/fl.html +++ b/doc/fl.html @@ -240,6 +240,18 @@ +<table class="type"> + <tr><th colspan="2">Errors</th></tr> + + <tr> + <td> </td> + <td>Internal_FLTK_Error</td> + </tr> + +</table> + + + <table class="function"> <tr><th colspan="2">Attributes</th></tr> diff --git a/src/fltk-asks.adb b/src/fltk-asks.adb index 2a70358..eba4dbb 100644 --- a/src/fltk-asks.adb +++ b/src/fltk-asks.adb @@ -396,7 +396,7 @@ package body FLTK.Asks is case Result is when -3 .. -1 => return Extended_Choice_Result'Val (Result + 6); when 0 .. 2 => return Extended_Choice_Result'Val (Result); - when others => raise Program_Error; + when others => raise Internal_FLTK_Error; end case; end Extended_Choice; @@ -415,7 +415,7 @@ package body FLTK.Asks is case Result is when -3 .. -1 => return Extended_Choice_Result'Val (Result + 6); when 0 .. 2 => return Extended_Choice_Result'Val (Result); - when others => raise Program_Error; + when others => raise Internal_FLTK_Error; end case; end Extended_Choice; @@ -435,7 +435,7 @@ package body FLTK.Asks is case Result is when -3 .. -1 => return Extended_Choice_Result'Val (Result + 6); when 0 .. 2 => return Extended_Choice_Result'Val (Result); - when others => raise Program_Error; + when others => raise Internal_FLTK_Error; end case; end Extended_Choice; @@ -507,7 +507,7 @@ package body FLTK.Asks is elsif Result = 0 then return Cancel; else - raise Program_Error; + raise Internal_FLTK_Error; end if; end Color_Chooser; @@ -534,7 +534,7 @@ package body FLTK.Asks is elsif Result = 0 then return Cancel; else - raise Program_Error; + raise Internal_FLTK_Error; end if; end Color_Chooser; diff --git a/src/fltk-draw.adb b/src/fltk-draw.adb index 1a87285..42b3d26 100644 --- a/src/fltk-draw.adb +++ b/src/fltk-draw.adb @@ -673,7 +673,7 @@ package body FLTK.Draw is elsif Result = 0 then return False; else - raise Program_Error; + raise Internal_FLTK_Error; end if; end Can_Do_Alpha_Blending; @@ -1215,7 +1215,7 @@ package body FLTK.Draw is Interfaces.C.int (H), Interfaces.C.int (Alpha)); if Buffer /= Storage.To_Integer (Result (Result'First)'Address) then - raise Program_Error; + raise Internal_FLTK_Error; end if; return Result; end Read_Image; @@ -1240,7 +1240,7 @@ package body FLTK.Draw is if Ret_Val = 0 then raise Draw_Error; elsif Ret_Val /= 1 then - raise Program_Error; + raise Internal_FLTK_Error; end if; end Add_Symbol; @@ -1407,7 +1407,7 @@ package body FLTK.Draw is if Ret_Val = 0 then raise Draw_Error; elsif Ret_Val /= 1 then - raise Program_Error; + raise Internal_FLTK_Error; end if; end Draw_Symbol; diff --git a/src/fltk-environment.adb b/src/fltk-environment.adb index 1632717..a1ebdbe 100644 --- a/src/fltk-environment.adb +++ b/src/fltk-environment.adb @@ -384,7 +384,7 @@ package body FLTK.Environment is elsif Num = root_fl_prefs_user then return User; else - raise Constraint_Error; + raise Internal_FLTK_Error; end if; end To_Scope; diff --git a/src/fltk-text_buffers.adb b/src/fltk-text_buffers.adb index 5d88b10..1afa2a7 100644 --- a/src/fltk-text_buffers.adb +++ b/src/fltk-text_buffers.adb @@ -24,6 +24,14 @@ use type package body FLTK.Text_Buffers is + function strerror + (Errnum : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, strerror, "strerror"); + + + + function new_fl_text_buffer (RS, PGS : in Interfaces.C.int) return Storage.Integer_Address; @@ -634,7 +642,7 @@ package body FLTK.Text_Buffers is Interfaces.C.int (Buffer)); begin if Err_No /= 0 then - raise Storage_Error; + raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No)); end if; end Load_File; @@ -650,7 +658,7 @@ package body FLTK.Text_Buffers is Interfaces.C.int (Buffer)); begin if Err_No /= 0 then - raise Storage_Error; + raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No)); end if; end Append_File; @@ -668,7 +676,7 @@ package body FLTK.Text_Buffers is Interfaces.C.int (Buffer)); begin if Err_No /= 0 then - raise Storage_Error; + raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No)); end if; end Insert_File; @@ -687,7 +695,7 @@ package body FLTK.Text_Buffers is Interfaces.C.int (Buffer)); begin if Err_No /= 0 then - raise Storage_Error; + raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No)); end if; end Output_File; @@ -703,7 +711,7 @@ package body FLTK.Text_Buffers is Interfaces.C.int (Buffer)); begin if Err_No /= 0 then - raise Storage_Error; + raise Storage_Error with Interfaces.C.Strings.Value (strerror (Err_No)); end if; end Save_File; diff --git a/src/fltk-widgets-groups-browsers.adb b/src/fltk-widgets-groups-browsers.adb index 9798c89..bdf79e2 100644 --- a/src/fltk-widgets-groups-browsers.adb +++ b/src/fltk-widgets-groups-browsers.adb @@ -750,7 +750,7 @@ package body FLTK.Widgets.Groups.Browsers is Boolean'Pos (Do_Callbacks)); begin if Code not in 0 .. 1 then - raise Program_Error; + raise Internal_FLTK_Error; end if; return Boolean'Val (Code); end Set_Select; @@ -768,7 +768,7 @@ package body FLTK.Widgets.Groups.Browsers is Boolean'Pos (Do_Callbacks)); begin if Code not in 0 .. 1 then - raise Program_Error; + raise Internal_FLTK_Error; end if; return Boolean'Val (Code); end Select_Only; @@ -792,7 +792,7 @@ package body FLTK.Widgets.Groups.Browsers is Boolean'Pos (Do_Callbacks)); begin if Code not in 0 .. 1 then - raise Program_Error; + raise Internal_FLTK_Error; end if; return Boolean'Val (Code); end Deselect; @@ -816,7 +816,7 @@ package body FLTK.Widgets.Groups.Browsers is Cursor_To_Address (Item)); begin if Code not in 0 .. 1 then - raise Program_Error; + raise Internal_FLTK_Error; end if; return Boolean'Val (Code); end Is_Displayed; diff --git a/src/fltk-widgets-groups-help_views.adb b/src/fltk-widgets-groups-help_views.adb index b5ed154..715e2ca 100644 --- a/src/fltk-widgets-groups-help_views.adb +++ b/src/fltk-widgets-groups-help_views.adb @@ -423,7 +423,7 @@ package body FLTK.Widgets.Groups.Help_Views is if Code = -1 then raise Load_Help_Error; elsif Code /= 0 then - raise Program_Error; + raise Internal_FLTK_Error; end if; end Load; diff --git a/src/fltk.ads b/src/fltk.ads index e0ebf1c..3a0e332 100644 --- a/src/fltk.ads +++ b/src/fltk.ads @@ -21,12 +21,15 @@ package FLTK is -- This is necessary so things like Text_Buffers and -- Widgets can talk to each other behind the binding. type Wrapper is new Ada.Finalization.Limited_Controlled with private; - -- with Type_Invariant => Is_Valid (Wrapper); function Is_Valid (Object : in Wrapper) return Boolean; + -- If this is ever raised it means FLTK has returned a value or otherwise + -- acted in a way that the binding really did not expect. + Internal_FLTK_Error : exception; + |