From b709843ae66a4348746d6a54114c99dd00ebdb74 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Mon, 19 Sep 2016 18:48:47 +1000 Subject: All File/Edit functions working, just need to add Search/About menu stuff --- src/adapad.adb | 199 +++++++++++++++------ src/editors.adb | 11 +- src/editors.ads | 19 +- src/fltk_binding/c_fl_double_window.cpp | 5 + src/fltk_binding/c_fl_double_window.h | 1 + src/fltk_binding/c_fl_popup.cpp | 32 ++++ src/fltk_binding/c_fl_popup.h | 15 ++ src/fltk_binding/c_fl_text_buffer.cpp | 35 ++++ src/fltk_binding/c_fl_text_buffer.h | 7 + src/fltk_binding/c_fl_text_editor.cpp | 13 +- src/fltk_binding/c_fl_text_editor.h | 9 +- src/fltk_binding/c_fl_window.cpp | 10 ++ src/fltk_binding/c_fl_window.h | 2 + src/fltk_binding/fltk-popups.adb | 113 ++++++++++++ src/fltk_binding/fltk-popups.ads | 32 ++++ src/fltk_binding/fltk-text_buffers.adb | 123 ++++++++++++- src/fltk_binding/fltk-text_buffers.ads | 34 +++- ...k-widgets-groups-text_displays-text_editors.adb | 13 ++ ...k-widgets-groups-text_displays-text_editors.ads | 4 + .../fltk-widgets-groups-windows-double.adb | 13 ++ .../fltk-widgets-groups-windows-double.ads | 4 + src/fltk_binding/fltk-widgets-groups-windows.adb | 28 +++ src/fltk_binding/fltk-widgets-groups-windows.ads | 9 + 23 files changed, 653 insertions(+), 78 deletions(-) create mode 100644 src/fltk_binding/c_fl_popup.cpp create mode 100644 src/fltk_binding/c_fl_popup.h create mode 100644 src/fltk_binding/fltk-popups.adb create mode 100644 src/fltk_binding/fltk-popups.ads diff --git a/src/adapad.adb b/src/adapad.adb index f1425f9..5dc36ca 100644 --- a/src/adapad.adb +++ b/src/adapad.adb @@ -9,6 +9,10 @@ with FLTK.Widgets; use FLTK.Widgets; with FLTK.Widgets.Menus; use FLTK.Widgets.Menus; +with FLTK.Popups; +use FLTK.Popups; +with Ada.Strings.Unbounded; +use Ada.Strings.Unbounded; with Ada.Text_IO; @@ -17,9 +21,22 @@ with Ada.Text_IO; function AdaPad return Integer is - Pad : aliased Editor_Window := Create (0, 0, 640, 400, "AdaPad"); + Pad : aliased Editor_Window := Create (0, 0, 640, 400, "(Untitled)"); Buff : aliased Text_Buffer := Create; + -- these globals make me feel dirty + -- like they should be in the buffer class or something + Changed : Boolean := False; + Filename : Unbounded_String := To_Unbounded_String (0); + + + + + procedure Set_Title (Editor : access Editor_Window); + function Cancel_Save_Discard return Choice; + procedure Load_File (Buffer : access Text_Buffer; Name : in String); + procedure Save_File (Buffer : access Text_Buffer; Name : in String); + @@ -32,57 +49,83 @@ function AdaPad return Integer is - type New_Callback is new Editor_Callback with null record; - New_CB : aliased New_Callback; - + type Save_As_Callback is new Editor_Callback with null record; + Save_As_CB : aliased Save_As_Callback; overriding procedure Call - (This : in New_Callback; + (This : in Save_As_Callback; Item : in out Widget'Class) is + + New_Filename : String := File_Chooser + ("Save File As?", "*", To_String (Filename)); + begin - Ada.Text_IO.Put_Line ("New callback executed."); + if New_Filename /= "" then + Save_File (This.Buffer, New_Filename); + end if; end Call; - type Open_Callback is new Editor_Callback with null record; - Open_CB : aliased Open_Callback; - + type Save_Callback is new Editor_Callback with null record; + Save_CB : aliased Save_Callback; overriding procedure Call - (This : in Open_Callback; + (This : in Save_Callback; Item : in out Widget'Class) is begin - Ada.Text_IO.Put_Line ("Open callback executed."); + if Filename = "" then + Save_As_CB.Call (Item); + else + Save_File (This.Buffer, To_String (Filename)); + end if; end Call; - type Save_Callback is new Editor_Callback with null record; - Save_CB : aliased Save_Callback; - + type New_Callback is new Editor_Callback with null record; + New_CB : aliased New_Callback; overriding procedure Call - (This : in Save_Callback; + (This : in New_Callback; Item : in out Widget'Class) is begin - Ada.Text_IO.Put_Line ("Save callback executed."); + case Cancel_Save_Discard is + when First => return; + when Second => Save_CB.Call (Item); + when Third => null; + end case; + Filename := To_Unbounded_String (0); + This.Buffer.Set_Selection (0, This.Buffer.Length); + This.Buffer.Remove_Selected_Text; + Changed := False; + This.Buffer.Call_Modify_Callbacks; end Call; - type Save_As_Callback is new Editor_Callback with null record; - Save_As_CB : aliased Save_As_Callback; - + type Open_Callback is new Editor_Callback with null record; + Open_CB : aliased Open_Callback; overriding procedure Call - (This : in Save_As_Callback; + (This : in Open_Callback; Item : in out Widget'Class) is begin - Ada.Text_IO.Put_Line ("Save As callback executed."); + case Cancel_Save_Discard is + when First => return; + when Second => Save_CB.Call (Item); + when Third => null; + end case; + declare + New_Filename : String := File_Chooser ("Open File?", "*", To_String (Filename)); + begin + if New_Filename /= "" then + Load_File (This.Buffer, New_Filename); + end if; + end; end Call; @@ -91,12 +134,16 @@ function AdaPad return Integer is type Quit_Callback is new Editor_Callback with null record; Quit_CB : aliased Quit_Callback; - overriding procedure Call (This : in Quit_Callback; Item : in out Widget'Class) is begin - Ada.Text_IO.Put_Line ("Quit callback executed."); + case Cancel_Save_Discard is + when First => return; + when Second => Save_CB.Call (Item); + when Third => null; + end case; + This.Editor.Hide; end Call; @@ -105,12 +152,11 @@ function AdaPad return Integer is type Undo_Callback is new Editor_Callback with null record; Undo_CB : aliased Undo_Callback; - overriding procedure Call (This : in Undo_Callback; Item : in out Widget'Class) is begin - Ada.Text_IO.Put_Line ("Undo callback executed."); + This.Editor.Undo; end Call; @@ -119,7 +165,6 @@ function AdaPad return Integer is type Cut_Callback is new Editor_Callback with null record; Cut_CB : aliased Cut_Callback; - overriding procedure Call (This : in Cut_Callback; Item : in out Widget'Class) is @@ -133,7 +178,6 @@ function AdaPad return Integer is type Copy_Callback is new Editor_Callback with null record; Copy_CB : aliased Copy_Callback; - overriding procedure Call (This : in Copy_Callback; Item : in out Widget'Class) is @@ -147,7 +191,6 @@ function AdaPad return Integer is type Paste_Callback is new Editor_Callback with null record; Paste_CB : aliased Paste_Callback; - overriding procedure Call (This : in Paste_Callback; Item : in out Widget'Class) is @@ -161,7 +204,6 @@ function AdaPad return Integer is type Delete_Callback is new Editor_Callback with null record; Delete_CB : aliased Delete_Callback; - overriding procedure Call (This : in Delete_Callback; Item : in out Widget'Class) is @@ -175,7 +217,6 @@ function AdaPad return Integer is type Find_Callback is new Editor_Callback with null record; Find_CB : aliased Find_Callback; - overriding procedure Call (This : in Find_Callback; Item : in out Widget'Class) is @@ -189,7 +230,6 @@ function AdaPad return Integer is type Replace_Callback is new Editor_Callback with null record; Replace_CB : aliased Replace_Callback; - overriding procedure Call (This : in Replace_Callback; Item : in out Widget'Class) is @@ -203,7 +243,6 @@ function AdaPad return Integer is type About_Callback is new Editor_Callback with null record; About_CB : aliased About_Callback; - overriding procedure Call (This : in About_Callback; Item : in out Widget'Class) is @@ -214,10 +253,12 @@ function AdaPad return Integer is - type Mod_Callback is new Modify_Callback with null record; + type Mod_Callback is new Modify_Callback with + record + Editor : access Editor_Window := Pad'Access; + end record; Mod_CB : aliased Mod_Callback; - overriding procedure Call (This : in Mod_Callback; Action : in Modification; @@ -225,61 +266,113 @@ function AdaPad return Integer is Length : in Natural; Deleted_Text : in String) is begin - Ada.Text_IO.Put_Line ("Modify of Type: " & Modification'Image (Action) & - " Place: " & Position'Image (Place) & - " Length: " & Integer'Image (Length)); + if Action = Insert or Action = Delete then + Changed := True; + end if; + Set_Title (This.Editor); end Call; - type Pre_Callback is new Predelete_Callback with null record; - Pre_CB : aliased Pre_Callback; + procedure Set_Title + (Editor : access Editor_Window) is + Title : Unbounded_String := To_Unbounded_String (0); - overriding procedure Call - (This : in Pre_Callback; - Place : in Position; - Length : in Natural) is begin - Ada.Text_IO.Put_Line ("Predelete at Place: " & Position'Image (Place) & - " Length: " & Integer'Image (Length)); - end Call; + if Changed then + Append (Title, "*"); + end if; + if Filename = "" then + Append (Title, "(Untitled)"); + else + Append (Title, Filename); + end if; -begin + Editor.Set_Label (To_String (Title)); + end Set_Title; - Buff.Add_Modify_Callback (Mod_CB'Access); - Buff.Add_Predelete_Callback (Pre_CB'Access); + + + function Cancel_Save_Discard + return Choice is + begin + if not Changed then + return Third; + else + return Three_Way_Choice + ("The current file has not been saved." & Character'Val (10) & + "Would you like to save it now?", + "Cancel", "Save", "Discard"); + end if; + end Cancel_Save_Discard; + + + + + procedure Load_File + (Buffer : access Text_Buffer; + Name : in String) is + begin + Buffer.Load_File (Name); + Filename := To_Unbounded_String (Name); + Changed := False; + Buffer.Call_Modify_Callbacks; + exception + when Storage_Error => + Alert ("Error reading from file " & Name); + end Load_File; + + + + + procedure Save_File + (Buffer : access Text_Buffer; + Name : in String) is + begin + Buffer.Save_File (Name); + Filename := To_Unbounded_String (Name); + Changed := False; + Buffer.Call_Modify_Callbacks; + exception + when Storage_Error => + Alert ("Error writing to file " & Name); + end Save_File; + + +begin declare Bar : Menu_Cursor := Pad.Get_Menu; begin - Bar.Add (Text => "&File", Shortcut => Mod_Alt + 'f', Flags => Flag_Submenu); + Bar.Add (Text => "&File", Flags => Flag_Submenu); Bar.Add ("File/&New", New_CB'Access, Mod_Ctrl + 'n'); Bar.Add ("File/&Open...", Open_CB'Access, Mod_Ctrl + 'o'); Bar.Add ("File/&Save", Save_CB'Access, Mod_Ctrl + 's'); Bar.Add ("File/Save &As...", Save_As_CB'Access, Mod_Shift + Mod_Ctrl + 's'); Bar.Add ("File/&Quit", Quit_CB'Access, Mod_Ctrl + 'q'); - Bar.Add (Text => "&Edit", Shortcut => Mod_Alt + 'e', Flags => Flag_Submenu); + Bar.Add (Text => "&Edit", Flags => Flag_Submenu); Bar.Add ("Edit/&Undo", Undo_CB'Access, Mod_Ctrl + 'z'); Bar.Add ("Edit/Cu&t", Cut_CB'Access, Mod_Ctrl + 'x'); Bar.Add ("Edit/&Copy", Copy_CB'Access, Mod_Ctrl + 'c'); Bar.Add ("Edit/&Paste", Paste_CB'Access, Mod_Ctrl + 'v'); Bar.Add ("Edit/&Delete", Delete_CB'Access); - Bar.Add (Text => "&Search", Shortcut => Mod_Alt + 's', Flags => Flag_Submenu); + Bar.Add (Text => "&Search", Flags => Flag_Submenu); Bar.Add ("Search/&Find...", Find_CB'Access, Mod_Ctrl + 'f'); Bar.Add ("Search/&Replace...", Replace_CB'Access, Mod_Ctrl + 'h'); - Bar.Add (Text => "&Help", Shortcut => Mod_Alt + 'h', Flags => Flag_Submenu); + Bar.Add (Text => "&Help", Flags => Flag_Submenu); Bar.Add ("Help/&About", About_CB'Access); end; + Buff.Add_Modify_Callback (Mod_CB'Access); Pad.Set_Buffer (Buff); Pad.Show; return FLTK.Run; diff --git a/src/editors.adb b/src/editors.adb index 42b89ed..74ae629 100644 --- a/src/editors.adb +++ b/src/editors.adb @@ -35,7 +35,7 @@ package body Editors is (W, H : in Integer) return Editor_Window is begin - return Create (0, 0, W, H, "AdaPad"); + return Create (0, 0, W, H, "(Untitled)"); end Create; @@ -71,6 +71,15 @@ package body Editors is + procedure Undo + (This : in out Editor_Window) is + begin + This.Editor.Undo; + end Undo; + + + + procedure Cut (This : in out Editor_Window) is begin diff --git a/src/editors.ads b/src/editors.ads index c3b6655..2d4f599 100644 --- a/src/editors.ads +++ b/src/editors.ads @@ -42,20 +42,11 @@ package Editors is return Menu_Cursor; - procedure Cut - (This : in out Editor_Window); - - - procedure Copy - (This : in out Editor_Window); - - - procedure Paste - (This : in out Editor_Window); - - - procedure Delete - (This : in out Editor_Window); + procedure Undo (This : in out Editor_Window); + procedure Cut (This : in out Editor_Window); + procedure Copy (This : in out Editor_Window); + procedure Paste (This : in out Editor_Window); + procedure Delete (This : in out Editor_Window); private diff --git a/src/fltk_binding/c_fl_double_window.cpp b/src/fltk_binding/c_fl_double_window.cpp index 67d0736..7f29af8 100644 --- a/src/fltk_binding/c_fl_double_window.cpp +++ b/src/fltk_binding/c_fl_double_window.cpp @@ -25,3 +25,8 @@ void fl_double_window_show(DOUBLEWINDOW d) { reinterpret_cast(d)->show(); } + +void fl_double_window_hide(DOUBLEWINDOW d) { + reinterpret_cast(d)->hide(); +} + diff --git a/src/fltk_binding/c_fl_double_window.h b/src/fltk_binding/c_fl_double_window.h index 81b136a..3be3588 100644 --- a/src/fltk_binding/c_fl_double_window.h +++ b/src/fltk_binding/c_fl_double_window.h @@ -12,6 +12,7 @@ extern "C" DOUBLEWINDOW new_fl_double_window2(int w, int h); extern "C" void free_fl_double_window(DOUBLEWINDOW d); extern "C" void fl_double_window_show(DOUBLEWINDOW d); +extern "C" void fl_double_window_hide(DOUBLEWINDOW d); #endif diff --git a/src/fltk_binding/c_fl_popup.cpp b/src/fltk_binding/c_fl_popup.cpp new file mode 100644 index 0000000..913ec51 --- /dev/null +++ b/src/fltk_binding/c_fl_popup.cpp @@ -0,0 +1,32 @@ + + +#include +#include +#include +#include "c_fl_popup.h" + + +void popup_fl_alert(const char * m) { + fl_alert(m); +} + + +int popup_fl_choice(const char * m, const char * a, const char * b, const char * c) { + return fl_choice(m, a, b, c); +} + + +char * popup_fl_file_chooser(const char * m, const char * p, const char * d, int r) { + return fl_file_chooser(m, p, d, r); +} + + +const char * popup_fl_input(const char * m, const char * d) { + return fl_input(m, d); +} + + +void popup_fl_message(const char * m) { + fl_message(m); +} + diff --git a/src/fltk_binding/c_fl_popup.h b/src/fltk_binding/c_fl_popup.h new file mode 100644 index 0000000..ff0f9ac --- /dev/null +++ b/src/fltk_binding/c_fl_popup.h @@ -0,0 +1,15 @@ + + +#ifndef FL_POPUP_GUARD +#define FL_POPUP_GUARD + + +extern "C" void popup_fl_alert(const char * m); +extern "C" int popup_fl_choice(const char * m, const char * a, const char * b, const char * c); +extern "C" char * popup_fl_file_chooser(const char * m, const char * p, const char * d, int r); +extern "C" const char * popup_fl_input(const char * m, const char * d); +extern "C" void popup_fl_message(const char * m); + + +#endif + diff --git a/src/fltk_binding/c_fl_text_buffer.cpp b/src/fltk_binding/c_fl_text_buffer.cpp index 0da63c2..089ca33 100644 --- a/src/fltk_binding/c_fl_text_buffer.cpp +++ b/src/fltk_binding/c_fl_text_buffer.cpp @@ -24,3 +24,38 @@ void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud) reinterpret_cast(tb)->add_predelete_callback(reinterpret_cast(cb), ud); } + +void fl_text_buffer_call_modify_callbacks(TEXTBUFFER tb) { + reinterpret_cast(tb)->call_modify_callbacks(); +} + + +void fl_text_buffer_call_predelete_callbacks(TEXTBUFFER tb) { + reinterpret_cast(tb)->call_predelete_callbacks(); +} + + +int fl_text_buffer_length(TEXTBUFFER tb) { + return reinterpret_cast(tb)->length(); +} + + +int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n) { + return reinterpret_cast(tb)->loadfile(n); +} + + +void fl_text_buffer_remove_selection(TEXTBUFFER tb) { + reinterpret_cast(tb)->remove_selection(); +} + + +int fl_text_buffer_savefile(TEXTBUFFER tb, char * n) { + return reinterpret_cast(tb)->savefile(n); +} + + +void fl_text_buffer_select(TEXTBUFFER tb, int s, int e) { + reinterpret_cast(tb)->select(s, e); +} + diff --git a/src/fltk_binding/c_fl_text_buffer.h b/src/fltk_binding/c_fl_text_buffer.h index 8c1483e..906ef8c 100644 --- a/src/fltk_binding/c_fl_text_buffer.h +++ b/src/fltk_binding/c_fl_text_buffer.h @@ -13,6 +13,13 @@ extern "C" void free_fl_text_buffer(TEXTBUFFER tb); extern "C" void fl_text_buffer_add_modify_callback(TEXTBUFFER tb, void * cb, void * ud); extern "C" void fl_text_buffer_add_predelete_callback(TEXTBUFFER tb, void * cb, void * ud); +extern "C" void fl_text_buffer_call_modify_callbacks(TEXTBUFFER tb); +extern "C" void fl_text_buffer_call_predelete_callbacks(TEXTBUFFER tb); +extern "C" int fl_text_buffer_length(TEXTBUFFER tb); +extern "C" int fl_text_buffer_loadfile(TEXTBUFFER tb, char * n); +extern "C" void fl_text_buffer_remove_selection(TEXTBUFFER tb); +extern "C" int fl_text_buffer_savefile(TEXTBUFFER tb, char * n); +extern "C" void fl_text_buffer_select(TEXTBUFFER tb, int s, int e); #endif diff --git a/src/fltk_binding/c_fl_text_editor.cpp b/src/fltk_binding/c_fl_text_editor.cpp index 6754695..1290e7b 100644 --- a/src/fltk_binding/c_fl_text_editor.cpp +++ b/src/fltk_binding/c_fl_text_editor.cpp @@ -17,22 +17,27 @@ void free_fl_text_editor(TEXTEDITOR te) { -void fl_text_editor_cut (TEXTEDITOR te) { +void fl_text_editor_undo(TEXTEDITOR te) { + Fl_Text_Editor::kf_undo(0, reinterpret_cast(te)); +} + + +void fl_text_editor_cut(TEXTEDITOR te) { Fl_Text_Editor::kf_cut(0, reinterpret_cast(te)); } -void fl_text_editor_copy (TEXTEDITOR te) { +void fl_text_editor_copy(TEXTEDITOR te) { Fl_Text_Editor::kf_copy(0, reinterpret_cast(te)); } -void fl_text_editor_paste (TEXTEDITOR te) { +void fl_text_editor_paste(TEXTEDITOR te) { Fl_Text_Editor::kf_paste(0, reinterpret_cast(te)); } -void fl_text_editor_delete (TEXTEDITOR te) { +void fl_text_editor_delete(TEXTEDITOR te) { Fl_Text_Editor::kf_delete(0, reinterpret_cast(te)); } diff --git a/src/fltk_binding/c_fl_text_editor.h b/src/fltk_binding/c_fl_text_editor.h index 7c7cee5..8c7dba0 100644 --- a/src/fltk_binding/c_fl_text_editor.h +++ b/src/fltk_binding/c_fl_text_editor.h @@ -11,10 +11,11 @@ extern "C" TEXTEDITOR new_fl_text_editor(int x, int y, int w, int h, char* label extern "C" void free_fl_text_editor(TEXTEDITOR te); -extern "C" void fl_text_editor_cut (TEXTEDITOR te); -extern "C" void fl_text_editor_copy (TEXTEDITOR te); -extern "C" void fl_text_editor_paste (TEXTEDITOR te); -extern "C" void fl_text_editor_delete (TEXTEDITOR te); +extern "C" void fl_text_editor_undo(TEXTEDITOR te); +extern "C" void fl_text_editor_cut(TEXTEDITOR te); +extern "C" void fl_text_editor_copy(TEXTEDITOR te); +extern "C" void fl_text_editor_paste(TEXTEDITOR te); +extern "C" void fl_text_editor_delete(TEXTEDITOR te); #endif diff --git a/src/fltk_binding/c_fl_window.cpp b/src/fltk_binding/c_fl_window.cpp index f409e34..5b2d0ff 100644 --- a/src/fltk_binding/c_fl_window.cpp +++ b/src/fltk_binding/c_fl_window.cpp @@ -25,3 +25,13 @@ void fl_window_show(WINDOW n) { reinterpret_cast(n)->show(); } + +void fl_window_hide(WINDOW n) { + reinterpret_cast(n)->hide(); +} + + +void fl_window_set_label(WINDOW n, char* text) { + reinterpret_cast(n)->copy_label(text); +} + diff --git a/src/fltk_binding/c_fl_window.h b/src/fltk_binding/c_fl_window.h index 658d3ef..8d38de0 100644 --- a/src/fltk_binding/c_fl_window.h +++ b/src/fltk_binding/c_fl_window.h @@ -12,6 +12,8 @@ extern "C" WINDOW new_fl_window2(int w, int h); extern "C" void free_fl_window(WINDOW n); extern "C" void fl_window_show(WINDOW n); +extern "C" void fl_window_hide(WINDOW n); +extern "C" void fl_window_set_label(WINDOW n, char* text); #endif diff --git a/src/fltk_binding/fltk-popups.adb b/src/fltk_binding/fltk-popups.adb new file mode 100644 index 0000000..40a8d3e --- /dev/null +++ b/src/fltk_binding/fltk-popups.adb @@ -0,0 +1,113 @@ + + +with Interfaces.C; +with Interfaces.C.Strings; +use type Interfaces.C.Strings.chars_ptr; + + +package body FLTK.Popups is + + + procedure popup_fl_alert + (M : in Interfaces.C.char_array); + pragma Import (C, popup_fl_alert, "popup_fl_alert"); + + function popup_fl_choice + (M, A, B, C : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, popup_fl_choice, "popup_fl_choice"); + + function popup_fl_file_chooser + (M, P, D : in Interfaces.C.char_array; + R : in Interfaces.C.int) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, popup_fl_file_chooser, "popup_fl_file_chooser"); + + function popup_fl_input + (M, D : in Interfaces.C.char_array) + return Interfaces.C.Strings.chars_ptr; + pragma Import (C, popup_fl_input, "popup_fl_input"); + + procedure popup_fl_message + (M : in Interfaces.C.char_array); + pragma Import (C, popup_fl_message, "popup_fl_message"); + + + + + procedure Alert + (Message : String) is + begin + popup_fl_alert (Interfaces.C.To_C (Message)); + end Alert; + + + + + function Three_Way_Choice + (Message, Button1, Button2, Button3 : in String) + return Choice is + + Result : Interfaces.C.int := popup_fl_choice + (Interfaces.C.To_C (Message), + Interfaces.C.To_C (Button1), + Interfaces.C.To_C (Button2), + Interfaces.C.To_C (Button3)); + + begin + return Choice'Val (Result); + end Three_Way_Choice; + + + + + function File_Chooser + (Message, Filter_Pattern, Default : in String; + Relative : in Boolean := False) + return String is + + Result : Interfaces.C.Strings.chars_ptr := popup_fl_file_chooser + (Interfaces.C.To_C (Message), + Interfaces.C.To_C (Filter_Pattern), + Interfaces.C.To_C (Default), + Boolean'Pos (Relative)); + + begin + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; + end File_Chooser; + + + + + function Text_Input + (Message, Default : in String) + return String is + + Result : Interfaces.C.Strings.chars_ptr := popup_fl_input + (Interfaces.C.To_C (Message), + Interfaces.C.To_C (Default)); + + begin + if Result = Interfaces.C.Strings.Null_Ptr then + return ""; + else + return Interfaces.C.Strings.Value (Result); + end if; + end Text_Input; + + + + + procedure Message_Box + (Message : in String) is + begin + popup_fl_message (Interfaces.C.To_C (Message)); + end Message_Box; + + +end FLTK.Popups; + diff --git a/src/fltk_binding/fltk-popups.ads b/src/fltk_binding/fltk-popups.ads new file mode 100644 index 0000000..bee5d99 --- /dev/null +++ b/src/fltk_binding/fltk-popups.ads @@ -0,0 +1,32 @@ + + +package FLTK.Popups is + + + procedure Alert + (Message : String); + + + type Choice is (First, Second, Third); + function Three_Way_Choice + (Message, Button1, Button2, Button3 : in String) + return Choice; + + + function File_Chooser + (Message, Filter_Pattern, Default : in String; + Relative : in Boolean := False) + return String; + + + function Text_Input + (Message, Default : in String) + return String; + + + procedure Message_Box + (Message : in String); + + +end FLTK.Popups; + diff --git a/src/fltk_binding/fltk-text_buffers.adb b/src/fltk_binding/fltk-text_buffers.adb index fa2a259..6a25399 100644 --- a/src/fltk_binding/fltk-text_buffers.adb +++ b/src/fltk_binding/fltk-text_buffers.adb @@ -36,6 +36,42 @@ package body FLTK.Text_Buffers is pragma Import (C, fl_text_buffer_add_predelete_callback, "fl_text_buffer_add_predelete_callback"); + procedure fl_text_buffer_call_modify_callbacks + (TB : in System.Address); + pragma Import (C, fl_text_buffer_call_modify_callbacks, + "fl_text_buffer_call_modify_callbacks"); + + procedure fl_text_buffer_call_predelete_callbacks + (TB : in System.Address); + pragma Import (C, fl_text_buffer_call_predelete_callbacks, + "fl_text_buffer_call_predelete_callbacks"); + + function fl_text_buffer_length + (TB : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_length, "fl_text_buffer_length"); + + function fl_text_buffer_loadfile + (TB : in System.Address; + N : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_loadfile, "fl_text_buffer_loadfile"); + + procedure fl_text_buffer_remove_selection + (TB : in System.Address); + pragma Import (C, fl_text_buffer_remove_selection, "fl_text_buffer_remove_selection"); + + function fl_text_buffer_savefile + (TB : in System.Address; + N : in Interfaces.C.char_array) + return Interfaces.C.int; + pragma Import (C, fl_text_buffer_savefile, "fl_text_buffer_savefile"); + + procedure fl_text_buffer_select + (TB : in System.Address; + S, E : in Interfaces.C.int); + pragma Import (C, fl_text_buffer_select, "fl_text_buffer_select"); + @@ -88,7 +124,8 @@ package body FLTK.Text_Buffers is Length := Natural (Restyled); Action := Restyle; else - raise Program_Error; + Length := 0; + Action := None; end if; for CB of Ada_Text_Buffer.Modify_CBs loop @@ -171,5 +208,89 @@ package body FLTK.Text_Buffers is end Add_Predelete_Callback; + + + procedure Call_Modify_Callbacks + (This : in out Text_Buffer) is + begin + fl_text_buffer_call_modify_callbacks (This.Void_Ptr); + end Call_Modify_Callbacks; + + + + + procedure Call_Predelete_Callbacks + (This : in out Text_Buffer) is + begin + fl_text_buffer_call_predelete_callbacks (This.Void_Ptr); + end Call_Predelete_Callbacks; + + + + + function Length + (This : in Text_Buffer) + return Natural is + begin + return Natural (fl_text_buffer_length (This.Void_Ptr)); + end Length; + + + + + procedure Load_File + (This : in Text_Buffer; + Name : in String) is + + Err_No : Interfaces.C.int := fl_text_buffer_loadfile + (This.Void_Ptr, + Interfaces.C.To_C (Name)); + + begin + if Err_No /= 0 then + raise Storage_Error; + end if; + end Load_File; + + + + + procedure Remove_Selected_Text + (This : in out Text_Buffer) is + begin + fl_text_buffer_remove_selection (This.Void_Ptr); + end Remove_Selected_Text; + + + + + procedure Save_File + (This : in Text_Buffer; + Name : in String) is + + Err_No : Interfaces.C.int := fl_text_buffer_savefile + (This.Void_Ptr, + Interfaces.C.To_C (Name)); + + begin + if Err_No /= 0 then + raise Storage_Error; + end if; + end Save_File; + + + + + procedure Set_Selection + (This : in out Text_Buffer; + Start, Finish : in Natural) is + begin + fl_text_buffer_select + (This.Void_Ptr, + Interfaces.C.int (Start), + Interfaces.C.int (Finish)); + end Set_Selection; + + end FLTK.Text_Buffers; diff --git a/src/fltk_binding/fltk-text_buffers.ads b/src/fltk_binding/fltk-text_buffers.ads index aa6a49f..eea9b73 100644 --- a/src/fltk_binding/fltk-text_buffers.ads +++ b/src/fltk_binding/fltk-text_buffers.ads @@ -15,7 +15,7 @@ package FLTK.Text_Buffers is type Position is new Natural; - type Modification is (Insert, Restyle, Delete); + type Modification is (Insert, Restyle, Delete, None); type Modify_Callback is interface; procedure Call (This : in Modify_Callback; @@ -48,6 +48,38 @@ package FLTK.Text_Buffers is Func : not null access Predelete_Callback'Class); + procedure Call_Modify_Callbacks + (This : in out Text_Buffer); + + + procedure Call_Predelete_Callbacks + (This : in out Text_Buffer); + + + function Length + (This : in Text_Buffer) + return Natural; + + + procedure Load_File + (This : in Text_Buffer; + Name : in String); + + + procedure Remove_Selected_Text + (This : in out Text_Buffer); + + + procedure Save_File + (This : in Text_Buffer; + Name : in String); + + + procedure Set_Selection + (This : in out Text_Buffer; + Start, Finish : in Natural); + + private diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.adb index 7969f27..ce7684c 100644 --- a/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.adb +++ b/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.adb @@ -18,6 +18,10 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is (TE : in System.Address); pragma Import (C, free_fl_text_editor, "free_fl_text_editor"); + procedure fl_text_editor_undo + (TE : in System.Address); + pragma Import (C, fl_text_editor_undo, "fl_text_editor_undo"); + procedure fl_text_editor_cut (TE : in System.Address); pragma Import (C, fl_text_editor_cut, "fl_text_editor_cut"); @@ -73,6 +77,15 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is + procedure Undo + (This : in out Text_Editor) is + begin + fl_text_editor_undo (This.Void_Ptr); + end Undo; + + + + procedure Cut (This : in out Text_Editor) is begin diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.ads b/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.ads index 37e5464..5e3ff01 100644 --- a/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.ads +++ b/src/fltk_binding/fltk-widgets-groups-text_displays-text_editors.ads @@ -12,6 +12,10 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is return Text_Editor; + procedure Undo + (This : in out Text_Editor); + + procedure Cut (This : in out Text_Editor); diff --git a/src/fltk_binding/fltk-widgets-groups-windows-double.adb b/src/fltk_binding/fltk-widgets-groups-windows-double.adb index a6a8a83..407c018 100644 --- a/src/fltk_binding/fltk-widgets-groups-windows-double.adb +++ b/src/fltk_binding/fltk-widgets-groups-windows-double.adb @@ -27,6 +27,10 @@ package body FLTK.Widgets.Groups.Windows.Double is (W : in System.Address); pragma Import (C, fl_double_window_show, "fl_double_window_show"); + procedure fl_double_window_hide + (W : in System.Address); + pragma Import (C, fl_double_window_hide, "fl_double_window_hide"); + @@ -91,5 +95,14 @@ package body FLTK.Widgets.Groups.Windows.Double is end Show; + + + procedure Hide + (This : in Double_Window) is + begin + fl_double_window_hide (This.Void_Ptr); + end Hide; + + end FLTK.Widgets.Groups.Windows.Double; diff --git a/src/fltk_binding/fltk-widgets-groups-windows-double.ads b/src/fltk_binding/fltk-widgets-groups-windows-double.ads index 20b5362..214f698 100644 --- a/src/fltk_binding/fltk-widgets-groups-windows-double.ads +++ b/src/fltk_binding/fltk-widgets-groups-windows-double.ads @@ -21,6 +21,10 @@ package FLTK.Widgets.Groups.Windows.Double is (This : in Double_Window); + procedure Hide + (This : in Double_Window); + + private diff --git a/src/fltk_binding/fltk-widgets-groups-windows.adb b/src/fltk_binding/fltk-widgets-groups-windows.adb index 1c29f9b..4ecda66 100644 --- a/src/fltk_binding/fltk-widgets-groups-windows.adb +++ b/src/fltk_binding/fltk-widgets-groups-windows.adb @@ -27,6 +27,15 @@ package body FLTK.Widgets.Groups.Windows is (W : in System.Address); pragma Import (C, fl_window_show, "fl_window_show"); + procedure fl_window_hide + (W : in System.Address); + pragma Import (C, fl_window_hide, "fl_window_hide"); + + procedure fl_window_set_label + (W : in System.Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_window_set_label, "fl_window_set_label"); + @@ -91,5 +100,24 @@ package body FLTK.Widgets.Groups.Windows is end Show; + + + procedure Hide + (This : in Window) is + begin + fl_window_hide (This.Void_Ptr); + end Hide; + + + + + procedure Set_Label + (This : in out Window; + Text : in String) is + begin + fl_window_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); + end Set_Label; + + end FLTK.Widgets.Groups.Windows; diff --git a/src/fltk_binding/fltk-widgets-groups-windows.ads b/src/fltk_binding/fltk-widgets-groups-windows.ads index 54d855f..0999b21 100644 --- a/src/fltk_binding/fltk-widgets-groups-windows.ads +++ b/src/fltk_binding/fltk-widgets-groups-windows.ads @@ -21,6 +21,15 @@ package FLTK.Widgets.Groups.Windows is (This : in Window); + procedure Hide + (This : in Window); + + + procedure Set_Label + (This : in out Window; + Text : in String); + + private -- cgit