path: root/src/adapad.adb

with FLTK;
with Editor_Windows;
use Editor_Windows;
with FLTK.Text_Buffers;
use FLTK.Text_Buffers;
with FLTK.Widgets;
use FLTK.Widgets;
with FLTK.Widgets.Menus;
use FLTK.Widgets.Menus;
with FLTK.Popups;
use FLTK.Popups;
with FLTK.Widgets.Groups.Windows;
use FLTK.Widgets.Groups.Windows;
with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;

with Ada.Text_IO;


function Adapad return Integer is


    --  forward declarations of helper functions

    procedure Set_Title;
    function Safe_To_Discard return Boolean;
    procedure Do_Save;
    procedure Do_Save_As;
    procedure Load_File (Name : in String);
    procedure Save_File (Name : in String);
    procedure Centre (Win : in out Window'Class);




    --  global state of the text editor

    Editor   : Editor_Window    := Create (800, 500);
    Buffer   : Text_Buffer      := Create;
    About    : About_Window     := Create;
    Find     : Find_Window      := Create;
    Replace  : Replace_Window   := Create;

    Changed  : Boolean          := False;
    Filename : Unbounded_String := To_Unbounded_String (0);




    --  callbacks for the menu

    type New_Callback is new Widget_Callback with null record;
    New_CB : aliased New_Callback;

    overriding procedure Call
           (This : in     New_Callback;
            Item : in out Widget'Class) is
    begin
        if not Safe_To_Discard then return; end if;
        Filename := To_Unbounded_String (0);
        Buffer.Set_Selection (0, Buffer.Length);
        Buffer.Remove_Selected_Text;
        Changed := False;
        Buffer.Call_Modify_Callbacks;
    end Call;




    type Open_Callback is new Widget_Callback with null record;
    Open_CB : aliased Open_Callback;

    overriding procedure Call
           (This : in     Open_Callback;
            Item : in out Widget'Class) is
    begin
        if not Safe_To_Discard then return; end if;
        declare
            New_Filename : String := File_Chooser ("Open File?", "*", To_String (Filename));
        begin
            if New_Filename /= "" then
                Load_File (New_Filename);
            end if;
        end;
    end Call;




    type Save_Callback is new Widget_Callback with null record;
    Save_CB : aliased Save_Callback;

    overriding procedure Call
           (This : in     Save_Callback;
            Item : in out Widget'Class) is
    begin
        Do_Save;
    end Call;




    type Save_As_Callback is new Widget_Callback with null record;
    Save_As_CB : aliased Save_As_Callback;

    overriding procedure Call
           (This : in     Save_As_Callback;
            Item : in out Widget'Class) is
    begin
        Do_Save_As;
    end Call;




    type Quit_Callback is new Widget_Callback with null record;
    Quit_CB : aliased Quit_Callback;

    overriding procedure Call
           (This : in     Quit_Callback;
            Item : in out Widget'Class) is
    begin
        if not Safe_To_Discard then return; end if;
        Find.Hide;
        Replace.Hide;
        About.Hide;
        Editor.Hide;
    end Call;




    type Undo_Callback is new Widget_Callback with null record;
    Undo_CB : aliased Undo_Callback;

    overriding procedure Call
           (This : in     Undo_Callback;
            Item : in out Widget'Class) is
    begin
        Editor.Undo;
    end Call;




    type Cut_Callback is new Widget_Callback with null record;
    Cut_CB : aliased Cut_Callback;

    overriding procedure Call
           (This : in     Cut_Callback;
            Item : in out Widget'Class) is
    begin
        Editor.Cut;
    end Call;




    type Copy_Callback is new Widget_Callback with null record;
    Copy_CB : aliased Copy_Callback;

    overriding procedure Call
           (This : in     Copy_Callback;
            Item : in out Widget'Class) is
    begin
        Editor.Copy;
    end Call;




    type Paste_Callback is new Widget_Callback with null record;
    Paste_CB : aliased Paste_Callback;

    overriding procedure Call
           (This : in     Paste_Callback;
            Item : in out Widget'Class) is
    begin
        Editor.Paste;
    end Call;




    type Delete_Callback is new Widget_Callback with null record;
    Delete_CB : aliased Delete_Callback;

    overriding procedure Call
           (This : in     Delete_Callback;
            Item : in out Widget'Class) is
    begin
        Editor.Delete;
    end Call;




    type Select_All_Callback is new Widget_Callback with null record;
    Select_All_CB : aliased Select_All_Callback;

    overriding procedure Call
           (This : in     Select_All_Callback;
            Item : in out Widget'Class) is
    begin
        Buffer.Set_Selection (0, Buffer.Length);
    end Call;




    type Find_Callback is new Widget_Callback with null record;
    Find_CB : aliased Find_Callback;

    overriding procedure Call
           (This : in     Find_Callback;
            Item : in out Widget'Class) is
    begin
        Centre (Find);
        Find.Show;
    end Call;




    type Replace_Callback is new Widget_Callback with null record;
    Replace_CB : aliased Replace_Callback;

    overriding procedure Call
           (This : in     Replace_Callback;
            Item : in out Widget'Class) is
    begin
        Centre (Replace);
        Replace.Show;
    end Call;




    type About_Callback is new Widget_Callback with null record;
    About_CB : aliased About_Callback;

    overriding procedure Call
           (This : in     About_Callback;
            Item : in out Widget'Class) is
    begin
        Centre (About);
        About.Show;
    end Call;




    --  callbacks for the text buffer

    type Mod_Callback is new Modify_Callback with null record;
    Mod_CB : aliased Mod_Callback;

    overriding procedure Call
           (This         : in Mod_Callback;
            Action       : in Modification;
            Place        : in Position;
            Length       : in Natural;
            Deleted_Text : in String) is
    begin
        if Action = Insert or Action = Delete then
            Changed := True;
        end if;
        Set_Title;
    end Call;




    --  callbacks for the find/replace windows

    type Do_Find_Callback is new Editor_Windows.Find_Callback with null record;
    Do_Find_CB : aliased Do_Find_Callback;

    overriding procedure Call
           (This       : in Do_Find_Callback;
            Item       : in String;
            Match_Case : in Boolean) is
    begin
        Ada.Text_IO.Put_Line ("Finding " & Item);
        if Match_Case then
            Ada.Text_IO.Put_Line ("Matching case");
        end if;
    end Call;




    type Do_Replace_Callback is new Editor_Windows.Replace_Callback with null record;
    Do_Replace_CB : aliased Do_Replace_Callback;

    overriding procedure Call
           (This                    : in Do_Replace_Callback;
            Item, Replace_With      : in String;
            Match_Case, Replace_All : in Boolean) is
    begin
        Ada.Text_IO.Put_Line ("Replacing " & Item & " with " & Replace_With);
        if Match_Case then
            Ada.Text_IO.Put_Line ("Matching case");
        end if;
        if Replace_All then
            Ada.Text_IO.Put_Line ("Replacing all");
        end if;
    end Call;




    --  helper functions

    procedure Set_Title is
        Title : Unbounded_String := To_Unbounded_String (0);
    begin
        if Changed then
            Append (Title, "*");
        end if;
        if Filename = "" then
            Append (Title, "(Untitled)");
        else
            Append (Title, Filename);
        end if;
        Editor.Set_Label (To_String (Title));
    end Set_Title;




    function Safe_To_Discard return Boolean is
        User_Response : Choice;
    begin
        if not Changed then return True; end if;
        User_Response := Three_Way_Choice
               ("The current file has not been saved." & Character'Val (10) &
                "Would you like to save it now?",
                "Cancel", "Save", "Discard");
        case User_Response is
            when First =>
                return False;
            when Second =>
                Do_Save;
                return not Changed;
            when Third =>
                return True;
        end case;
    end Safe_To_Discard;




    procedure Do_Save is
    begin
        if Filename = "" then
            Do_Save_As;
        else
            Save_File (To_String (Filename));
        end if;
    end Do_Save;




    procedure Do_Save_As is
        New_Filename : String := File_Chooser
               ("Save File As?", "*", To_String (Filename));
    begin
        if New_Filename /= "" then
            Save_File (New_Filename);
        end if;
    end Do_Save_As;




    procedure Load_File (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 (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;




    procedure Centre (Win : in out Window'Class) is
        Middle_X : Integer := Editor.Get_X + Editor.Get_W / 2;
        Middle_Y : Integer := Editor.Get_Y + Editor.Get_H / 2;
    begin
        Win.Reposition
               (Middle_X - Win.Get_W / 2,
                Middle_Y - Win.Get_H / 2);
    end Centre;


begin


    declare
        Bar : Menu_Cursor := Editor.Get_Menu;
    begin
        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', Flag_Divider);
        Bar.Add ("File/&Quit",         Quit_CB'Access,       Mod_Ctrl + 'q');

        Bar.Add (Text => "&Edit",   Flags => Flag_Submenu);
        Bar.Add ("Edit/&Undo",         Undo_CB'Access,       Mod_Ctrl + 'z',        Flag_Divider);
        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,     No_Key,                Flag_Divider);
        Bar.Add ("Edit/Select &All",   Select_All_CB'Access, Mod_Ctrl + 'a');

        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",   Flags => Flag_Submenu);
        Bar.Add ("Help/&About",        About_CB'Access);
    end;


    Find.Set_Find_Callback (Do_Find_CB'Access);
    Replace.Set_Replace_Callback (Do_Replace_CB'Access);
    Buffer.Add_Modify_Callback (Mod_CB'Access);
    Editor.Set_Callback (Quit_CB'Access);
    Editor.Set_Buffer (Buffer);
    Editor.Show;
    return FLTK.Run;


end Adapad;