diff options
| author | Jedidiah Barber <contact@jedbarber.id.au> | 2024-11-17 17:15:53 +1300 |
|---|---|---|
| committer | Jedidiah Barber <contact@jedbarber.id.au> | 2024-11-17 17:15:53 +1300 |
| commit | 619b3da9fbb37c57aedfc039cc813f6acf5569be (patch) | |
| tree | 5577d1594900cd5e23afbc792d31ba9a40818d55 /src | |
| parent | f5f77c762534ed15adc557009d1a645e5fd998a5 (diff) | |
Refactored Finalize subprograms and made note of potential future Widget issues there in fltk.ads
Diffstat (limited to 'src')
160 files changed, 924 insertions, 507 deletions
diff --git a/src/fltk-devices-surfaces-copy.adb b/src/fltk-devices-surfaces-copy.adb index b600239..a904c42 100644 --- a/src/fltk-devices-surfaces-copy.adb +++ b/src/fltk-devices-surfaces-copy.adb @@ -68,13 +68,9 @@ package body FLTK.Devices.Surfaces.Copy is procedure Finalize (This : in out Copy_Surface) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Copy_Surface'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_copy_surface (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Surface_Device (This)); end Finalize; @@ -93,6 +89,8 @@ package body FLTK.Devices.Surfaces.Copy is end return; end Create; + pragma Inline (Create); + end Forge; diff --git a/src/fltk-devices-surfaces-image.adb b/src/fltk-devices-surfaces-image.adb index 9878e49..4eadc9a 100644 --- a/src/fltk-devices-surfaces-image.adb +++ b/src/fltk-devices-surfaces-image.adb @@ -68,13 +68,9 @@ package body FLTK.Devices.Surfaces.Image is procedure Finalize (This : in out Image_Surface) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Image_Surface'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_image_surface (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Surface_Device (This)); end Finalize; diff --git a/src/fltk-devices-surfaces-paged-printers.adb b/src/fltk-devices-surfaces-paged-printers.adb index 3617f28..944efa6 100644 --- a/src/fltk-devices-surfaces-paged-printers.adb +++ b/src/fltk-devices-surfaces-paged-printers.adb @@ -140,13 +140,9 @@ package body FLTK.Devices.Surfaces.Paged.Printers is procedure Finalize (This : in out Printer) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Printer'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_printer (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Paged_Surface (This)); end Finalize; diff --git a/src/fltk-devices-surfaces-paged.adb b/src/fltk-devices-surfaces-paged.adb index 4b9fdb2..990d1ea 100644 --- a/src/fltk-devices-surfaces-paged.adb +++ b/src/fltk-devices-surfaces-paged.adb @@ -138,13 +138,9 @@ package body FLTK.Devices.Surfaces.Paged is procedure Finalize (This : in out Paged_Surface) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Paged_Surface'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_paged_device (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Surface_Device (This)); end Finalize; diff --git a/src/fltk-devices-surfaces.adb b/src/fltk-devices-surfaces.adb index 0824a00..cee6910 100644 --- a/src/fltk-devices-surfaces.adb +++ b/src/fltk-devices-surfaces.adb @@ -37,15 +37,9 @@ package body FLTK.Devices.Surfaces is procedure Finalize (This : in out Surface_Device) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Surface_Device'Class - then - if This.Needs_Dealloc then - free_fl_surface (This.Void_Ptr); - end if; - This.Void_Ptr := Null_Pointer; + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_surface (This.Void_Ptr); end if; - Finalize (Device (This)); end Finalize; @@ -62,6 +56,8 @@ package body FLTK.Devices.Surfaces is end return; end Create; + pragma Inline (Create); + end Forge; diff --git a/src/fltk-environment.adb b/src/fltk-environment.adb index c13c3ec..4cafb19 100644 --- a/src/fltk-environment.adb +++ b/src/fltk-environment.adb @@ -398,30 +398,21 @@ package body FLTK.Environment is procedure Finalize (This : in out Database) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Database'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_pref_database (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Wrapper (This)); end Finalize; procedure Finalize (This : in out Pref_Group) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Pref_Group'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_pref_group (This.Void_Ptr); if This.Root_Ptr /= Null_Pointer then free_fl_pref_database (This.Root_Ptr); - This.Root_Ptr := Null_Pointer; end if; - This.Void_Ptr := Null_Pointer; end if; - Finalize (Wrapper (This)); end Finalize; diff --git a/src/fltk-environment.ads b/src/fltk-environment.ads index 132e610..be32eee 100644 --- a/src/fltk-environment.ads +++ b/src/fltk-environment.ads @@ -295,7 +295,7 @@ private type Pref_Group is new Wrapper with record - Root_Ptr : Storage.Integer_Address; + Root_Ptr : Storage.Integer_Address := Null_Pointer; end record; overriding procedure Finalize diff --git a/src/fltk-help_dialogs.adb b/src/fltk-help_dialogs.adb index a98545c..fa84f01 100644 --- a/src/fltk-help_dialogs.adb +++ b/src/fltk-help_dialogs.adb @@ -149,13 +149,9 @@ package body FLTK.Help_Dialogs is procedure Finalize (This : in out Help_Dialog) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Help_Dialog'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_help_dialog (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Wrapper (This)); end Finalize; diff --git a/src/fltk-images-bitmaps-xbm.adb b/src/fltk-images-bitmaps-xbm.adb index 207d39f..1d063c4 100644 --- a/src/fltk-images-bitmaps-xbm.adb +++ b/src/fltk-images-bitmaps-xbm.adb @@ -29,13 +29,9 @@ package body FLTK.Images.Bitmaps.XBM is overriding procedure Finalize (This : in out XBM_Image) is begin - if This.Void_Ptr /= Null_Pointer and then - This in XBM_Image'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_xbm_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Bitmap (This)); end Finalize; diff --git a/src/fltk-images-bitmaps.adb b/src/fltk-images-bitmaps.adb index 7921fa9..68c7253 100644 --- a/src/fltk-images-bitmaps.adb +++ b/src/fltk-images-bitmaps.adb @@ -66,13 +66,9 @@ package body FLTK.Images.Bitmaps is overriding procedure Finalize (This : in out Bitmap) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Bitmap'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_bitmap (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Image (This)); end Finalize; diff --git a/src/fltk-images-pixmaps-gif.adb b/src/fltk-images-pixmaps-gif.adb index a8567a8..f882749 100644 --- a/src/fltk-images-pixmaps-gif.adb +++ b/src/fltk-images-pixmaps-gif.adb @@ -29,13 +29,9 @@ package body FLTK.Images.Pixmaps.GIF is overriding procedure Finalize (This : in out GIF_Image) is begin - if This.Void_Ptr /= Null_Pointer and then - This in GIF_Image'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_gif_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Pixmap (This)); end Finalize; diff --git a/src/fltk-images-pixmaps-xpm.adb b/src/fltk-images-pixmaps-xpm.adb index d20e8f7..3b170ec 100644 --- a/src/fltk-images-pixmaps-xpm.adb +++ b/src/fltk-images-pixmaps-xpm.adb @@ -29,13 +29,9 @@ package body FLTK.Images.Pixmaps.XPM is overriding procedure Finalize (This : in out XPM_Image) is begin - if This.Void_Ptr /= Null_Pointer and then - This in XPM_Image'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_xpm_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Pixmap (This)); end Finalize; diff --git a/src/fltk-images-pixmaps.adb b/src/fltk-images-pixmaps.adb index 242ed8d..d76132f 100644 --- a/src/fltk-images-pixmaps.adb +++ b/src/fltk-images-pixmaps.adb @@ -74,13 +74,9 @@ package body FLTK.Images.Pixmaps is overriding procedure Finalize (This : in out Pixmap) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Pixmap'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_pixmap (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Image (This)); end Finalize; diff --git a/src/fltk-images-rgb-bmp.adb b/src/fltk-images-rgb-bmp.adb index 8a15988..73d3293 100644 --- a/src/fltk-images-rgb-bmp.adb +++ b/src/fltk-images-rgb-bmp.adb @@ -29,13 +29,9 @@ package body FLTK.Images.RGB.BMP is overriding procedure Finalize (This : in out BMP_Image) is begin - if This.Void_Ptr /= Null_Pointer and then - This in BMP_Image'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_bmp_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (RGB_Image (This)); end Finalize; diff --git a/src/fltk-images-rgb-jpeg.adb b/src/fltk-images-rgb-jpeg.adb index b36c775..f5f5419 100644 --- a/src/fltk-images-rgb-jpeg.adb +++ b/src/fltk-images-rgb-jpeg.adb @@ -36,13 +36,9 @@ package body FLTK.Images.RGB.JPEG is overriding procedure Finalize (This : in out JPEG_Image) is begin - if This.Void_Ptr /= Null_Pointer and then - This in JPEG_Image'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_jpeg_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (RGB_Image (This)); end Finalize; diff --git a/src/fltk-images-rgb-png.adb b/src/fltk-images-rgb-png.adb index 1c117b4..a60a3e0 100644 --- a/src/fltk-images-rgb-png.adb +++ b/src/fltk-images-rgb-png.adb @@ -37,13 +37,9 @@ package body FLTK.Images.RGB.PNG is overriding procedure Finalize (This : in out PNG_Image) is begin - if This.Void_Ptr /= Null_Pointer and then - This in PNG_Image'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_png_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (RGB_Image (This)); end Finalize; diff --git a/src/fltk-images-rgb-pnm.adb b/src/fltk-images-rgb-pnm.adb index d1b6141..8227cd9 100644 --- a/src/fltk-images-rgb-pnm.adb +++ b/src/fltk-images-rgb-pnm.adb @@ -29,13 +29,9 @@ package body FLTK.Images.RGB.PNM is overriding procedure Finalize (This : in out PNM_Image) is begin - if This.Void_Ptr /= Null_Pointer and then - This in PNM_Image'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_pnm_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (RGB_Image (This)); end Finalize; diff --git a/src/fltk-images-rgb.adb b/src/fltk-images-rgb.adb index df3cf99..8ea3646 100644 --- a/src/fltk-images-rgb.adb +++ b/src/fltk-images-rgb.adb @@ -98,13 +98,9 @@ package body FLTK.Images.RGB is overriding procedure Finalize (This : in out RGB_Image) is begin - if This.Void_Ptr /= Null_Pointer and then - This in RGB_Image'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_rgb_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Image (This)); end Finalize; diff --git a/src/fltk-images-shared.adb b/src/fltk-images-shared.adb index b9e2a13..fd2663b 100644 --- a/src/fltk-images-shared.adb +++ b/src/fltk-images-shared.adb @@ -138,13 +138,9 @@ package body FLTK.Images.Shared is overriding procedure Finalize (This : in out Shared_Image) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Shared_Image'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then fl_shared_image_release (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Image (This)); end Finalize; diff --git a/src/fltk-images-tiled.adb b/src/fltk-images-tiled.adb index ee2ce02..a489f82 100644 --- a/src/fltk-images-tiled.adb +++ b/src/fltk-images-tiled.adb @@ -83,13 +83,9 @@ package body FLTK.Images.Tiled is overriding procedure Finalize (This : in out Tiled_Image) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Tiled_Image'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_tiled_image (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Image (This)); end Finalize; diff --git a/src/fltk-images.adb b/src/fltk-images.adb index 9a51f30..e435976 100644 --- a/src/fltk-images.adb +++ b/src/fltk-images.adb @@ -164,13 +164,8 @@ package body FLTK.Images is overriding procedure Finalize (This : in out Image) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Image'Class - then - if This.Needs_Dealloc then - free_fl_image (This.Void_Ptr); - end if; - This.Void_Ptr := Null_Pointer; + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_image (This.Void_Ptr); end if; end Finalize; diff --git a/src/fltk-labels.adb b/src/fltk-labels.adb index 493ac8d..4f5ff28 100644 --- a/src/fltk-labels.adb +++ b/src/fltk-labels.adb @@ -137,14 +137,10 @@ package body FLTK.Labels is procedure Finalize (This : in out Label) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Label'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_label (This.Void_Ptr); Interfaces.C.Strings.Free (This.My_Text); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Wrapper (This)); end Finalize; diff --git a/src/fltk-menu_items.adb b/src/fltk-menu_items.adb index da17ef0..73e4c3c 100644 --- a/src/fltk-menu_items.adb +++ b/src/fltk-menu_items.adb @@ -228,13 +228,8 @@ package body FLTK.Menu_Items is procedure Finalize (This : in out Menu_Item) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Menu_Item'Class - then - if This.Needs_Dealloc then - free_fl_menu_item (This.Void_Ptr); - end if; - This.Void_Ptr := Null_Pointer; + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_menu_item (This.Void_Ptr); end if; end Finalize; diff --git a/src/fltk-text_buffers.adb b/src/fltk-text_buffers.adb index d859b26..e3755a1 100644 --- a/src/fltk-text_buffers.adb +++ b/src/fltk-text_buffers.adb @@ -515,11 +515,8 @@ package body FLTK.Text_Buffers is procedure Finalize (This : in out Text_Buffer) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Text_Buffer'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_text_buffer (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; end Finalize; @@ -535,13 +532,8 @@ package body FLTK.Text_Buffers is begin return This : Text_Buffer do This.Void_Ptr := new_fl_text_buffer - (Interfaces.C.int (Requested_Size), - Interfaces.C.int (Preferred_Gap_Size)); - - This.Modify_CBs := Modify_Vectors.Empty_Vector; - This.Predelete_CBs := Predelete_Vectors.Empty_Vector; - This.CB_Active := True; - + (Interfaces.C.int (Requested_Size), + Interfaces.C.int (Preferred_Gap_Size)); fl_text_buffer_add_modify_callback (This.Void_Ptr, Storage.To_Integer (Modify_Callback_Hook'Address), diff --git a/src/fltk-text_buffers.ads b/src/fltk-text_buffers.ads index 2a8b5d4..53b2692 100644 --- a/src/fltk-text_buffers.ads +++ b/src/fltk-text_buffers.ads @@ -375,7 +375,7 @@ private type Text_Buffer is new Wrapper with record - CB_Active : Boolean; + CB_Active : Boolean := True; Modify_CBs : Modify_Vectors.Vector; Predelete_CBs : Predelete_Vectors.Vector; High_From, High_To : Natural := 0; diff --git a/src/fltk-widgets-boxes.adb b/src/fltk-widgets-boxes.adb index 56c7007..3194237 100644 --- a/src/fltk-widgets-boxes.adb +++ b/src/fltk-widgets-boxes.adb @@ -55,18 +55,20 @@ package body FLTK.Widgets.Boxes is + procedure Extra_Final + (This : in out Box) is + begin + Extra_Final (Widget (This)); + end Extra_Final; + + procedure Finalize (This : in out Box) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Box'Class - then - if This.Needs_Dealloc then - free_fl_box (This.Void_Ptr); - end if; - This.Void_Ptr := Null_Pointer; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_box (This.Void_Ptr); end if; - Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-boxes.ads b/src/fltk-widgets-boxes.ads index c04fe0e..f710011 100644 --- a/src/fltk-widgets-boxes.ads +++ b/src/fltk-widgets-boxes.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Box) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-buttons-enter.adb b/src/fltk-widgets-buttons-enter.adb index f738461..cefe2b1 100644 --- a/src/fltk-widgets-buttons-enter.adb +++ b/src/fltk-widgets-buttons-enter.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Buttons.Enter is + procedure Extra_Final + (This : in out Enter_Button) is + begin + Extra_Final (Button (This)); + end Extra_Final; + + procedure Finalize (This : in out Enter_Button) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Enter_Button'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_return_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-enter.ads b/src/fltk-widgets-buttons-enter.ads index 807697a..a8dbc11 100644 --- a/src/fltk-widgets-buttons-enter.ads +++ b/src/fltk-widgets-buttons-enter.ads @@ -53,6 +53,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Enter_Button) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-buttons-light-check.adb b/src/fltk-widgets-buttons-light-check.adb index 135eaca..7594782 100644 --- a/src/fltk-widgets-buttons-light-check.adb +++ b/src/fltk-widgets-buttons-light-check.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Buttons.Light.Check is + procedure Extra_Final + (This : in out Check_Button) is + begin + Extra_Final (Light_Button (This)); + end Extra_Final; + + procedure Finalize (This : in out Check_Button) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Check_Button'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_check_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Light_Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-light-check.ads b/src/fltk-widgets-buttons-light-check.ads index bd1b1ee..a4f6767 100644 --- a/src/fltk-widgets-buttons-light-check.ads +++ b/src/fltk-widgets-buttons-light-check.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Check_Button) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-buttons-light-radio.adb b/src/fltk-widgets-buttons-light-radio.adb index 0701054..a1f0e95 100644 --- a/src/fltk-widgets-buttons-light-radio.adb +++ b/src/fltk-widgets-buttons-light-radio.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Buttons.Light.Radio is + procedure Extra_Final + (This : in out Radio_Light_Button) is + begin + Extra_Final (Light_Button (This)); + end Extra_Final; + + procedure Finalize (This : in out Radio_Light_Button) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Radio_Light_Button'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_radio_light_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Light_Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-light-radio.ads b/src/fltk-widgets-buttons-light-radio.ads index 639e623..e8cfcb8 100644 --- a/src/fltk-widgets-buttons-light-radio.ads +++ b/src/fltk-widgets-buttons-light-radio.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Radio_Light_Button) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-buttons-light-round-radio.adb b/src/fltk-widgets-buttons-light-round-radio.adb index 4dbe7d9..cabcb0d 100644 --- a/src/fltk-widgets-buttons-light-round-radio.adb +++ b/src/fltk-widgets-buttons-light-round-radio.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is + procedure Extra_Final + (This : in out Radio_Round_Button) is + begin + Extra_Final (Round_Button (This)); + end Extra_Final; + + procedure Finalize (This : in out Radio_Round_Button) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Radio_Round_Button'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_radio_round_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Round_Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-light-round-radio.ads b/src/fltk-widgets-buttons-light-round-radio.ads index 54d0172..e16964e 100644 --- a/src/fltk-widgets-buttons-light-round-radio.ads +++ b/src/fltk-widgets-buttons-light-round-radio.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Radio_Round_Button) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-buttons-light-round.adb b/src/fltk-widgets-buttons-light-round.adb index 9c120d4..b0ed29a 100644 --- a/src/fltk-widgets-buttons-light-round.adb +++ b/src/fltk-widgets-buttons-light-round.adb @@ -55,16 +55,19 @@ package body FLTK.Widgets.Buttons.Light.Round is + procedure Extra_Final + (This : in out Round_Button) is + begin + Extra_Final (Light_Button (This)); + end Extra_Final; + + procedure Finalize (This : in out Round_Button) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Round_Button'Class - then + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_round_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Light_Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-light-round.ads b/src/fltk-widgets-buttons-light-round.ads index ab54b81..443cf60 100644 --- a/src/fltk-widgets-buttons-light-round.ads +++ b/src/fltk-widgets-buttons-light-round.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Round_Button) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-buttons-light.adb b/src/fltk-widgets-buttons-light.adb index 4e74c74..13afeb6 100644 --- a/src/fltk-widgets-buttons-light.adb +++ b/src/fltk-widgets-buttons-light.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Buttons.Light is + procedure Extra_Final + (This : in out Light_Button) is + begin + Extra_Final (Button (This)); + end Extra_Final; + + procedure Finalize (This : in out Light_Button) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Light_Button'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_light_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-light.ads b/src/fltk-widgets-buttons-light.ads index b7be94f..291cc0e 100644 --- a/src/fltk-widgets-buttons-light.ads +++ b/src/fltk-widgets-buttons-light.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Light_Button) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-buttons-radio.adb b/src/fltk-widgets-buttons-radio.adb index f75d95c..7fb764e 100644 --- a/src/fltk-widgets-buttons-radio.adb +++ b/src/fltk-widgets-buttons-radio.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Buttons.Radio is + procedure Extra_Final + (This : in out Radio_Button) is + begin + Extra_Final (Button (This)); + end Extra_Final; + + procedure Finalize (This : in out Radio_Button) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Radio_Button'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_radio_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-radio.ads b/src/fltk-widgets-buttons-radio.ads index 08816bd..285f614 100644 --- a/src/fltk-widgets-buttons-radio.ads +++ b/src/fltk-widgets-buttons-radio.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Radio_Button) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-buttons-repeat.adb b/src/fltk-widgets-buttons-repeat.adb index e61786f..de4cf29 100644 --- a/src/fltk-widgets-buttons-repeat.adb +++ b/src/fltk-widgets-buttons-repeat.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Buttons.Repeat is + procedure Extra_Final + (This : in out Repeat_Button) is + begin + Extra_Final (Button (This)); + end Extra_Final; + + procedure Finalize (This : in out Repeat_Button) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Repeat_Button'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_repeat_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-repeat.ads b/src/fltk-widgets-buttons-repeat.ads index e2b440d..eeb4166 100644 --- a/src/fltk-widgets-buttons-repeat.ads +++ b/src/fltk-widgets-buttons-repeat.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Repeat_Button) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-buttons-toggle.adb b/src/fltk-widgets-buttons-toggle.adb index 44c6a80..0fe7962 100644 --- a/src/fltk-widgets-buttons-toggle.adb +++ b/src/fltk-widgets-buttons-toggle.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Buttons.Toggle is + procedure Extra_Final + (This : in out Toggle_Button) is + begin + Extra_Final (Button (This)); + end Extra_Final; + + procedure Finalize (This : in out Toggle_Button) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Toggle_Button'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_toggle_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Button (This)); end Finalize; diff --git a/src/fltk-widgets-buttons-toggle.ads b/src/fltk-widgets-buttons-toggle.ads index a4e775d..a218533 100644 --- a/src/fltk-widgets-buttons-toggle.ads +++ b/src/fltk-widgets-buttons-toggle.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Toggle_Button) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-buttons.adb b/src/fltk-widgets-buttons.adb index 81bf3a8..a6c98d0 100644 --- a/src/fltk-widgets-buttons.adb +++ b/src/fltk-widgets-buttons.adb @@ -102,16 +102,20 @@ package body FLTK.Widgets.Buttons is + procedure Extra_Final + (This : in out Button) is + begin + Extra_Final (Widget (This)); + end Extra_Final; + + procedure Finalize (This : in out Button) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Button'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_button (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-buttons.ads b/src/fltk-widgets-buttons.ads index 5365bd6..18c5026 100644 --- a/src/fltk-widgets-buttons.ads +++ b/src/fltk-widgets-buttons.ads @@ -85,6 +85,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Button) + with Inline; + pragma Inline (Get_State); pragma Inline (Set_State); diff --git a/src/fltk-widgets-charts.adb b/src/fltk-widgets-charts.adb index 6754910..fd477cc 100644 --- a/src/fltk-widgets-charts.adb +++ b/src/fltk-widgets-charts.adb @@ -186,16 +186,20 @@ package body FLTK.Widgets.Charts is + procedure Extra_Final + (This : in out Chart) is + begin + Extra_Final (Widget (This)); + end Extra_Final; + + procedure Finalize (This : in out Chart) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Chart'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_chart (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-charts.ads b/src/fltk-widgets-charts.ads index 409090f..71df2f0 100644 --- a/src/fltk-widgets-charts.ads +++ b/src/fltk-widgets-charts.ads @@ -141,6 +141,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Chart) + with Inline; + pragma Inline (Add); pragma Inline (Insert); diff --git a/src/fltk-widgets-clocks-updated-round.adb b/src/fltk-widgets-clocks-updated-round.adb index 96acf8a..aa08655 100644 --- a/src/fltk-widgets-clocks-updated-round.adb +++ b/src/fltk-widgets-clocks-updated-round.adb @@ -61,16 +61,20 @@ package body FLTK.Widgets.Clocks.Updated.Round is + procedure Extra_Final + (This : in out Round_Clock) is + begin + Extra_Final (Updated_Clock (This)); + end Extra_Final; + + procedure Finalize (This : in out Round_Clock) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Round_Clock'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_round_clock (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Updated_Clock (This)); end Finalize; diff --git a/src/fltk-widgets-clocks-updated-round.ads b/src/fltk-widgets-clocks-updated-round.ads index efd0417..fc52031 100644 --- a/src/fltk-widgets-clocks-updated-round.ads +++ b/src/fltk-widgets-clocks-updated-round.ads @@ -54,6 +54,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Round_Clock) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-clocks-updated.adb b/src/fltk-widgets-clocks-updated.adb index b9eabea..9ca47ce 100644 --- a/src/fltk-widgets-clocks-updated.adb +++ b/src/fltk-widgets-clocks-updated.adb @@ -69,16 +69,20 @@ package body FLTK.Widgets.Clocks.Updated is + procedure Extra_Final + (This : in out Updated_Clock) is + begin + Extra_Final (Clock (This)); + end Extra_Final; + + procedure Finalize (This : in out Updated_Clock) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Updated_Clock'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_clock (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Clock (This)); end Finalize; diff --git a/src/fltk-widgets-clocks-updated.ads b/src/fltk-widgets-clocks-updated.ads index a4662c0..c094c55 100644 --- a/src/fltk-widgets-clocks-updated.ads +++ b/src/fltk-widgets-clocks-updated.ads @@ -60,6 +60,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Updated_Clock) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-clocks.adb b/src/fltk-widgets-clocks.adb index 8c9e785..535dd36 100644 --- a/src/fltk-widgets-clocks.adb +++ b/src/fltk-widgets-clocks.adb @@ -103,16 +103,20 @@ package body FLTK.Widgets.Clocks is + procedure Extra_Final + (This : in out Clock) is + begin + Extra_Final (Widget (This)); + end Extra_Final; + + procedure Finalize (This : in out Clock) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Clock'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_clock_output (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-clocks.ads b/src/fltk-widgets-clocks.ads index 36782b3..5117fb1 100644 --- a/src/fltk-widgets-clocks.ads +++ b/src/fltk-widgets-clocks.ads @@ -92,6 +92,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Clock) + with Inline; + pragma Inline (Get_Hour); pragma Inline (Get_Minute); diff --git a/src/fltk-widgets-groups-browsers.adb b/src/fltk-widgets-groups-browsers.adb index 48d2265..cd9b3f3 100644 --- a/src/fltk-widgets-groups-browsers.adb +++ b/src/fltk-widgets-groups-browsers.adb @@ -629,17 +629,22 @@ package body FLTK.Widgets.Groups.Browsers is -- Controlled Type Subprograms -- ----------------------------------- + procedure Extra_Final + (This : in out Abstract_Browser) is + begin + Extra_Final (Widget (This.Horizon)); + Extra_Final (Widget (This.Vertigo)); + Extra_Final (Group (This)); + end Extra_Final; + + procedure Finalize (This : in out Abstract_Browser) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Abstract_Browser'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_abstract_browser (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-browsers.ads b/src/fltk-widgets-groups-browsers.ads index 00aabc8..66cfdd3 100644 --- a/src/fltk-widgets-groups-browsers.ads +++ b/src/fltk-widgets-groups-browsers.ads @@ -350,6 +350,9 @@ private X, Y, W, H : in Integer; Text : in String); + procedure Extra_Final + (This : in out Abstract_Browser); + pragma Assert (Item_Cursor'Size = Storage.Integer_Address'Size, diff --git a/src/fltk-widgets-groups-color_choosers.adb b/src/fltk-widgets-groups-color_choosers.adb index c66ae1a..cd97fb3 100644 --- a/src/fltk-widgets-groups-color_choosers.adb +++ b/src/fltk-widgets-groups-color_choosers.adb @@ -145,17 +145,20 @@ package body FLTK.Widgets.Groups.Color_Choosers is + procedure Extra_Final + (This : in out Color_Chooser) is + begin + Extra_Final (Group (This)); + end Extra_Final; + + procedure Finalize (This : in out Color_Chooser) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Color_Chooser'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_color_chooser (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-color_choosers.ads b/src/fltk-widgets-groups-color_choosers.ads index 580c31a..badbe24 100644 --- a/src/fltk-widgets-groups-color_choosers.ads +++ b/src/fltk-widgets-groups-color_choosers.ads @@ -124,6 +124,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Color_Chooser) + with Inline; + pragma Inline (Get_Red); pragma Inline (Get_Green); diff --git a/src/fltk-widgets-groups-help_views.adb b/src/fltk-widgets-groups-help_views.adb index 385e0eb..24a592f 100644 --- a/src/fltk-widgets-groups-help_views.adb +++ b/src/fltk-widgets-groups-help_views.adb @@ -267,18 +267,21 @@ package body FLTK.Widgets.Groups.Help_Views is -- Controlled Type Subprograms -- ----------------------------------- + procedure Extra_Final + (This : in out Help_View) is + begin + Interfaces.C.Strings.Free (This.Hilda); + Extra_Final (Group (This)); + end Extra_Final; + + procedure Finalize (This : in out Help_View) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Help_View'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_help_view (This.Void_Ptr); - Interfaces.C.Strings.Free (This.Hilda); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-help_views.ads b/src/fltk-widgets-groups-help_views.ads index ce24ef1..8bea2a6 100644 --- a/src/fltk-widgets-groups-help_views.ads +++ b/src/fltk-widgets-groups-help_views.ads @@ -188,6 +188,9 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Help_View); + pragma Inline (Clear_Selection); pragma Inline (Select_All); diff --git a/src/fltk-widgets-groups-input_choices.adb b/src/fltk-widgets-groups-input_choices.adb index 41994dc..7fc6870 100644 --- a/src/fltk-widgets-groups-input_choices.adb +++ b/src/fltk-widgets-groups-input_choices.adb @@ -168,20 +168,26 @@ package body FLTK.Widgets.Groups.Input_Choices is + procedure Extra_Final + (This : in out Input_Choice) is + begin + Extra_Final (Widget (This.My_Input)); + Extra_Final (Widget (This.My_Menu_Button)); + Extra_Final (Group (This)); + end Extra_Final; + procedure Finalize (This : in out Input_Choice) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Input_Choice'Class - then - Group (This).Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_input_choice (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; + + procedure Extra_Init (This : in out Input_Choice; X, Y, W, H : in Integer; diff --git a/src/fltk-widgets-groups-input_choices.ads b/src/fltk-widgets-groups-input_choices.ads index 1cc2f2f..0ffc8d9 100644 --- a/src/fltk-widgets-groups-input_choices.ads +++ b/src/fltk-widgets-groups-input_choices.ads @@ -133,6 +133,9 @@ private X, Y, W, H : in Integer; Text : in String); + procedure Extra_Final + (This : in out Input_Choice); + pragma Inline (Input); pragma Inline (Menu_Button); diff --git a/src/fltk-widgets-groups-packed.adb b/src/fltk-widgets-groups-packed.adb index 1a40889..5bc4d37 100644 --- a/src/fltk-widgets-groups-packed.adb +++ b/src/fltk-widgets-groups-packed.adb @@ -70,17 +70,20 @@ package body FLTK.Widgets.Groups.Packed is + procedure Extra_Final + (This : in out Packed_Group) is + begin + Extra_Final (Group (This)); + end Extra_Final; + + procedure Finalize (This : in out Packed_Group) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Packed_Group'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_pack (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-packed.ads b/src/fltk-widgets-groups-packed.ads index e09f5aa..8bc134d 100644 --- a/src/fltk-widgets-groups-packed.ads +++ b/src/fltk-widgets-groups-packed.ads @@ -61,6 +61,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Packed_Group) + with Inline; + pragma Inline (Get_Spacing); pragma Inline (Set_Spacing); diff --git a/src/fltk-widgets-groups-scrolls.adb b/src/fltk-widgets-groups-scrolls.adb index 5ae90f4..a31dea3 100644 --- a/src/fltk-widgets-groups-scrolls.adb +++ b/src/fltk-widgets-groups-scrolls.adb @@ -105,17 +105,20 @@ package body FLTK.Widgets.Groups.Scrolls is + procedure Extra_Final + (This : in out Scroll) is + begin + Extra_Final (Group (This)); + end Extra_Final; + + procedure Finalize (This : in out Scroll) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Scroll'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_scroll (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-scrolls.ads b/src/fltk-widgets-groups-scrolls.ads index 0c34e2e..f571230 100644 --- a/src/fltk-widgets-groups-scrolls.ads +++ b/src/fltk-widgets-groups-scrolls.ads @@ -97,6 +97,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Scroll) + with Inline; + pragma Inline (Clear); diff --git a/src/fltk-widgets-groups-spinners.adb b/src/fltk-widgets-groups-spinners.adb index 3366c71..b87e27e 100644 --- a/src/fltk-widgets-groups-spinners.adb +++ b/src/fltk-widgets-groups-spinners.adb @@ -191,17 +191,20 @@ package body FLTK.Widgets.Groups.Spinners is + procedure Extra_Final + (This : in out Spinner) is + begin + Extra_Final (Group (This)); + end Extra_Final; + + procedure Finalize (This : in out Spinner) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Spinner'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_spinner (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-spinners.ads b/src/fltk-widgets-groups-spinners.ads index 245df12..be7b8d9 100644 --- a/src/fltk-widgets-groups-spinners.ads +++ b/src/fltk-widgets-groups-spinners.ads @@ -146,6 +146,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Spinner) + with Inline; + pragma Inline (Get_Background_Color); pragma Inline (Set_Background_Color); diff --git a/src/fltk-widgets-groups-tabbed.adb b/src/fltk-widgets-groups-tabbed.adb index c206c26..b0b0c2f 100644 --- a/src/fltk-widgets-groups-tabbed.adb +++ b/src/fltk-widgets-groups-tabbed.adb @@ -97,17 +97,20 @@ package body FLTK.Widgets.Groups.Tabbed is + procedure Extra_Final + (This : in out Tabbed_Group) is + begin + Extra_Final (Group (This)); + end Extra_Final; + + procedure Finalize (This : in out Tabbed_Group) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Tabbed_Group'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_tabs (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-tabbed.ads b/src/fltk-widgets-groups-tabbed.ads index 15c8fd0..cadd144 100644 --- a/src/fltk-widgets-groups-tabbed.ads +++ b/src/fltk-widgets-groups-tabbed.ads @@ -82,6 +82,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Tabbed_Group) + with Inline; + pragma Inline (Get_Client_Area); diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb index 0653c89..55399e7 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.adb +++ b/src/fltk-widgets-groups-text_displays-text_editors.adb @@ -384,18 +384,21 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is + procedure Extra_Final + (This : in out Text_Editor) is + begin + Extra_Final (Text_Display (This)); + end Extra_Final; + + procedure Finalize (This : in out Text_Editor) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Text_Editor'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_text_editor (This.Void_Ptr); free_fl_text_buffer (This.Raw_Buffer); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Text_Display (This)); end Finalize; diff --git a/src/fltk-widgets-groups-text_displays-text_editors.ads b/src/fltk-widgets-groups-text_displays-text_editors.ads index 67ea0e7..8eb604a 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.ads +++ b/src/fltk-widgets-groups-text_displays-text_editors.ads @@ -349,6 +349,9 @@ private X, Y, W, H : in Integer; Text : in String); + procedure Extra_Final + (This : in out Text_Editor); + function Key_Func_Hook (K : in Interfaces.C.int; diff --git a/src/fltk-widgets-groups-text_displays.adb b/src/fltk-widgets-groups-text_displays.adb index d818490..d8e296f 100644 --- a/src/fltk-widgets-groups-text_displays.adb +++ b/src/fltk-widgets-groups-text_displays.adb @@ -466,18 +466,21 @@ package body FLTK.Widgets.Groups.Text_Displays is + procedure Extra_Final + (This : in out Text_Display) is + begin + Extra_Final (Group (This)); + end Extra_Final; + + procedure Finalize (This : in out Text_Display) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Text_Display'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_text_display (This.Void_Ptr); free_fl_text_buffer (This.Raw_Buffer); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-text_displays.ads b/src/fltk-widgets-groups-text_displays.ads index 775acbe..bf7d662 100644 --- a/src/fltk-widgets-groups-text_displays.ads +++ b/src/fltk-widgets-groups-text_displays.ads @@ -376,6 +376,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Text_Display) + with Inline; + package Text_Display_Convert is new System.Address_To_Access_Conversions (Text_Display'Class); diff --git a/src/fltk-widgets-groups-tiled.adb b/src/fltk-widgets-groups-tiled.adb index ea4b70d..9619a06 100644 --- a/src/fltk-widgets-groups-tiled.adb +++ b/src/fltk-widgets-groups-tiled.adb @@ -64,17 +64,20 @@ package body FLTK.Widgets.Groups.Tiled is + procedure Extra_Final + (This : in out Tiled_Group) is + begin + Extra_Final (Group (This)); + end Extra_Final; + + procedure Finalize (This : in out Tiled_Group) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Tiled_Group'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_tile (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-tiled.ads b/src/fltk-widgets-groups-tiled.ads index 07954aa..7dc3d0d 100644 --- a/src/fltk-widgets-groups-tiled.ads +++ b/src/fltk-widgets-groups-tiled.ads @@ -58,6 +58,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Tiled_Group) + with Inline; + pragma Inline (Position); diff --git a/src/fltk-widgets-groups-windows-double-overlay.adb b/src/fltk-widgets-groups-windows-double-overlay.adb index 382ab50..ca0936c 100644 --- a/src/fltk-widgets-groups-windows-double-overlay.adb +++ b/src/fltk-widgets-groups-windows-double-overlay.adb @@ -120,17 +120,20 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is + procedure Extra_Final + (This : in out Overlay_Window) is + begin + Extra_Final (Double_Window (This)); + end Extra_Final; + + procedure Finalize (This : in out Overlay_Window) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Overlay_Window'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_overlay_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Double_Window (This)); end Finalize; diff --git a/src/fltk-widgets-groups-windows-double-overlay.ads b/src/fltk-widgets-groups-windows-double-overlay.ads index e04e5a5..097abb8 100644 --- a/src/fltk-widgets-groups-windows-double-overlay.ads +++ b/src/fltk-widgets-groups-windows-double-overlay.ads @@ -100,6 +100,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Overlay_Window) + with Inline; + pragma Inline (Show); pragma Inline (Hide); diff --git a/src/fltk-widgets-groups-windows-double.adb b/src/fltk-widgets-groups-windows-double.adb index b8562f1..190b743 100644 --- a/src/fltk-widgets-groups-windows-double.adb +++ b/src/fltk-widgets-groups-windows-double.adb @@ -80,17 +80,20 @@ package body FLTK.Widgets.Groups.Windows.Double is + procedure Extra_Final + (This : in out Double_Window) is + begin + Extra_Final (Window (This)); + end Extra_Final; + + procedure Finalize (This : in out Double_Window) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Double_Window'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_double_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Window (This)); end Finalize; diff --git a/src/fltk-widgets-groups-windows-double.ads b/src/fltk-widgets-groups-windows-double.ads index cd16a1f..a72c090 100644 --- a/src/fltk-widgets-groups-windows-double.ads +++ b/src/fltk-widgets-groups-windows-double.ads @@ -66,6 +66,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Double_Window) + with Inline; + pragma Inline (Show); pragma Inline (Hide); diff --git a/src/fltk-widgets-groups-windows-opengl.adb b/src/fltk-widgets-groups-windows-opengl.adb index 9ea1ed3..e315cc4 100644 --- a/src/fltk-widgets-groups-windows-opengl.adb +++ b/src/fltk-widgets-groups-windows-opengl.adb @@ -210,17 +210,20 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is + procedure Extra_Final + (This : in out GL_Window) is + begin + Extra_Final (Window (This)); + end Extra_Final; + + procedure Finalize (This : in out GL_Window) is begin - if This.Void_Ptr /= Null_Pointer and then - This in GL_Window'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_gl_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Window (This)); end Finalize; diff --git a/src/fltk-widgets-groups-windows-opengl.ads b/src/fltk-widgets-groups-windows-opengl.ads index 9a60f03..63762fb 100644 --- a/src/fltk-widgets-groups-windows-opengl.ads +++ b/src/fltk-widgets-groups-windows-opengl.ads @@ -204,6 +204,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out GL_Window) + with Inline; + for Mode_Mask use record Index at 0 range 0 .. 0; diff --git a/src/fltk-widgets-groups-windows-single-menu.adb b/src/fltk-widgets-groups-windows-single-menu.adb index d1249e7..9aa0ded 100644 --- a/src/fltk-widgets-groups-windows-single-menu.adb +++ b/src/fltk-widgets-groups-windows-single-menu.adb @@ -103,17 +103,20 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is + procedure Extra_Final + (This : in out Menu_Window) is + begin + Extra_Final (Single_Window (This)); + end Extra_Final; + + procedure Finalize (This : in out Menu_Window) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Menu_Window'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_menu_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Single_Window (This)); end Finalize; diff --git a/src/fltk-widgets-groups-windows-single-menu.ads b/src/fltk-widgets-groups-windows-single-menu.ads index 0b66490..d380141 100644 --- a/src/fltk-widgets-groups-windows-single-menu.ads +++ b/src/fltk-widgets-groups-windows-single-menu.ads @@ -78,6 +78,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Menu_Window) + with Inline; + pragma Inline (Show); pragma Inline (Hide); diff --git a/src/fltk-widgets-groups-windows-single.adb b/src/fltk-widgets-groups-windows-single.adb index 14618b9..a012920 100644 --- a/src/fltk-widgets-groups-windows-single.adb +++ b/src/fltk-widgets-groups-windows-single.adb @@ -75,17 +75,20 @@ package body FLTK.Widgets.Groups.Windows.Single is + procedure Extra_Final + (This : in out Single_Window) is + begin + Extra_Final (Window (This)); + end Extra_Final; + + procedure Finalize (This : in out Single_Window) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Single_Window'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_single_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Window (This)); end Finalize; diff --git a/src/fltk-widgets-groups-windows-single.ads b/src/fltk-widgets-groups-windows-single.ads index 6e1e1e1..0dfa262 100644 --- a/src/fltk-widgets-groups-windows-single.ads +++ b/src/fltk-widgets-groups-windows-single.ads @@ -64,6 +64,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Single_Window) + with Inline; + pragma Inline (Show); pragma Inline (Flush); diff --git a/src/fltk-widgets-groups-windows.adb b/src/fltk-widgets-groups-windows.adb index d7cc362..af5cef7 100644 --- a/src/fltk-widgets-groups-windows.adb +++ b/src/fltk-widgets-groups-windows.adb @@ -300,17 +300,20 @@ package body FLTK.Widgets.Groups.Windows is + procedure Extra_Final + (This : in out Window) is + begin + Extra_Final (Group (This)); + end Extra_Final; + + procedure Finalize (This : in out Window) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Window'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_window (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-windows.ads b/src/fltk-widgets-groups-windows.ads index 27fa02d..f64bb40 100644 --- a/src/fltk-widgets-groups-windows.ads +++ b/src/fltk-widgets-groups-windows.ads @@ -224,6 +224,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Window) + with Inline; + pragma Inline (Show); pragma Inline (Hide); diff --git a/src/fltk-widgets-groups-wizards.adb b/src/fltk-widgets-groups-wizards.adb index d776b71..b3d6d6d 100644 --- a/src/fltk-widgets-groups-wizards.adb +++ b/src/fltk-widgets-groups-wizards.adb @@ -82,17 +82,20 @@ package body FLTK.Widgets.Groups.Wizards is + procedure Extra_Final + (This : in out Wizard) is + begin + Extra_Final (Group (This)); + end Extra_Final; + + procedure Finalize (This : in out Wizard) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Wizard'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_wizard (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Group (This)); end Finalize; diff --git a/src/fltk-widgets-groups-wizards.ads b/src/fltk-widgets-groups-wizards.ads index 5034d7c..9464a0f 100644 --- a/src/fltk-widgets-groups-wizards.ads +++ b/src/fltk-widgets-groups-wizards.ads @@ -70,6 +70,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Wizard) + with Inline; + pragma Inline (Next); pragma Inline (Prev); diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb index 3f07083..f61104a 100644 --- a/src/fltk-widgets-groups.adb +++ b/src/fltk-widgets-groups.adb @@ -166,17 +166,21 @@ package body FLTK.Widgets.Groups is + procedure Extra_Final + (This : in out Group) is + begin + This.Clear; + Extra_Final (Widget (This)); + end Extra_Final; + + procedure Finalize (This : in out Group) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Group'Class - then - This.Clear; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_group (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-groups.ads b/src/fltk-widgets-groups.ads index 38991b1..194ceca 100644 --- a/src/fltk-widgets-groups.ads +++ b/src/fltk-widgets-groups.ads @@ -172,6 +172,10 @@ private X, Y, W, H : in Integer; Text : in String); + procedure Extra_Final + (This : in out Group); + + package Group_Convert is new System.Address_To_Access_Conversions (Group); diff --git a/src/fltk-widgets-inputs-file.adb b/src/fltk-widgets-inputs-file.adb index b445eeb..f928187 100644 --- a/src/fltk-widgets-inputs-file.adb +++ b/src/fltk-widgets-inputs-file.adb @@ -102,16 +102,20 @@ package body FLTK.Widgets.Inputs.File is + procedure Extra_Final + (This : in out File_Input) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + procedure Finalize (This : in out File_Input) is begin - if This.Void_Ptr /= Null_Pointer and then - This in File_Input'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_file_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-file.ads b/src/fltk-widgets-inputs-file.ads index 0b493d7..fc6d845 100644 --- a/src/fltk-widgets-inputs-file.ads +++ b/src/fltk-widgets-inputs-file.ads @@ -80,6 +80,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out File_Input) + with Inline; + pragma Inline (Get_Down_Box); pragma Inline (Set_Down_Box); diff --git a/src/fltk-widgets-inputs-float.adb b/src/fltk-widgets-inputs-float.adb index 71bcb39..be8e05a 100644 --- a/src/fltk-widgets-inputs-float.adb +++ b/src/fltk-widgets-inputs-float.adb @@ -59,16 +59,20 @@ package body FLTK.Widgets.Inputs.Float is + procedure Extra_Final + (This : in out Float_Input) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + procedure Finalize (This : in out Float_Input) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Float_Input'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_float_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-float.ads b/src/fltk-widgets-inputs-float.ads index 67ddd8b..6e009a4 100644 --- a/src/fltk-widgets-inputs-float.ads +++ b/src/fltk-widgets-inputs-float.ads @@ -57,6 +57,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Float_Input) + with Inline; + pragma Inline (Get_Value); diff --git a/src/fltk-widgets-inputs-integer.adb b/src/fltk-widgets-inputs-integer.adb index 1d2c307..6633354 100644 --- a/src/fltk-widgets-inputs-integer.adb +++ b/src/fltk-widgets-inputs-integer.adb @@ -59,16 +59,20 @@ package body FLTK.Widgets.Inputs.Integer is + procedure Extra_Final + (This : in out Integer_Input) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + procedure Finalize (This : in out Integer_Input) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Integer_Input'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_int_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-integer.ads b/src/fltk-widgets-inputs-integer.ads index 57dec17..fb76662 100644 --- a/src/fltk-widgets-inputs-integer.ads +++ b/src/fltk-widgets-inputs-integer.ads @@ -57,6 +57,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Integer_Input) + with Inline; + pragma Inline (Get_Value); diff --git a/src/fltk-widgets-inputs-multiline.adb b/src/fltk-widgets-inputs-multiline.adb index 9a0b075..b240631 100644 --- a/src/fltk-widgets-inputs-multiline.adb +++ b/src/fltk-widgets-inputs-multiline.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Inputs.Multiline is + procedure Extra_Final + (This : in out Multiline_Input) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + procedure Finalize (This : in out Multiline_Input) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Multiline_Input'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_multiline_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-multiline.ads b/src/fltk-widgets-inputs-multiline.ads index 6198af7..4b7d596 100644 --- a/src/fltk-widgets-inputs-multiline.ads +++ b/src/fltk-widgets-inputs-multiline.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Multiline_Input) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-inputs-outputs-multiline.adb b/src/fltk-widgets-inputs-outputs-multiline.adb index d5333e7..d0fb8f7 100644 --- a/src/fltk-widgets-inputs-outputs-multiline.adb +++ b/src/fltk-widgets-inputs-outputs-multiline.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Inputs.Outputs.Multiline is + procedure Extra_Final + (This : in out Multiline_Output) is + begin + Extra_Final (Output (This)); + end Extra_Final; + + procedure Finalize (This : in out Multiline_Output) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Multiline_Output'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_multiline_output (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Output (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-outputs-multiline.ads b/src/fltk-widgets-inputs-outputs-multiline.ads index b339397..23e2725 100644 --- a/src/fltk-widgets-inputs-outputs-multiline.ads +++ b/src/fltk-widgets-inputs-outputs-multiline.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Multiline_Output) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-inputs-outputs.adb b/src/fltk-widgets-inputs-outputs.adb index 9ed0e1b..e7d5f44 100644 --- a/src/fltk-widgets-inputs-outputs.adb +++ b/src/fltk-widgets-inputs-outputs.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Inputs.Outputs is + procedure Extra_Final + (This : in out Output) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + procedure Finalize (This : in out Output) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Output'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_output (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-outputs.ads b/src/fltk-widgets-inputs-outputs.ads index 456b3fe..d9c060d 100644 --- a/src/fltk-widgets-inputs-outputs.ads +++ b/src/fltk-widgets-inputs-outputs.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Output) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-inputs-secret.adb b/src/fltk-widgets-inputs-secret.adb index 7fe2a39..0f56085 100644 --- a/src/fltk-widgets-inputs-secret.adb +++ b/src/fltk-widgets-inputs-secret.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Inputs.Secret is + procedure Extra_Final + (This : in out Secret_Input) is + begin + Extra_Final (Input (This)); + end Extra_Final; + + procedure Finalize (This : in out Secret_Input) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Secret_Input'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_secret_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Input (This)); end Finalize; diff --git a/src/fltk-widgets-inputs-secret.ads b/src/fltk-widgets-inputs-secret.ads index 62bed26..2f419b7 100644 --- a/src/fltk-widgets-inputs-secret.ads +++ b/src/fltk-widgets-inputs-secret.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Secret_Input) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb index fdcdab8..3281a00 100644 --- a/src/fltk-widgets-inputs.adb +++ b/src/fltk-widgets-inputs.adb @@ -308,18 +308,20 @@ package body FLTK.Widgets.Inputs is + procedure Extra_Final + (This : in out Input) is + begin + Extra_Final (Widget (This)); + end Extra_Final; + + procedure Finalize (This : in out Input) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Input'Class - then - if This.Needs_Dealloc then - free_fl_input (This.Void_Ptr); - end if; - This.Void_Ptr := Null_Pointer; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_input (This.Void_Ptr); end if; - Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-inputs.ads b/src/fltk-widgets-inputs.ads index 296ca94..76d6848 100644 --- a/src/fltk-widgets-inputs.ads +++ b/src/fltk-widgets-inputs.ads @@ -243,6 +243,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Input) + with Inline; + pragma Inline (Copy); pragma Inline (Cut); diff --git a/src/fltk-widgets-menus-choices.adb b/src/fltk-widgets-menus-choices.adb index b306c9b..211114f 100644 --- a/src/fltk-widgets-menus-choices.adb +++ b/src/fltk-widgets-menus-choices.adb @@ -82,21 +82,24 @@ package body FLTK.Widgets.Menus.Choices is + procedure Extra_Final + (This : in out Choice) is + begin + Extra_Final (Menu (This)); + end Extra_Final; + procedure Finalize (This : in out Choice) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Choice'Class - then - if This.Needs_Dealloc then - free_fl_choice (This.Void_Ptr); - end if; - This.Void_Ptr := Null_Pointer; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_choice (This.Void_Ptr); end if; - Finalize (Widget (This)); end Finalize; + + procedure Extra_Init (This : in out Choice; X, Y, W, H : in Integer; diff --git a/src/fltk-widgets-menus-choices.ads b/src/fltk-widgets-menus-choices.ads index fbab109..ec73836 100644 --- a/src/fltk-widgets-menus-choices.ads +++ b/src/fltk-widgets-menus-choices.ads @@ -69,6 +69,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Choice) + with Inline; + pragma Inline (Chosen); pragma Inline (Chosen_Index); diff --git a/src/fltk-widgets-menus-menu_bars.adb b/src/fltk-widgets-menus-menu_bars.adb index 52279cd..3840f2e 100644 --- a/src/fltk-widgets-menus-menu_bars.adb +++ b/src/fltk-widgets-menus-menu_bars.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Menus.Menu_Bars is + procedure Extra_Final + (This : in out Menu_Bar) is + begin + Extra_Final (Menu (This)); + end Extra_Final; + + procedure Finalize (This : in out Menu_Bar) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Menu_Bar'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_menu_bar (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Menu (This)); end Finalize; diff --git a/src/fltk-widgets-menus-menu_bars.ads b/src/fltk-widgets-menus-menu_bars.ads index aa856eb..2071bff 100644 --- a/src/fltk-widgets-menus-menu_bars.ads +++ b/src/fltk-widgets-menus-menu_bars.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Menu_Bar) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb index 2d6f305..51c35f8 100644 --- a/src/fltk-widgets-menus-menu_buttons.adb +++ b/src/fltk-widgets-menus-menu_buttons.adb @@ -76,18 +76,20 @@ package body FLTK.Widgets.Menus.Menu_Buttons is + procedure Extra_Final + (This : in out Menu_Button) is + begin + Extra_Final (Menu (This)); + end Extra_Final; + + procedure Finalize (This : in out Menu_Button) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Menu_Button'Class - then - if This.Needs_Dealloc then - free_fl_menu_button (This.Void_Ptr); - end if; - This.Void_Ptr := Null_Pointer; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_menu_button (This.Void_Ptr); end if; - Finalize (Menu (This)); end Finalize; diff --git a/src/fltk-widgets-menus-menu_buttons.ads b/src/fltk-widgets-menus-menu_buttons.ads index e520484..e71310f 100644 --- a/src/fltk-widgets-menus-menu_buttons.ads +++ b/src/fltk-widgets-menus-menu_buttons.ads @@ -69,6 +69,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Menu_Button) + with Inline; + pragma Inline (Set_Popup_Kind); pragma Inline (Popup); diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb index f35d53c..5bd67df 100644 --- a/src/fltk-widgets-menus.adb +++ b/src/fltk-widgets-menus.adb @@ -279,21 +279,23 @@ package body FLTK.Widgets.Menus is (Object => FLTK.Menu_Items.Menu_Item, Name => Item_Access); + procedure Extra_Final + (This : in out Menu) is + begin + for Item of This.My_Items loop + Free_Item (Item); + end loop; + Extra_Final (Widget (This)); + end Extra_Final; procedure Finalize (This : in out Menu) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Menu'Class - then - for Item of This.My_Items loop - Free_Item (Item); - end loop; + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_menu (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads index bc72bef..c0e0ed4 100644 --- a/src/fltk-widgets-menus.ads +++ b/src/fltk-widgets-menus.ads @@ -262,6 +262,9 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Menu); + procedure Item_Hook (M, U : in Storage.Integer_Address); pragma Convention (C, Item_Hook); diff --git a/src/fltk-widgets-progress_bars.adb b/src/fltk-widgets-progress_bars.adb index 2c36a12..9b1301f 100644 --- a/src/fltk-widgets-progress_bars.adb +++ b/src/fltk-widgets-progress_bars.adb @@ -94,16 +94,20 @@ package body FLTK.Widgets.Progress_Bars is + procedure Extra_Final + (This : in out Progress_Bar) is + begin + Extra_Final (Widget (This)); + end Extra_Final; + + procedure Finalize (This : in out Progress_Bar) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Progress_Bar'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_progress (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-progress_bars.ads b/src/fltk-widgets-progress_bars.ads index 0476f8a..2eb57f3 100644 --- a/src/fltk-widgets-progress_bars.ads +++ b/src/fltk-widgets-progress_bars.ads @@ -77,6 +77,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Progress_Bar) + with Inline; + pragma Inline (Get_Minimum); pragma Inline (Set_Minimum); diff --git a/src/fltk-widgets-valuators-adjusters.adb b/src/fltk-widgets-valuators-adjusters.adb index 0a1e4c5..9d12b12 100644 --- a/src/fltk-widgets-valuators-adjusters.adb +++ b/src/fltk-widgets-valuators-adjusters.adb @@ -74,16 +74,20 @@ package body FLTK.Widgets.Valuators.Adjusters is + procedure Extra_Final + (This : in out Adjuster) is + begin + Extra_Final (Valuator (This)); + end Extra_Final; + + procedure Finalize (This : in out Adjuster) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Adjuster'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_adjuster (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Valuator (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-adjusters.ads b/src/fltk-widgets-valuators-adjusters.ads index 635571c..df19f28 100644 --- a/src/fltk-widgets-valuators-adjusters.ads +++ b/src/fltk-widgets-valuators-adjusters.ads @@ -61,6 +61,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Adjuster) + with Inline; + pragma Inline (Is_Soft); pragma Inline (Set_Soft); diff --git a/src/fltk-widgets-valuators-counters-simple.adb b/src/fltk-widgets-valuators-counters-simple.adb index 05a9eba..b7a35a2 100644 --- a/src/fltk-widgets-valuators-counters-simple.adb +++ b/src/fltk-widgets-valuators-counters-simple.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Valuators.Counters.Simple is + procedure Extra_Final + (This : in out Simple_Counter) is + begin + Extra_Final (Counter (This)); + end Extra_Final; + + procedure Finalize (This : in out Simple_Counter) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Simple_Counter'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_simple_counter (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Counter (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-counters-simple.ads b/src/fltk-widgets-valuators-counters-simple.ads index dffdff8..99e4bee 100644 --- a/src/fltk-widgets-valuators-counters-simple.ads +++ b/src/fltk-widgets-valuators-counters-simple.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Simple_Counter) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-counters.adb b/src/fltk-widgets-valuators-counters.adb index a31e389..a8cb10a 100644 --- a/src/fltk-widgets-valuators-counters.adb +++ b/src/fltk-widgets-valuators-counters.adb @@ -115,16 +115,20 @@ package body FLTK.Widgets.Valuators.Counters is + procedure Extra_Final + (This : in out Counter) is + begin + Extra_Final (Valuator (This)); + end Extra_Final; + + procedure Finalize (This : in out Counter) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Counter'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_counter (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Valuator (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-counters.ads b/src/fltk-widgets-valuators-counters.ads index 1ba4f5e..7119923 100644 --- a/src/fltk-widgets-valuators-counters.ads +++ b/src/fltk-widgets-valuators-counters.ads @@ -100,6 +100,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Counter) + with Inline; + pragma Inline (Get_Step); pragma Inline (Set_Step); diff --git a/src/fltk-widgets-valuators-dials-fill.adb b/src/fltk-widgets-valuators-dials-fill.adb index aa55025..b83d329 100644 --- a/src/fltk-widgets-valuators-dials-fill.adb +++ b/src/fltk-widgets-valuators-dials-fill.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Valuators.Dials.Fill is + procedure Extra_Final + (This : in out Fill_Dial) is + begin + Extra_Final (Dial (This)); + end Extra_Final; + + procedure Finalize (This : in out Fill_Dial) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Fill_Dial'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_fill_dial (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Dial (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-dials-fill.ads b/src/fltk-widgets-valuators-dials-fill.ads index a029c13..c1f6f06 100644 --- a/src/fltk-widgets-valuators-dials-fill.ads +++ b/src/fltk-widgets-valuators-dials-fill.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Fill_Dial) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-dials-line.adb b/src/fltk-widgets-valuators-dials-line.adb index 01e8c44..a02d1b8 100644 --- a/src/fltk-widgets-valuators-dials-line.adb +++ b/src/fltk-widgets-valuators-dials-line.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Valuators.Dials.Line is + procedure Extra_Final + (This : in out Line_Dial) is + begin + Extra_Final (Dial (This)); + end Extra_Final; + + procedure Finalize (This : in out Line_Dial) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Line_Dial'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_line_dial (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Dial (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-dials-line.ads b/src/fltk-widgets-valuators-dials-line.ads index ac23efa..d0a955d 100644 --- a/src/fltk-widgets-valuators-dials-line.ads +++ b/src/fltk-widgets-valuators-dials-line.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Line_Dial) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-dials.adb b/src/fltk-widgets-valuators-dials.adb index f3cdf87..a796a8c 100644 --- a/src/fltk-widgets-valuators-dials.adb +++ b/src/fltk-widgets-valuators-dials.adb @@ -103,16 +103,20 @@ package body FLTK.Widgets.Valuators.Dials is + procedure Extra_Final + (This : in out Dial) is + begin + Extra_Final (Valuator (This)); + end Extra_Final; + + procedure Finalize (This : in out Dial) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Dial'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_dial (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Valuator (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-dials.ads b/src/fltk-widgets-valuators-dials.ads index cc149a7..9cd4d49 100644 --- a/src/fltk-widgets-valuators-dials.ads +++ b/src/fltk-widgets-valuators-dials.ads @@ -90,6 +90,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Dial) + with Inline; + pragma Inline (Get_Dial_Type); diff --git a/src/fltk-widgets-valuators-rollers.adb b/src/fltk-widgets-valuators-rollers.adb index d8f68e7..69e0f39 100644 --- a/src/fltk-widgets-valuators-rollers.adb +++ b/src/fltk-widgets-valuators-rollers.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Valuators.Rollers is + procedure Extra_Final + (This : in out Roller) is + begin + Extra_Final (Valuator (This)); + end Extra_Final; + + procedure Finalize (This : in out Roller) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Roller'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_roller (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Valuator (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-rollers.ads b/src/fltk-widgets-valuators-rollers.ads index 44dff6a..266072f 100644 --- a/src/fltk-widgets-valuators-rollers.ads +++ b/src/fltk-widgets-valuators-rollers.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Roller) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-sliders-fill.adb b/src/fltk-widgets-valuators-sliders-fill.adb index eb2d7dc..6d88d56 100644 --- a/src/fltk-widgets-valuators-sliders-fill.adb +++ b/src/fltk-widgets-valuators-sliders-fill.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Valuators.Sliders.Fill is + procedure Extra_Final + (This : in out Fill_Slider) is + begin + Extra_Final (Slider (This)); + end Extra_Final; + + procedure Finalize (This : in out Fill_Slider) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Fill_Slider'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_fill_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Slider (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-sliders-fill.ads b/src/fltk-widgets-valuators-sliders-fill.ads index 48e5475..27c69b2 100644 --- a/src/fltk-widgets-valuators-sliders-fill.ads +++ b/src/fltk-widgets-valuators-sliders-fill.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Fill_Slider) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-sliders-hor_fill.adb b/src/fltk-widgets-valuators-sliders-hor_fill.adb index 953adaf..c35d10a 100644 --- a/src/fltk-widgets-valuators-sliders-hor_fill.adb +++ b/src/fltk-widgets-valuators-sliders-hor_fill.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Fill is + procedure Extra_Final + (This : in out Hor_Fill_Slider) is + begin + Extra_Final (Slider (This)); + end Extra_Final; + + procedure Finalize (This : in out Hor_Fill_Slider) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Hor_Fill_Slider'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_hor_fill_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Slider (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-sliders-hor_fill.ads b/src/fltk-widgets-valuators-sliders-hor_fill.ads index ec28cd4..b4142c3 100644 --- a/src/fltk-widgets-valuators-sliders-hor_fill.ads +++ b/src/fltk-widgets-valuators-sliders-hor_fill.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Hor_Fill_Slider) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-sliders-hor_nice.adb b/src/fltk-widgets-valuators-sliders-hor_nice.adb index ec84990..d280df4 100644 --- a/src/fltk-widgets-valuators-sliders-hor_nice.adb +++ b/src/fltk-widgets-valuators-sliders-hor_nice.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Nice is + procedure Extra_Final + (This : in out Hor_Nice_Slider) is + begin + Extra_Final (Slider (This)); + end Extra_Final; + + procedure Finalize (This : in out Hor_Nice_Slider) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Hor_Nice_Slider'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_hor_nice_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Slider (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-sliders-hor_nice.ads b/src/fltk-widgets-valuators-sliders-hor_nice.ads index 54cfa36..9ebb06b 100644 --- a/src/fltk-widgets-valuators-sliders-hor_nice.ads +++ b/src/fltk-widgets-valuators-sliders-hor_nice.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Hor_Nice_Slider) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-sliders-horizontal.adb b/src/fltk-widgets-valuators-sliders-horizontal.adb index 9d8797a..302b620 100644 --- a/src/fltk-widgets-valuators-sliders-horizontal.adb +++ b/src/fltk-widgets-valuators-sliders-horizontal.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Valuators.Sliders.Horizontal is + procedure Extra_Final + (This : in out Horizontal_Slider) is + begin + Extra_Final (Slider (This)); + end Extra_Final; + + procedure Finalize (This : in out Horizontal_Slider) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Horizontal_Slider'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_horizontal_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Slider (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-sliders-horizontal.ads b/src/fltk-widgets-valuators-sliders-horizontal.ads index 82cf222..c6cc2e6 100644 --- a/src/fltk-widgets-valuators-sliders-horizontal.ads +++ b/src/fltk-widgets-valuators-sliders-horizontal.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Horizontal_Slider) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-sliders-nice.adb b/src/fltk-widgets-valuators-sliders-nice.adb index f032c22..7fef1e8 100644 --- a/src/fltk-widgets-valuators-sliders-nice.adb +++ b/src/fltk-widgets-valuators-sliders-nice.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Valuators.Sliders.Nice is + procedure Extra_Final + (This : in out Nice_Slider) is + begin + Extra_Final (Slider (This)); + end Extra_Final; + + procedure Finalize (This : in out Nice_Slider) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Nice_Slider'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_nice_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Slider (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-sliders-nice.ads b/src/fltk-widgets-valuators-sliders-nice.ads index 60354e6..742f1ce 100644 --- a/src/fltk-widgets-valuators-sliders-nice.ads +++ b/src/fltk-widgets-valuators-sliders-nice.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Nice_Slider) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-sliders-scrollbars.adb b/src/fltk-widgets-valuators-sliders-scrollbars.adb index 4342a98..e950e93 100644 --- a/src/fltk-widgets-valuators-sliders-scrollbars.adb +++ b/src/fltk-widgets-valuators-sliders-scrollbars.adb @@ -88,16 +88,20 @@ package body FLTK.Widgets.Valuators.Sliders.Scrollbars is + procedure Extra_Final + (This : in out Scrollbar) is + begin + Extra_Final (Slider (This)); + end Extra_Final; + + procedure Finalize (This : in out Scrollbar) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Scrollbar'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_scrollbar (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Slider (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-sliders-scrollbars.ads b/src/fltk-widgets-valuators-sliders-scrollbars.ads index 42d84b9..5a87e86 100644 --- a/src/fltk-widgets-valuators-sliders-scrollbars.ads +++ b/src/fltk-widgets-valuators-sliders-scrollbars.ads @@ -76,6 +76,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Scrollbar) + with Inline; + pragma Inline (Get_Line_Size); pragma Inline (Set_Line_Size); diff --git a/src/fltk-widgets-valuators-sliders-value-horizontal.adb b/src/fltk-widgets-valuators-sliders-value-horizontal.adb index 7aeb803..0b4d1e9 100644 --- a/src/fltk-widgets-valuators-sliders-value-horizontal.adb +++ b/src/fltk-widgets-valuators-sliders-value-horizontal.adb @@ -55,16 +55,20 @@ package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is + procedure Extra_Final + (This : in out Hor_Value_Slider) is + begin + Extra_Final (Value_Slider (This)); + end Extra_Final; + + procedure Finalize (This : in out Hor_Value_Slider) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Hor_Value_Slider'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_hor_value_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Value_Slider (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-sliders-value-horizontal.ads b/src/fltk-widgets-valuators-sliders-value-horizontal.ads index fdea4b5..911d2e0 100644 --- a/src/fltk-widgets-valuators-sliders-value-horizontal.ads +++ b/src/fltk-widgets-valuators-sliders-value-horizontal.ads @@ -50,6 +50,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Hor_Value_Slider) + with Inline; + pragma Inline (Draw); pragma Inline (Handle); diff --git a/src/fltk-widgets-valuators-sliders-value.adb b/src/fltk-widgets-valuators-sliders-value.adb index f6c1902..878f498 100644 --- a/src/fltk-widgets-valuators-sliders-value.adb +++ b/src/fltk-widgets-valuators-sliders-value.adb @@ -94,16 +94,20 @@ package body FLTK.Widgets.Valuators.Sliders.Value is + procedure Extra_Final + (This : in out Value_Slider) is + begin + Extra_Final (Slider (This)); + end Extra_Final; + + procedure Finalize (This : in out Value_Slider) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Value_Slider'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_value_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Slider (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-sliders-value.ads b/src/fltk-widgets-valuators-sliders-value.ads index 5e48bbf..4a2e461 100644 --- a/src/fltk-widgets-valuators-sliders-value.ads +++ b/src/fltk-widgets-valuators-sliders-value.ads @@ -77,6 +77,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Value_Slider) + with Inline; + pragma Inline (Get_Text_Color); pragma Inline (Set_Text_Color); diff --git a/src/fltk-widgets-valuators-sliders.adb b/src/fltk-widgets-valuators-sliders.adb index a5674f0..793fffb 100644 --- a/src/fltk-widgets-valuators-sliders.adb +++ b/src/fltk-widgets-valuators-sliders.adb @@ -110,16 +110,20 @@ package body FLTK.Widgets.Valuators.Sliders is + procedure Extra_Final + (This : in out Slider) is + begin + Extra_Final (Valuator (This)); + end Extra_Final; + + procedure Finalize (This : in out Slider) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Slider'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_slider (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Valuator (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-sliders.ads b/src/fltk-widgets-valuators-sliders.ads index a1d52db..cbe7222 100644 --- a/src/fltk-widgets-valuators-sliders.ads +++ b/src/fltk-widgets-valuators-sliders.ads @@ -100,6 +100,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Slider) + with Inline; + pragma Inline (Get_Slider_Type); pragma Inline (Set_Bounds); diff --git a/src/fltk-widgets-valuators-value_inputs.adb b/src/fltk-widgets-valuators-value_inputs.adb index 4897013..8513680 100644 --- a/src/fltk-widgets-valuators-value_inputs.adb +++ b/src/fltk-widgets-valuators-value_inputs.adb @@ -152,16 +152,20 @@ package body FLTK.Widgets.Valuators.Value_Inputs is + procedure Extra_Final + (This : in out Value_Input) is + begin + Extra_Final (Valuator (This)); + end Extra_Final; + + procedure Finalize (This : in out Value_Input) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Value_Input'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_value_input (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Valuator (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-value_inputs.ads b/src/fltk-widgets-valuators-value_inputs.ads index 8c45026..861086b 100644 --- a/src/fltk-widgets-valuators-value_inputs.ads +++ b/src/fltk-widgets-valuators-value_inputs.ads @@ -123,6 +123,10 @@ private X, Y, W, H : in Integer; Text : in String); + procedure Extra_Final + (This : in out Value_Input) + with Inline; + pragma Inline (Input); diff --git a/src/fltk-widgets-valuators-value_outputs.adb b/src/fltk-widgets-valuators-value_outputs.adb index 970d7e1..e677850 100644 --- a/src/fltk-widgets-valuators-value_outputs.adb +++ b/src/fltk-widgets-valuators-value_outputs.adb @@ -113,16 +113,20 @@ package body FLTK.Widgets.Valuators.Value_Outputs is + procedure Extra_Final + (This : in out Value_Output) is + begin + Extra_Final (Valuator (This)); + end Extra_Final; + + procedure Finalize (This : in out Value_Output) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Value_Output'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_value_output (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Valuator (This)); end Finalize; diff --git a/src/fltk-widgets-valuators-value_outputs.ads b/src/fltk-widgets-valuators-value_outputs.ads index 1220a79..099743b 100644 --- a/src/fltk-widgets-valuators-value_outputs.ads +++ b/src/fltk-widgets-valuators-value_outputs.ads @@ -88,6 +88,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Value_Output) + with Inline; + pragma Inline (Is_Soft); pragma Inline (Set_Soft); diff --git a/src/fltk-widgets-valuators.adb b/src/fltk-widgets-valuators.adb index d20faef..e2f87ee 100644 --- a/src/fltk-widgets-valuators.adb +++ b/src/fltk-widgets-valuators.adb @@ -144,16 +144,20 @@ package body FLTK.Widgets.Valuators is + procedure Extra_Final + (This : in out Valuator) is + begin + Extra_Final (Widget (This)); + end Extra_Final; + + procedure Finalize (This : in out Valuator) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Valuator'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_valuator (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; - Finalize (Widget (This)); end Finalize; diff --git a/src/fltk-widgets-valuators.ads b/src/fltk-widgets-valuators.ads index 6d12cd0..ccf2a49 100644 --- a/src/fltk-widgets-valuators.ads +++ b/src/fltk-widgets-valuators.ads @@ -113,6 +113,10 @@ private Text : in String) with Inline; + procedure Extra_Final + (This : in out Valuator) + with Inline; + pragma Inline (Clamp); pragma Inline (Round); diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb index 31fc6b5..e9bf587 100644 --- a/src/fltk-widgets.adb +++ b/src/fltk-widgets.adb @@ -501,14 +501,19 @@ package body FLTK.Widgets is + procedure Extra_Final + (This : in out Widget) is + begin + null; + end Extra_Final; + + procedure Finalize (This : in out Widget) is begin - if This.Void_Ptr /= Null_Pointer and then - This in Widget'Class - then + Extra_Final (This); + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then free_fl_widget (This.Void_Ptr); - This.Void_Ptr := Null_Pointer; end if; end Finalize; diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads index e0ab7a3..f37870d 100644 --- a/src/fltk-widgets.ads +++ b/src/fltk-widgets.ads @@ -361,11 +361,24 @@ private overriding procedure Finalize (This : in out Widget); + -- Widgets that might cause problems for this setup in the future: + -- Valuators.Value_Inputs (has an internal Input) + -- Menus (gets various Menu_Items added to it) + -- Groups.Text_Displays (gets a Text_Buffer attached) + -- Groups.Text_Displays.Text_Editors (also gets a Text_Buffer attached) + -- Groups.Input_Choices (has an internal Input and Menu_Button) + -- Groups.Browsers (has two internal Scrollbars) + -- If weird Init/Final errors start mysteriously occuring then check there first. + procedure Extra_Init (This : in out Widget; X, Y, W, H : in Integer; Text : in String); + procedure Extra_Final + (This : in out Widget) + with Inline; + diff --git a/src/fltk.ads b/src/fltk.ads index e686934..e0ebf1c 100644 --- a/src/fltk.ads +++ b/src/fltk.ads @@ -399,8 +399,8 @@ private -- a mess, really just all sorts of problems. type Wrapper is new Ada.Finalization.Limited_Controlled with record - Void_Ptr : Storage.Integer_Address; - Needs_Dealloc : Boolean := True; + Void_Ptr : Storage.Integer_Address := Null_Pointer; + Needs_Dealloc : Boolean := True; end record; overriding procedure Initialize |