-------------------------------------------------------------------------------------------------------------------------------------------------------------- -- Gnostic is Ada Generic Neural Object System Engineering. -- -- Gnostic (C) Copyright 2016 Manuel De Girardi. -- -------------------------------------------------------------------------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------------------------------------------------------------------------- -- Date := 2016-12-06 15:54:11 ;  -- Description : Ada Generic Neural Object System Engineering. -- -- Version := 2016.36.1a ;  -- Authors : Manuel De Girardi. -- -------------------------------------------------------------------------------------------------------------------------------------------------------------- with Ada.Directories; use Ada.Directories; with Gtk.Dialog; use Gtk.Dialog; with Gtk.Widget; use Gtk.Widget; with Gtk.Link_Button; use Gtk.Link_Button; with Gtk.Text_Tag_Table; use Gtk.Text_Tag_Table; with Gtk.Text_Tag; use Gtk.Text_Tag; with Gtk.Text_Iter; use Gtk.Text_Iter; with Gtk.Text_Mark; use Gtk.Text_Mark; with GtkAda.file_selection; with Glib.Error; use Glib.Error; with Glib.Convert; with Gtk.Enums; use Gtk.Enums; with Gtk.Stock; use Gtk.Stock; with Gtk.Action; with Gtk.Label; use Gtk.Label; with Cairo.Png; with Cairo.Region; use Cairo.Region; with Cairo.Surface; use Cairo.Surface; with Cairo.Image_Surface; use Cairo.Image_Surface; use Cairo; with Pango.Cairo; use Pango.Cairo; with Gdk.Cairo; use Gdk.Cairo; with Text_Io; with Ada.Wide_Text_Io; with Ada.Characters.Handling; use Ada.Characters; with Ada.Strings.Maps; with Ada.Strings.Fixed; use Ada.Strings.Fixed; use Ada.Strings; with Ada.Strings.Wide_Fixed; use Ada; with System.Address_To_Access_Conversions; with Ada.Strings.UTF_Encoding.Strings; with Ada.Strings.UTF_Encoding.Wide_Strings; with Gnat.Directory_Operations; use Gnat.Directory_Operations; use Gnat; with Gtk.About_Dialog; use Gtk.About_Dialog; with Gtk.Gentry; use Gtk.Gentry; with Gnos.Versions; with Gnos.Versions.Version_Io; with Gnos.Versions.Editting; use Gnos.Versions.Editting; use Gnos.Versions; use Gnos.Versions.Version_Io; with gnos.Tools; use gnos.Tools; with Gnat.Command_Line; use Gnat.Command_Line; with Gnat.Strings; with Ada.Calendar.Formatting; use Ada.Calendar.Formatting; with Ada.Command_Line; package body Gnos.Windows is procedure Computation_Menu(Action, Main_Window : Address); pragma Convention (C, Computation_Menu); procedure Project_Archive(Action, Main_Window : Address); pragma Convention (C, Project_Archive); procedure Project_Prepare(Action, Main_Window : Address); pragma Convention (C, Project_Prepare); procedure Quit(Action, Main_Window : Address); pragma Convention (C, Quit); procedure Export_Canvas_Menu(Action, Main_Window : Address); pragma Convention (C, Export_Canvas_Menu); procedure Reverse_Canvas_Menu(Action, Main_Window : Address); pragma Convention (C, Reverse_Canvas_Menu); procedure Reload_Menu(Action, Main_Window : Address); pragma Convention (C, Reload_Menu); procedure Update_Menu(Action, Main_Window : Address); pragma Convention (C, Update_Menu); procedure Clear_Menu (Action, Main_Window : Address); pragma Convention (C, Clear_Menu); procedure Clean_Menu(Action, Main_Window : Address); pragma Convention (C, Clean_Menu); procedure Restart_Menu(Action, Main_Window : Address); pragma Convention (C, Restart_Menu); procedure Create_List(Action, Main_Window : Address); pragma Convention (C, Create_List); procedure New_File(Action, Main_Window : Address); pragma Convention (C, New_File); procedure Build_Menu(Action, Main_Window : Address); pragma Convention (C, Build_Menu); procedure Open_File(Action, Main_Window : Address); pragma Convention (C, Open_File); procedure About(Action, Main_Window : Address); pragma Convention (C, About); procedure Xterm_Menu(Action, Main_Window : Address); pragma Convention (C, Xterm_Menu); procedure Unself_Programming_Menu(Action, Main_Window : Address); pragma Convention (C, Unself_Programming_Menu); procedure Unself_Executed_Menu(Action, Main_Window : Address); pragma Convention (C, Unself_Executed_Menu); procedure self_Programming_Menu(Action, Main_Window : Address); pragma Convention (C, self_Programming_Menu); procedure self_Executed_Menu(Action, Main_Window : Address); pragma Convention (C, self_Executed_Menu); Entries : constant Action_Entry_Array := (1 => Create (Name => "FileMenu", Label => "_File"), 2 => Create (Name => "New_File", Stock_Id => Stock_NEw, Label => "_New file", Accelerator => "N", Tooltip => "New file", Callback => New_file'Access), 3 => Create (Name => "Open_File", Stock_Id => Stock_Open, Label => "_Open file", Accelerator => "N", Tooltip => "Open file", Callback => Open_file'Access), 4 => Create (Name => "Quit", Stock_Id => Stock_Quit, Label => "_Quit", Accelerator => "Q", Tooltip => "Quit", Callback => Quit'Access), 5 => Create (Name => "HelpMenu", Label => "_Help"), 6 => Create (Name => "About", Stock_Id => Stock_About, Label => "_About", Accelerator => "", Tooltip => "About", Callback => About'Access), 7 => Create (Name => "ProjectMenu", Label => "_Project"), 8 => Create (Name => "Create_List", Stock_Id => Stock_Refresh, Label => "_Create_List", Accelerator => "", Tooltip => "Create_List", Callback => Create_List'Access), 9 => Create (Name => "Prepare", Stock_Id => Stock_Execute, Label => "_Prepare", Accelerator => "P", Tooltip => "Prepare", Callback => Project_Prepare'Access), 10 => Create (Name => "Reload", Stock_Id => Stock_Refresh, Label => "_Reload", Accelerator => "R", Tooltip => "Reload", Callback => Reload_Menu'Access), 11 => Create (Name => "Build", Stock_Id => Stock_Execute, Label => "_Build", Accelerator => "B", Tooltip => "Build", Callback => Build_Menu'Access), 12 => Create (Name => "Archive", Stock_Id => Stock_Execute, Label => "_Archive", Accelerator => "", Tooltip => "Archive", Callback => Project_Archive'Access), 13 => Create (Name => "SystemMenu", Label => "_System"), 14 => Create (Name => "Clear", Stock_Id => Stock_Delete, Label => "_Clear", Accelerator => "L", Tooltip => "Clear text", Callback => Clear_menu'Access), 15 => Create (Name => "TermMenu", Label => "_Term"), 16 => Create (Name => "xterm", Stock_Id => Stock_Execute, Label => "_xterm 80x24", Accelerator => "T", Tooltip => "xterm", Callback => Xterm_Menu'Access), 17 => Create (Name => "Export_PNG", Stock_Id => Stock_Open, Label => "_Export canvas to PNG", Accelerator => "", Tooltip => "Export PNG", Callback => Export_Canvas_Menu'Access), 18 => Create (Name => "Update", Stock_Id => Stock_Execute, Label => "_Update", Accelerator => "U", Tooltip => "Update", Callback => Update_Menu'Access), 19 => Create (Name => "Restart", Stock_Id => Stock_Execute, Label => "_Restart", Accelerator => "", Tooltip => "Restart", Callback => Restart_Menu'Access), 20 => Create (Name => "Clean", Stock_Id => Stock_Execute, Label => "_Clean", Accelerator => "", Tooltip => "Clean", Callback => Clean_Menu'Access), 21 => Create (Name => "SelfMenu", Label => "_Self"), 22 => Create (Name => "Unself_Programming", Stock_Id => Stock_Stop, Label => "Unself _programming", Accelerator => "", Tooltip => "Unself_Programming", Callback => Unself_Programming_menu'Access), 23 => Create (Name => "Unself_Executed", Stock_Id => Stock_Stop, Label => "Unself _Executed", Accelerator => "", Tooltip => "Unself_Executed", Callback => Unself_Executed_Menu'Access), 24 => Create (Name => "Self_Programming", Stock_Id => Stock_Media_stop, Label => "self p_rogramming", Accelerator => "", Tooltip => "self_Programming", Callback => Self_Programming_Menu'Access), 25 => Create (Name => "Self_Executed", Stock_Id => Stock_Execute, Label => "self E_xecuted", Accelerator => "", Tooltip => "self_Executed", Callback => self_Executed_Menu'Access), 26 => Create (Name => "ViewMenu", Label => "_View"), 27 => Create (Name => "Reverse_Canvas", Stock_Id => Stock_refresh, Label => "_Reverse canvas", Accelerator => "W", Tooltip => "Reverse canvas", Callback => Reverse_Canvas_Menu'Access), 28 => Create (Name => "ComputationMenu", Stock_Id => Stock_Media_play, Label => "_computation", Accelerator => "I", Tooltip => "Computation menu", Callback => Computation_Menu'Access) ); UI_Info : constant String := "" & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & " " & ""; procedure About_Process(Main : in Object_Pointer); procedure Insert_With_Tag (Buffer : access Gtk_Text_Buffer_Record'Class; Tag : String; Text : String); procedure On_Link_Button_Clicked (Button : access Gtk_Link_Button_Record'Class; Link : UTF8_String; Data : Boolean); procedure Xterm_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); B_Args, Args : Argument_List_access; Exec_Location : Os_Lib.String_Access; Xterm_Call : constant String := "xterm -geometry 80x24"; Command_Index : constant Natural := Index(Xterm_Call, " ", Index_Non_Blank(Xterm_Call)); Command : Gnat.Command_Line.Command_Line; begin if Command_index > 1 then Set_Command_Line(Command, Xterm_Call); Build(Command, B_Args); Args := new Argument_List(1..B_Args'length - 1); for I in 1..B_Args'length - 1 loop Args(I) := new String ' (Normalize_Quoted_argument(B_Args(I+1).all)); end loop; Exec_Location := Locate_Exec_On_Path(Xterm_Call(Xterm_Call'First..Command_Index-1)); if Exec_Location /= null then To_Pointer(Main_Window).Id := Non_Blocking_Spawn(Exec_Location.all, Args.all); end if; end if; end Xterm_Menu; -- Automation_Message, -- On_Error_Message, -- System_Step_Message. type Message_Timeout_Window_Type(Message : Message_Enum) is record Dialog : Gtk_Dialog; Box : Gtk_Vbox; Label : Gtk_Label; End_time : Time := Clock; Timeout : duration := 1.0; Success : Boolean := False; Text_View : Gtk_Text_View; Text_Buffer : Gtk_Text_Buffer; Timeout_Id : Glib.Main.G_Source_Id; case Message is when Automation_Message => Remaning_Time : Time := Clock; Next_Step : System_Step_Enum := System_Step_Enum'First; when On_Error_Message => Step_On_Error : System_Step_Enum := List; Result : Results.Spawn_Result_Type; when System_Step_Message => Previsious_Step : System_Step_Enum := System_Step_Enum'First; Current_Step : System_Step_Enum := System_Step_Enum'First; Comment : Gtk_Label; when Computation_Message => null; end case; end record; package Messages_Timeouts is new Glib.Main.generic_sources(Message_Timeout_Window_Type); function Message_timeout_func(Message_window : Message_Timeout_Window_Type) return boolean is begin case Message_Window.Message is when Automation_Message => Set_Text(Message_Window.Label, Image(Message_Window.Remaning_Time - Clock)); if Message_Window.Remaning_Time < Clock then Gtk.Dialog.Response(Message_Window.Dialog, Gtk_Response_Yes); return False; end if; when On_Error_Message => Set_Text(Message_Window.Label, Image(Message_Window.End_Time - clock)); if Message_Window.End_Time < Clock then Gtk.Dialog.Response(Message_Window.Dialog, Gtk_Response_Yes); return False; end iF; when System_Step_Message => Set_Text(Message_Window.Label, Image(Message_Window.End_Time - Clock)); if Message_Window.End_Time < Clock then Gtk.Dialog.Response(Message_Window.Dialog, Gtk_Response_Yes); return False; end iF; when Computation_Message => Set_Text(Message_Window.Label, Image(Message_Window.End_Time - Clock)); if Message_Window.End_Time < Clock then Gtk.Dialog.Response(Message_Window.Dialog, Gtk_Response_No); return False; end iF; end case; Show_All(Message_Window.Label); return true; end Message_Timeout_Func; procedure Initialize_Message_Window(Message_Window : in out Message_Timeout_Window_Type ; Parent : Gtk_window) is Response : Gtk_Response_Type; Yes : Gtk.Widget.Gtk_Widget; No : Gtk.Widget.Gtk_Widget; Scroll : Gtk_Scrolled_Window; File : Wide_Text_Io.File_Type; begin Gtk.Dialog.Gtk_New(Message_Window.Dialog, "Timeout message : " & Message_Enum'Image(Message_Window.Message), Parent, Flags => Modal); Message_Window.Box := Get_Content_area(Message_Window.Dialog); Gtk_New(Message_Window.Label, ""); Yes := Gtk.Dialog.Add_Button(Message_Window.Dialog, "Yes", Gtk.Dialog.Gtk_Response_Yes); No := Gtk.Dialog.Add_Button(Message_Window.Dialog, "No", Gtk.Dialog.Gtk_Response_No); case Message_Window.Message is when Automation_Message => Set_Default_size(Message_Window.Dialog, 500, 200); Gtk_New(Message_Window.Text_Buffer); Gtk_New(Message_Window.Text_View, Message_Window.Text_Buffer); --Set_Usize(Message_Window.Text_View, 500, 200); Gtk_New(Scroll); Add(Scroll, Message_Window.Text_View); Pack_Start(Message_Window.Box, Scroll, False, False); Insert_With_Tag(Message_Window.Text_Buffer, "", "Going to next Step : " & System_Step_Enum'image(Message_Window.Next_Step)); Set_Editable(Message_Window.Text_View, False); when On_Error_Message => Set_Default_size(Message_Window.Dialog, 500, 440); Gtk_New(Message_Window.Text_Buffer); Gtk_New(Message_Window.Text_View, Message_Window.Text_Buffer); --Set_Usize(Message_Window.Text_View, 500, 400); Gtk_New(Scroll); Add(Scroll, Message_Window.Text_View); Pack_Start(Message_Window.Box, Scroll, False, False); Set_Text(Message_Window.Label, Image(Message_Window.End_time - Clock )); if Message_Window.Result.File_Content /= null then --Text_Io.Put_Line("Going to Load Spaw_Result..."); for I in Message_Window.Result.File_Content'Range loop Insert_With_Tag(Message_Window.Text_Buffer, "", "Step " & System_Step_Enum'image(Message_Window.Step_On_Error) & " : " & Handling.To_String(-(Message_Window.Result.File_Content(I)))); end loop; --Text_Io.Put_Line("Spawn Result loaded."); end if; Set_Editable(Message_Window.Text_View, False); when System_Step_Message => Set_Default_size(Message_Window.Dialog, 500, 200); Gtk_New(Message_Window.Text_Buffer); Gtk_New(Message_Window.Text_View, Message_Window.Text_Buffer); --Set_Usize(Message_Window.Text_View, 500, 200); Gtk_New(Scroll); Add(Scroll, Message_Window.Text_View); Pack_Start(Message_Window.Box, Scroll, False, False); Insert_With_Tag(Message_Window.Text_Buffer, "", "The next step is not the successor of current step :"); Insert_With_Tag(Message_Window.Text_Buffer, "", "The current step is : " & System_Step_Enum'image(Message_Window.Previsious_Step)); Insert_With_Tag(Message_Window.Text_Buffer, "", "The next step is : " & System_Step_Enum'image(Message_Window.Current_Step)); Set_Text(Message_Window.Label, Image(Message_Window.End_Time - Clock)); Set_Editable(Message_Window.Text_View, False); when Computation_Message => Set_Default_size(Message_Window.Dialog, 500, 200); Gtk_New(Message_Window.Text_Buffer); Gtk_New(Message_Window.Text_View, Message_Window.Text_Buffer); --Set_Usize(Message_Window.Text_View, 500, 200); Gtk_New(Scroll); Add(Scroll, Message_Window.Text_View); Insert_With_Tag(Message_Window.Text_Buffer, "", "Click yes to compute a file."); Set_Text(Message_Window.Label, Image(Message_Window.End_Time - Clock)); Set_Editable(Message_Window.Text_View, False); Pack_Start(Message_Window.Box, Scroll, False, False); end case; Pack_Start(Message_Window.Box, Message_Window.Label, False, false); Show_All(Message_Window.Dialog); Message_Window.Timeout_Id := Messages_Timeouts.Timeout_Add(1000, Message_Timeout_Func'Access, Message_Window); Response := Run(Message_Window.Dialog); case Response is when Gtk_Response_Yes => Message_Window.Success := True; Destroy(Message_Window.Dialog); glib.Main.remove(Message_Window.Timeout_ID); when others => Message_Window.Success := False; Destroy(Message_Window.Dialog); glib.Main.remove(Message_Window.Timeout_ID); end case; end Initialize_Message_Window; procedure Restart(Object : in Object_Pointer) is B_Args, Args : Argument_List_access; Exec_Location : Os_Lib.String_Access; Command_Line : String_Access; begin if Get_Parameter(Object.Context.Gnose_Params.Kit, Config_Filename).Is_Setted then Command_Line := new String ' (Ada.Command_Line.Command_Name & " -F " & Handling.To_String(Get_Parameter(Object.Context.Gnose_Params.Kit, Config_Filename).Value.all)); else Command_Line := new String ' (Ada.Command_Line.Command_Name); end if; declare Xterm_Call : constant String := "xterm -geometry 80x40 -e bash -c """ & Command_Line.all & """"; Command_Index : constant Natural := Index(Xterm_Call, " ", Index_Non_Blank(Xterm_Call)); Command : Gnat.Command_Line.Command_Line; begin if Command_index > 1 then Set_Command_Line(Command, Xterm_Call); Build(Command, B_Args); Args := new Argument_List(1..B_Args'length - 1); for I in 1..B_Args'length - 1 loop Args(I) := new String ' (Normalize_Quoted_argument(B_Args(I+1).all)); end loop; Exec_Location := Locate_Exec_On_Path(Xterm_Call(Xterm_Call'First..Command_Index-1)); if Exec_Location /= null then Object.Id := Non_Blocking_Spawn(Exec_Location.all, Args.all); end if; end if; end; end Restart; procedure Quit(Action, Main_Window : Address) is pragma Unreferenced (Action); begin destroy(Gtk_Window(To_Pointer(Main_Window).Gnose_interface)); end Quit; procedure Project_Prepare_Window (Gnostic : in Object_Pointer); procedure Project_Prepare_Window (Gnostic : in Object_Pointer) is begin if Gnostic.System_Step = prepare then Text_Io.Put_Line("-- Making prepare..."); Gnostic.Exit_Result := Results.Spawn("make prepare"); if Gnostic.Exit_Result.Success then -- Going to Computation; Gnostic.System_Step := Computation; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; else declare Message : constant Message_Enum := System_Step_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Previsious_Step := Gnostic.System_Step; Message_Window.Current_Step := Prepare; Message_Window.End_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if not Message_Window.Success then if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; Gnostic.Context.System_Params.Self_Executed := False; else Text_Io.Put_Line("-- Making prepare..."); Gnostic.Exit_Result := Results.Spawn("make prepare"); if Gnostic.Exit_Result.Success then -- Going to Computation; Gnostic.System_Step := Computation; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end if; end; end if; end Project_Prepare_Window; procedure Reload_Project(Object : in Object_Pointer); procedure Reload_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin if Gnostic.System_Step = reload then Reload_Project(To_Pointer(Main_Window)); if Gnostic.Exit_Result.Success then -- Going to Update : Gnostic.System_Step := Update; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; else declare Message : constant Message_Enum := System_Step_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Previsious_Step := Gnostic.System_Step; Message_Window.Current_Step := Reload; Message_Window.End_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if not Message_Window.Success then if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; Gnostic.Context.System_Params.Self_Executed := False; else Reload_Project(To_Pointer(Main_Window)); end if; if Gnostic.Exit_Result.Success then -- Going to Update : Gnostic.System_Step := Update; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end; end if; end Reload_Menu; procedure Upgrade (Object : in Object_Pointer) is Gnose_Context : Gnose_Context_Record := Object.Context.all; begin Versions.New_Version := Get_Parameter(Gnose_Context.Gnose_Params.Kit, Self_Programming).Is_setted; Text_Io.Put_Line("Update version..."); if Versions.New_Version then Text_Io.Put_Line("-- check for New Specifications..."); Versions.New_Description := Environment.Check_Modification_To_New_Description(Projects_Context_Record(Gnose_Context)); Text_Io.Put_Line("-- check for New Implementation..."); Versions.New_Action := Environment.Check_Modification_To_New_Action(Projects_Context_Record(Gnose_Context)); Text_Io.Put_Line("-- Version Update..."); -- update Version ! if Gnose_Context.Project.Project_Prefix /= null then Text_Io.Put_Line("Project prefix : " & Gnose_Context.Project.Project_Prefix.all); Text_Io.Put_Line("Project name : " & Gnose_Context.Project.Project_Name.all); declare Node_Name : access String := new String ' (Gnose_Context.Project.Project_Name(Gnose_Context.Project.Project_Prefix'Length+1..Gnose_Context.Project.Project_Name'Last)); begin if Versions.New_Description then if Environment.Version_Update /= 0 then raise Program_Error; end if; Text_Io.Put_Line("-- Editting minor version..."); Main_Description(Gnose_Context.Project.Project_Name.all, Gnose_Context.Project.Project_Prefix.all, "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Gnose_Context.Project.Project_Name.all, Gnose_Context.Project.Project_Prefix.all, "Version", Versions.Version_Io.To_String(Versions.Version), Node_Name.all); for File_Id in Specifications_Filenames_Search.File_Content'Range loop Editting.Update(Handling.To_String(Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Editting.Update(Handling.To_String(Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Versions.Version)); end loop; end if; if Versions.New_Action then if Environment.Version_Update /= 0 then raise Program_Error; end if; Text_Io.Put_Line("-- Editting revision version..."); Main_Description(Gnose_Context.Project.Project_Name.all, Gnose_Context.Project.Project_Prefix.all, "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Gnose_Context.Project.Project_Name.all, Gnose_Context.Project.Project_Prefix.all, "Version", Versions.Version_Io.To_String(Versions.Version), Node_Name.all); for File_Id in Implementations_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Versions.Version)); end loop; end if; if Versions.New_Action or Versions.New_Description then if Environment.Version_Update /= 0 then raise Program_Error; end if; Text_Io.Put_Line("-- Editting major version..."); Versions.Editting.To_Major(Gnose_Context.Project.Project_Name.all, Gnose_Context.Project.Project_Prefix.all); Versions.Editting.To_Minor(Gnose_Context.Project.Project_Name.all, Gnose_Context.Project.Project_Prefix.all); Versions.Editting.To_Revision(Gnose_Context.Project.Project_Name.all, Gnose_Context.Project.Project_Prefix.all); else if Environment.Version_Update /= 0 then raise Program_Error; end if; Text_Io.Put_Line("-- Editting release version..."); Versions.Editting.To_Release(Gnose_Context.Project.Project_Name.all, Gnose_Context.Project.Project_Prefix.all); end if; Versions.New_Action := False; Versions.New_Description := False; end; else Text_Io.Put_Line("Project name : " & Gnose_Context.Project.Project_Name.all); declare Node_Name : access String := new String ' (""); begin if Versions.New_Description then if Environment.Version_Update /= 0 then raise Program_Error; end if; Main_Description(Gnose_Context.Project.Project_Name.all, "", "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Gnose_Context.Project.Project_Name.all, "", "Version", Versions.Version_Io.To_String(Versions.Version), Node_Name.all); for File_Id in Specifications_Filenames_Search.File_Content'Range loop Editting.Update(Handling.To_String(Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Editting.Update(Handling.To_String(Results."-"(Specifications_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Versions.Version)); end loop; end if; if Versions.New_Action then if Environment.Version_Update /= 0 then raise Program_Error; end if; Main_Description(Gnose_Context.Project.Project_Name.all, "", "Date", Formatting.Image(Clock), Node_Name.all); Main_Description(Gnose_Context.Project.Project_Name.all, "", "Version", Versions.Version_Io.To_String(Versions.Version), Node_Name.all); for File_Id in Implementations_Filenames_Search.File_Content'Range loop Update(Handling.To_String(Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Date", Formatting.Image(Clock)); Update(Handling.To_String(Results."-"(Implementations_Filenames_Search.File_Content(File_Id))), "Version", Versions.Version_Io.To_String(Versions.Version)); end loop; end if; if Versions.New_Action or Versions.New_Description then Text_Io.Put_Line("-- Editting revision version..."); Versions.Editting.To_Revision(Gnose_Context.Project.Project_Name.all, ""); Text_Io.Put_Line("-- Editting minor version..."); Versions.Editting.To_Minor(Gnose_Context.Project.Project_Name.all, ""); Text_Io.Put_Line("-- Editting major version..."); Versions.Editting.To_Major(Gnose_Context.Project.Project_Name.all, ""); else if Environment.Version_Update /= 0 then raise Program_Error; end if; Text_Io.Put_Line("-- Editting release version..."); Versions.Editting.To_Release(Gnose_Context.Project.Project_Name.all, ""); end if; Versions.New_Action := False; Versions.New_Description := False; end; end if; Gtk.Window.Set_Title(Gtk_Window(Object.Gnose_Interface), Gnose_Context.Project.Project_Name.all & " - " & To_String(Versions.Version)); end if; Calendar.Split(Clock, Start_Date.Year, Start_Date.Month, Start_Date.Day, Start_Date.Hours); end Upgrade; procedure Update_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; File : Text_Io.File_Type; begin if Gnostic.System_Step = update then Upgrade(To_Pointer(Main_Window)); -- Make update. begin text_io.Open(File, text_io.Append_File, "Versions.default"); exception when text_io.Name_Error => text_io.create(File, text_io.out_File, "Versions.default"); end; text_io.Put_Line(File, To_String(Versions.Version)); text_io.Close(File); Text_Io.Put_Line("-- Making update..."); Gnostic.Exit_Result := Results.Spawn("make update"); if Gnostic.Exit_Result.Success then -- Going to Clean Gnostic.System_Step := Clean; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; else declare Message : constant Message_Enum := System_Step_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Previsious_Step := Gnostic.System_Step; Message_Window.Current_Step := Update; Message_Window.End_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if not Message_Window.Success then if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; Gnostic.Context.System_Params.Self_Executed := False; else Upgrade(To_Pointer(Main_Window)); begin text_io.Open(File, text_io.Append_File, "Versions.default"); exception when text_io.Name_Error => text_io.create(File, text_io.out_File, "Versions.default"); end; text_io.Put_Line(File, To_String(Versions.Version)); text_io.Close(File); -- Make update. Text_Io.Put_Line("-- Making update..."); Gnostic.Exit_Result := Results.Spawn("make update"); if Gnostic.Exit_Result.Success then -- Going to Clean Gnostic.System_Step := Clean; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end if; end; end if; end Update_Menu; procedure On_clear(Text_buffer : access Gtk.Text_buffer.Gtk_Text_Buffer_Record'Class; Main : Object_Pointer) is Top, Bot : Gtk_Text_Iter; begin Get_Bounds(Text_Buffer, Top, Bot); Gtk.Text_Buffer.delete(Text_Buffer, Top, Bot); Main.Gnose_Interface.User_Position := 0; Get_Bounds(Main.Gnose_Interface.System_Text_Buffer, Top, Bot); Gtk.Text_Buffer.delete(Main.Gnose_Interface.System_Text_Buffer, Top, Bot); end On_Clear; -- procedure On_clear(Text : access Gtk.Text.Gtk_Text_Record'Class; Main : Object_Pointer) is -- begin -- if Gtk.Text.Backward_Delete(Text, Gtk.Text.Get_Length(Text)) then -- Main.Gnose_Interface.User_Position := 0; -- end if; -- end On_Clear; -- procedure Clear_Menu (Action, Main_Window : Address) is -- begin -- On_Clear(To_Pointer(Main_Window).System_View.Text_Buffer, To_Pointer(Main_Window)); -- end Clear_Menu; procedure Clear_Menu (Action, Main_Window : Address) is pragma Unreferenced (Action); begin On_Clear(To_Pointer(Main_Window).Gnose_Interface.User_Text_buffer, To_Pointer(Main_Window)); end Clear_Menu; procedure Project_Archive_Window (Gnostic : in Object_Pointer); procedure Project_Archive(Action, Main_Window : Address) is pragma Unreferenced (Action); begin Project_Archive_Window(To_Pointer(Main_Window)); end Project_Archive; procedure Project_Prepare(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin Project_Prepare_Window(To_Pointer(Main_Window)); end Project_Prepare; procedure Export_Canvas_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); The_Surface : Cairo_Surface; Cr : Cairo_Context; Status : Cairo_Status; begin The_Surface := Create(Cairo_Format_ARGB32, To_Pointer(Main_Window).Gnose_Interface.Graph_Set(Project_Define).X_Ads, To_Pointer(Main_Window).Gnose_Interface.Graph_Set(Project_Define).Y_Ads); Cr := Create(The_Surface); Draw_All(To_Pointer(Main_Window).Gnose_Interface.Graph_Set(Project_Define).Canvas, Cr); The_Surface := Get_Target(Cr); Status := Cairo.PNG.Write_To_Png(The_Surface, "Gnostic.png"); end Export_Canvas_Menu; procedure Create_List_Window (Main : in Object_Pointer; Add_Name : in string); procedure Clean_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin if Gnostic.System_Step = Clean then Text_Io.Put_Line("-- Making mrproper..."); if Gnostic.Exit_Result.Success then Gnostic.Exit_Result := Results.Spawn("make mrproper"); end if; if Gnostic.Exit_Result.Success then -- Going to Arch : Gnostic.System_Step := Arch; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; else declare Message : constant Message_Enum := System_Step_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Previsious_Step := Gnostic.System_Step; Message_Window.Current_Step := Clean; Message_Window.End_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if not Message_Window.Success then if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; Gnostic.Context.System_Params.Self_Executed := False; else Text_Io.Put_Line("-- Making mrproper..."); if Gnostic.Exit_Result.Success then Gnostic.Exit_Result := Results.Spawn("make mrproper"); end if; if Gnostic.Exit_Result.Success then -- Going to Arch : Gnostic.System_Step := Arch; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end if; end; end if; end Clean_Menu; procedure Unself_Programming_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin Gnostic.Context.System_Params.Self_Programming := False; end Unself_Programming_Menu; procedure Unself_Executed_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); Gnostic.Context.System_Params.Self_Executed := False; end if; end Unself_Executed_Menu; procedure self_Programming_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin Gnostic.Context.System_Params.Self_Programming := True; end self_Programming_Menu; ---------------------------------------------------------------------------------------- -- function On_Self_Execution : Timeout callback with Data_Type (Gnose_Access) -- ---------------------------------------------------------------------------------------- function On_Self_Execution(Object : Object_Pointer) return Boolean; procedure self_Executed_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin if not Gnostic.Context.System_Params.Self_Executed then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, To_Pointer(Main_Window)); Gnostic.Context.System_Params.Self_Executed := True; end if; end self_Executed_Menu; procedure Restart_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin if Gnostic.System_Step = restart then if Gnostic.Exit_Result.Success then if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; Restart(To_Pointer(Main_Window)); -- Going to List; Gnostic.System_Step := List; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); delay 2.5; Destroy(Gnostic.Gnose_Interface); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; else declare Message : constant Message_Enum := System_Step_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Previsious_Step := Gnostic.System_Step; Message_Window.Current_Step := Restart; Message_Window.End_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if not Message_Window.Success then if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; Gnostic.Context.System_Params.Self_Executed := False; else if Gnostic.Exit_Result.Success then if Gnostic.Context.System_Params.Self_Executed then if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; end if; Restart(To_Pointer(Main_Window)); -- Going to List; Gnostic.System_Step := List; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); delay 2.5; Destroy(Gnostic.Gnose_Interface); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end if; end; end if; end Restart_Menu; type Computation_Window_Record_Type is tagged record Dialog : Gtk_Dialog; Page_Frame : Gtk_Frame; Buffer : Gtk_Text_Buffer; View : Gtk_Text_View; Scrolled : Gtk_Scrolled_Window; Editable : Boolean := False; Object : Object_Pointer; end record; type Computation_Window_Access is access all Computation_Window_Record_Type; procedure Computation_Save_As (Editor : access Computation_Window_Record_Type'Class); procedure Computation_Save (Editor : access Computation_Window_Record_Type'Class); procedure Computation_Save_Menu(Action, Main_Window : Address); pragma Convention (C, Computation_Save_Menu); procedure Computation_Save_As_Menu(Action, Main_Window : Address); pragma Convention (C, Computation_Save_As_Menu); procedure Computation_New_File(Action, Main_Window : Address); pragma Convention (C, Computation_New_File); procedure Computation_Open_File(Action, Main_Window : Address); pragma Convention (C, Computation_Open_File); package Computation_Conversions is new Address_To_Access_Conversions(Computation_Window_Access); package Computation_Cb_Handlers is new Gtk.Handlers.User_Callback(Gtk_Window_Record, Computation_Conversions.Object_Pointer); procedure Computation_New_File(Action, Main_Window : Address) is pragma Unreferenced (Action); Comptation_window : constant access Computation_Window_Record_Type'Class:= Computation_Conversions.To_Pointer(Main_Window).all.all'Access; begin On_Link_Button_clicked (null, "", True); end Computation_New_File; procedure Computation_Open_File(Action, Main_Window : Address) is pragma Unreferenced (Action); Title : constant String := (gtkada.file_selection.File_selection_Dialog(default_dir => "")); Object : constant Computation_Conversions.Object_Pointer := Computation_Conversions.To_Pointer(Main_Window); File : Wide_Text_Io.File_Type; Top, Bot : Gtk_Text_Iter; begin if (Title'Length /= 0) and then Is_Regular_File(Title) and then (Extension(Title) = "txt" or Extension(Title) = "ads" or Extension(Title) = "adb") then Get_Bounds(Object.all.Buffer, Top, Bot); Gtk.Text_Buffer.Delete(Object.all.Buffer, Top, Bot); Set_Title(object.all.dialog, title); Wide_Text_Io.Open(File, Wide_Text_Io.In_File, Title, Form => "WCEM=8"); while not Wide_Text_Io.End_Of_File(File) loop declare Line : constant Wide_String := UTF_Encoding.Wide_Strings.Decode(Wide_Text_Io.Get_Line(File)); begin if Line'Length > 0 then Insert_With_Tag (Object.all.Buffer, "", Glib.Convert.Locale_To_Utf8(Handling.To_String(Line))); else Insert_With_Tag (Object.all.Buffer, "", ""); end if; end; end loop; Wide_Text_Io.Close(File); end if; end Computation_Open_File; procedure Computation_Save_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Object : constant Computation_Conversions.Object_Pointer := Computation_Conversions.To_Pointer(Main_Window); begin Computation_Save(Object.all.all'access); end Computation_Save_Menu; procedure Computation_Save_As_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Object : constant Computation_Conversions.Object_Pointer := Computation_Conversions.To_Pointer(Main_Window); begin Computation_Save_As(Object.all.all'access); end Computation_Save_As_Menu; Computation_Entries : constant Action_Entry_Array := (1 => Create (Name => "FileMenu", Label => "_File"), 2 => Create (Name => "Save", Stock_Id => Stock_Save, Label => "_Save", Accelerator => "S", Tooltip => "Save", Callback => Computation_Save_Menu'Access), 3 => Create (Name => "Save _As", Stock_Id => Stock_Save_As, Label => "Save _As", Accelerator => "A", Tooltip => "Save _As", Callback => Computation_Save_As_Menu'Access), 4 => Create (Name => "New_File", Stock_Id => Stock_NEw, Label => "_New file", Accelerator => "N", Tooltip => "New file", Callback => Computation_New_File'Access), 5 => Create (Name => "Open_File", Stock_Id => Stock_Open, Label => "_Open file", Accelerator => "N", Tooltip => "Open file", Callback => Computation_Open_File'Access)); Computation_UI_Info : constant String := "" & " " & " " & " " & " " & " " & " " & " " & " " & ""; procedure Computation_Initialize(Computation_Pointer : in out Computation_Conversions.Object_Pointer; Object : Object_Pointer) is Tags : Gtk_Text_Tag_Table; Vbox : Gtk_Vbox; UI : Gtk_UI_Manager; Actions : Gtk_Action_Group; Error : aliased GError := null; Edit_Window : Computation_Window_access := Computation_Pointer.all.all'Access; Yes : Gtk.Widget.Gtk_Widget; No : Gtk.Widget.Gtk_Widget; begin Text_Io.Put_Line ("Computation =>"); Edit_Window.Editable := True; Edit_Window.Object := Object; Gtk.Dialog.Gtk_New(Edit_Window.Dialog, "File Computation", Gtk_Window(Object.Gnose_Interface), modal); Vbox := Get_content_area(Edit_Window.Dialog); Gtk_New(Tags); Gtk_New (Edit_Window.Buffer, Tags); Gtk_New (Edit_Window.View, Edit_Window.Buffer); Set_wrap_mode(Edit_Window.View, Gtk.enums. wrap_char); Gtk_New(Edit_Window.Page_Frame); Gtk.Window.Set_Default_Size(Gtk_Window_Record(Edit_Window.Dialog.all)'Access, 810, 600); Gtk.Window.Set_Position(Gtk_Window_Record(Edit_Window.Dialog.all)'Access, Gtk.Enums.Win_Pos_Center); Insert_With_Tag (Edit_Window.Buffer, "", Glib.Convert.Locale_To_Utf8(Handling.To_String("-- Date := """" ; "))); Insert_With_Tag (Edit_Window.Buffer, "", Glib.Convert.Locale_To_Utf8(Handling.To_String("-- Version := """" ; "))); Set_Editable(Edit_Window.View, True); Gtk_New (Edit_Window.Scrolled); Set_Policy (Edit_Window.Scrolled, Policy_Automatic, Policy_Always); Add (Edit_Window.Scrolled, Edit_Window.View); Add (Edit_Window.Page_Frame, Edit_Window.Scrolled); Gtk_New (Actions, "Actions"); Add_Actions (Actions, Computation_Entries, Computation_Conversions.To_Address(Computation_pointer)); Gtk_New (UI); Insert_Action_Group (UI, Actions, 0); Add_Accel_Group (Gtk_Window_Record(Edit_Window.Dialog.all)'Access, Get_Accel_Group (UI)); if Add_UI_From_String (UI, Computation_UI_Info, Error'Unchecked_Access) = 0 then Text_Io.Put_Line ("Building menus failed: " & Get_Message (Error)); Error_Free (Error); end if; -- Pack start Menu bar : Pack_Start (Vbox, Get_Widget (UI, "/MenuBar"), False, False, 5); Pack_Start(Vbox, Edit_Window.Page_Frame, True, True); Yes := Gtk.Dialog.Add_Button(Edit_Window.Dialog, "Yes", Gtk.Dialog.Gtk_Response_Yes); No := Gtk.Dialog.Add_Button(Edit_Window.Dialog, "No", Gtk.Dialog.Gtk_Response_No); Show_All(Gtk_Window_Record(Edit_Window.Dialog.all)'access); case Gtk.Dialog.Run(Edit_Window.Dialog) is when Gtk.Dialog.Gtk_Response_Yes => Gtk.Dialog.Destroy(Edit_Window.Dialog); when Gtk.Dialog.Gtk_Response_No => Gtk.Dialog.Destroy(Edit_Window.Dialog); when others => Gtk.Dialog.Destroy(Edit_Window.Dialog); end case; end Computation_Initialize; procedure Computation_Save_As (Editor : access Computation_Window_Record_Type'Class) is File : Wide_Text_Io.File_Type; Top : Gtk.Text_Iter.Gtk_Text_Iter; Bot : Gtk.Text_Iter.Gtk_Text_Iter; Title : constant string := gtkada.file_selection.File_selection_Dialog(default_dir => "."); begin if Extension(Title) = "txt" or Extension(Title) = "ads" or Extension(Title) = "adb" then Get_Bounds(Editor.Buffer, Top, Bot); set_title(Editor.dialog, Title); Wide_Text_Io.Create(File, Wide_Text_Io.Out_File, Title); Wide_Text_Io.Put_Line(File, UTF_Encoding.Wide_Strings.Encode(Handling.To_Wide_String(Get_Text(Editor.Buffer, Top, Bot, True)))); Wide_Text_Io.Close(File); end if; end Computation_Save_As; procedure Computation_Save (Editor : access Computation_Window_Record_Type'Class) is File : Wide_Text_Io.File_Type; Top : Gtk.Text_Iter.Gtk_Text_Iter; Bot : Gtk.Text_Iter.Gtk_Text_Iter; begin if Get_Title(Editor.dialog)'Length /= 0 then Get_Bounds(Editor.Buffer, Top, Bot); Wide_Text_Io.Create(File, Wide_Text_Io.Out_File, Get_Title(Editor.dialog)); Wide_Text_Io.Put_Line(File, UTF_Encoding.Wide_Strings.Encode(Handling.To_Wide_String(Get_Text(Editor.Buffer, Top, Bot, True)))); Wide_Text_Io.Close(File); end if; end Computation_Save; procedure Project_Archive_Window (Gnostic : in Object_Pointer) is begin if Gnostic.System_Step = arch then declare Computation_Pointer : Computation_Conversions.Object_Pointer; begin Computation_Pointer := new Computation_Window_Access; Computation_Pointer.all := new Computation_Window_Record_Type; Computation_Initialize(Computation_Pointer, Gnostic); end; Text_Io.Put_Line("-- Making arch.."); if Gnostic.Exit_Result.Success then Gnostic.Exit_Result := Results.Spawn("make enlight-sources"); Gnostic.Exit_Result := Results.Spawn("make arch"); end if; if Gnostic.Exit_Result.Success then case Gnostic.Plan is when Spec => Gnostic.System_Step := Computation; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); Gnostic.Plan := Impl; when Impl => -- Going to Build : Gnostic.System_Step := Build; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); Gnostic.Plan := Spec; end case; else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; else declare Message : constant Message_Enum := System_Step_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Previsious_Step := Gnostic.System_Step; Message_Window.Current_Step := Arch; Message_Window.End_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if not Message_Window.Success then if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; Gnostic.Context.System_Params.Self_Executed := False; else Text_Io.Put_Line("-- Making arch.."); if Gnostic.Exit_Result.Success then Gnostic.Exit_Result := Results.Spawn("make enlight-sources"); Gnostic.Exit_Result := Results.Spawn("make arch"); end if; if Gnostic.Exit_Result.Success then case Gnostic.Plan is when Spec => Gnostic.System_Step := Computation; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); Gnostic.Plan := Impl; when Impl => -- Going to Build : Gnostic.System_Step := Build; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); Gnostic.Plan := Spec; end case; else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end if; end; end if; end Project_Archive_Window; procedure Computation_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin if Gnostic.Context.System_Params.Self_Executed and Gnostic.Context.System_Params.Self_Programming then null; elsif Gnostic.Context.System_Params.Self_Executed then null; else declare Computation_Pointer : Computation_Conversions.Object_Pointer; begin Computation_Pointer := new Computation_Window_Access; Computation_Pointer.all := new Computation_Window_Record_Type; Computation_Initialize(Computation_Pointer, To_Pointer(Main_Window)); end; end if; case Gnostic.Plan is when Spec => Gnostic.System_Step := Reload; when Impl => Gnostic.System_Step := Reload; end case; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end Computation_Menu; procedure Create_List(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin Gnostic.Exit_Result := Results.Spawn("make clean"); if Gnostic.Exit_Result.Success then -- Going to Prepare :  if Gnostic.System_Step = list then Create_List_Window(To_Pointer(Main_Window), ""); Gnostic.System_Step := Prepare; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else declare Message : constant Message_Enum := System_Step_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Previsious_Step := Gnostic.System_Step; Message_Window.Current_Step := List; Message_Window.End_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if not Message_Window.Success then if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; Gnostic.Context.System_Params.Self_Executed := False; else Create_List_Window(To_Pointer(Main_Window), ""); end if; end; end if; else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end Create_List; procedure Initialize_Project_Window (Main : in Object_Pointer; Add_Name : in string) is Project_Default : constant String := "Project.default"; File : Text_Io.File_Type; List_Dialog : Gtk.Dialog.Gtk_Dialog; Box : Gtk.Box.Gtk_Vbox; The_Entry : Gtk.Gentry.Gtk_Entry; Name_Response : Gtk_Response_Type; Widget : access Gtk_Widget_Record'Class; begin Gtk.Dialog.Gtk_New(List_Dialog, Title => "Initialize list dialog", Flags => Modal); Gtk.Window.Set_Default_Size(Gtk_Window(List_Dialog), 250, 100); Box := Get_Content_Area(List_Dialog); Widget := Add_Button(List_Dialog, "Cancel", Gtk_Response_Cancel); Widget := Add_Button(List_Dialog, "Ok", Gtk_Response_Ok); if Main.Context.System_Params.Self_Programming and Main.Context.System_Params.Self_Executed then Gtk_New(The_Entry); Set_Text(The_Entry, Add_name); if Get_Text_Length(The_Entry) = 0 then Destroy(List_Dialog); else begin Text_Io.Open(File, Text_Io.Append_File, Project_Default); exception when Text_Io.Name_Error => Text_Io.Create(File, Text_Io.Out_File, Project_Default); end; Text_Io.Put_Line(File, Get_Text(The_Entry)); Text_Io.Put_Line(File, Get_Text(The_Entry)); Text_Io.Close(File); Destroy(List_Dialog); end if; elsif Main.Context.System_Params.Self_Programming then Gtk_New(The_Entry); Set_Text(The_Entry, Add_name); Set_Editable(The_Entry, False); Pack_Start(Box, The_Entry); Gtk_New(The_Entry); Set_Text(The_Entry, Add_name); Set_Editable(The_Entry, False); Pack_Start(Box, The_Entry); Gtk_New(The_Entry); Set_Editable(The_Entry, True); Pack_Start(Box, The_Entry); Show_All(List_Dialog); Name_Response := Run(List_Dialog); case Name_Response is when Gtk_Response_Ok => if Get_Text_Length(The_Entry) = 0 then begin Text_Io.Open(File, Text_Io.Append_File, Project_Default); exception when Text_Io.Name_Error => Text_Io.Create(File, Text_Io.Out_File, Project_Default); end; Text_Io.Put_Line(File, Get_Text(Gtk_Entry(The_Entry))); Text_Io.Put_Line(File, Get_Text(Gtk_Entry(The_Entry))); Text_Io.Close(File); Destroy(List_Dialog); else Gtk_New(The_Entry); Set_Editable(The_Entry, True); Pack_Start(Box, The_Entry); end if; when others => Destroy(List_Dialog); end case; else Gtk_New(The_Entry); Pack_Start(Box, The_Entry); Set_Editable(The_Entry, True); Show_All(List_Dialog); Name_Response := Run(List_Dialog); case Name_Response is when Gtk_Response_Ok => if Get_Text_Length(The_Entry) = 0 then Destroy(List_Dialog); else begin Text_Io.Open(File, Text_Io.Append_File, Project_Default); exception when Text_Io.Name_Error => Text_Io.Create(File, Text_Io.Out_File, Project_Default); end; Text_Io.Put_Line(File, Get_Text(The_Entry)); Text_Io.Put_Line(File, Get_Text(The_Entry)); Text_Io.Close(File); Destroy(List_Dialog); Create_List_Window(Main, ""); end if; when others => Destroy(List_Dialog); end case; end if; end Initialize_Project_Window; procedure Create_List_Window (Main : in Object_Pointer; Add_Name : in string) is Project_Default : constant String := "Project.default"; File : Text_Io.File_Type; List_Dialog : Gtk.Dialog.Gtk_Dialog; Box : Gtk.Box.Gtk_Vbox; The_Entry : Gtk.Gentry.Gtk_Entry; Name_Response : Gtk_Response_Type; Widget : access Gtk_Widget_Record'Class; Scroll : Gtk_Scrolled_Window; The_Box : Gtk_Vbox; begin loop Gtk.Dialog.Gtk_New(List_Dialog, Title => "Create list dialog", Flags => Modal); Gtk.Window.Set_Default_Size(Gtk_Window(List_Dialog), 250, 250); Box := Get_Content_Area(List_Dialog); Gtk_New_Vbox(The_Box, False, 0); Gtk_New(Scroll); Add_With_Viewport(Scroll, The_Box); if Is_Regular_File(Project_Default) then Text_Io.Open(File, Text_Io.In_File, Project_Default); while not Text_Io.End_Of_File(File) loop declare New_Text : constant String := Text_Io.Get_Line(File); begin Gtk_New(The_Entry); Pack_Start(The_Box, The_Entry); Set_Text(The_Entry, New_Text); Set_Editable(The_Entry, False); exception when others => null; end; end loop; Text_Io.Put_Line("Closing file named : " & Project_default); Text_Io.Close(File); end if; Widget := Add_Button(List_Dialog, "Cancel", Gtk_Response_Cancel); Widget := Add_Button(List_Dialog, "Ok", Gtk_Response_Ok); Pack_Start(Box, scroll); if Main.Context.System_Params.Self_Programming and Main.Context.System_Params.Self_Executed then Gtk_New(The_Entry); Set_Text(The_Entry, Add_name); if Get_Text_Length(The_Entry) = 0 then Destroy(List_Dialog); exit; else begin Text_Io.Open(File, Text_Io.Append_File, Project_Default); exception when Text_Io.Name_Error => Text_Io.Create(File, Text_Io.Out_File, Project_Default); end; Text_Io.Put_Line(File, Get_Text(The_Entry)); Text_Io.Close(File); Destroy(List_Dialog); exit; end if; elsif Main.Context.System_Params.Self_Programming then Gtk_New(The_Entry); Set_Text(The_Entry, Add_name); Pack_Start(The_Box, The_Entry); Show_All(List_Dialog); Name_Response := Run(List_Dialog); case Name_Response is when Gtk_Response_Ok => if Get_Text_Length(The_Entry) = 0 then Destroy(List_Dialog); exit; else begin Text_Io.Open(File, Text_Io.Append_File, Project_Default); exception when Text_Io.Name_Error => Text_Io.Create(File, Text_Io.Out_File, Project_Default); end; Text_Io.Put_Line(File, Get_Text(The_Entry)); Text_Io.Close(File); Destroy(List_Dialog); end if; when others => Destroy(List_Dialog); exit; end case; else Gtk_New(The_Entry); Pack_Start(The_Box, The_Entry); Show_All(List_Dialog); Name_Response := Run(List_Dialog); case Name_Response is when Gtk_Response_Ok => if Get_Text_Length(The_Entry) = 0 then Destroy(List_Dialog); exit; else begin Text_Io.Open(File, Text_Io.Append_File, Project_Default); exception when Text_Io.Name_Error => Text_Io.Create(File, Text_Io.Out_File, Project_Default); end; Text_Io.Put_Line(File, Get_Text(The_Entry)); Text_Io.Close(File); Destroy(List_Dialog); end if; when others => Destroy(List_Dialog); exit; end case; end if; end loop; end Create_List_Window; procedure Build_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Gnostic : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin -- make all;  Text_Io.Put_Line("-- Making all..."); if Gnostic.System_Step = Build then Gnostic.Exit_Result := Results.Spawn("make all"); if Gnostic.Exit_Result.Success then -- Going to Restart :  Gnostic.System_Step := Restart; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; else declare Message : constant Message_Enum := System_Step_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Previsious_Step := Gnostic.System_Step; Message_Window.Current_Step := Build; Message_Window.End_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if not Message_Window.Success then if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; Gnostic.Context.System_Params.Self_Executed := False; else Gnostic.Exit_Result := Results.Spawn("make all"); if Gnostic.Exit_Result.Success then -- Going to Restart :  Gnostic.System_Step := Restart; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end if; end; end if; end Build_Menu; procedure About(Action, Main_Window : Address) is pragma Unreferenced (Action); begin About_Process(To_Pointer(Main_Window)); end About; package Main_User_Cb_Handlers is new Gtk.Handlers.User_Callback(Gtk_Window_Record, Gnose_Access); procedure Main_Destroy (Window : access Gtk_Window_record'Class; Gnostic : in Gnose_access) is begin if Gnostic /= null then Text_Io.Put_Line("Going to halt System..."); Gnostic.Process.Halt; abort Gnostic.Process; Text_Io.Put_Line("System halted."); else Text_Io.Put_Line("Gnostic null"); end if; Gtk.Main.Main_Quit; end Main_Destroy; procedure About_Process(Main : in Object_Pointer) is About : Gtk_About_Dialog; About_Response : Gtk_Response_Type; begin Gtk_New(About); Set_Artists(About, (1 => new String ' ("Manuel De Girardi"))); Set_Authors(About, (1 => new String ' ("Manuel De Girardi"))); Set_Comments(About, "Tested on GNU/Linux Debian."); Set_Copyright(About, "Gnostic (C) Copyright 2016"); Set_License(About, "GNU General Public License."); Set_Program_Name(About, "Gnostic"); Set_Version(About, To_String(Versions.version)); Set_Website(About, "https://sourceforge.net/projects/gnostic"); About_Response := Run(About); Gtk.About_Dialog.Destroy(About); end About_Process; use Gnos.Parameters; -- Gnostic.Process.Run -- (Gnose_Context.System_Params.Self_Programming, -- Gnose_Context.System_Params.Self_Executed);  -- Gnostic.Process.Set_Neural(Human_Lang => Fr); -- Text_Io.New_Line; -- for Human_Lang in Human_Lang_Enum'Range loop -- Gnostic.Process.Get_Neural(Neural_Unit, Human_Lang => Human_Lang); -- Text_Io.Put_Line("Human Lang : " & Human_Lang_Enum'Image(Neural_Unit.Human_Lang)); -- end loop; -- Text_Io.New_Line; -- for Machine_Lang in Machine_Lang_Enum'Range loop -- Gnostic.Process.Get_Language(Language_Unit, Machine_Lang => Machine_Lang); -- Text_Io.Put_Line("Machine Lang : " & Machine_Lang_Enum'Image(Language_unit.Machine_Lang)); -- end loop; -- Gnostic.Process.Suspend; -- Gnostic.Process.Run -- (Gnose_Context.System_Params.Self_Programming, -- Gnose_Context.System_Params.Self_Executed); --  --------------------------- -- Draw_To_Double_Buffer -- --------------------------- -- The layout. -- ----------------------  Layout : Pango_Layout; procedure Draw (Item : access Display_Item_Record; Cr : Cairo_Context) is begin Gdk.Cairo.Set_Source_Color (Cr, Item.Color); Cairo.Rectangle (Cr, 0.5, 0.5, Gdouble (Item.W) - 1.0, Gdouble (Item.H) - 1.0); Cairo.Fill (Cr); Gdk.Cairo.Set_Source_Color (Cr, Item.Title); Rectangle (Cr, 0.5, 0.5, Gdouble (Item.W) - 1.0, Gdouble (Item.H) - 1.0); Cairo.Stroke (Cr); Set_Text (Layout, Display_Item (Item).Name); Cairo.Move_To (Cr, 10.0, 10.0); Pango.Cairo.Show_Layout (Cr, Layout); end Draw; Max_Colors : constant := 20; type Color_Type is range 1 .. Max_Colors; type String_Access is access String; Color_Names : constant array (Color_Type) of String_Access := (new String'("forest green"), new String'("red"), new String'("blue"), new String'("yellow"), new String'("peach puff"), new String'("azure"), new String'("seashell"), new String'("lavender"), new String'("grey"), new String'("turquoise"), new String'("khaki"), new String'("tan"), new String'("orange red"), new String'("MediumPurple"), new String'("ivory1"), new String'("DeepSkyBlue1"), new String'("burlywood1"), new String'("wheat1"), new String'("orange1"), new String'("pink")); Colors : array (Color_Type) of Gdk_Color; ---------------------------- -- On_Link_Button_Clicked -- ----------------------------  type Edit_Window_Record_Type is new Gtk_Window_Record with record Page_Frame : Gtk_Frame; Buffer : Gtk_Text_Buffer; View : Gtk_Text_View; Scrolled : Gtk_Scrolled_Window; Editable : Boolean := False; end record; package Edit_Cb_Handlers is new Gtk.Handlers.callback(Edit_Window_Record_Type); procedure Edit_Save_As (Editor : access Edit_Window_Record_Type'Class); procedure Edit_Save (Editor : access Edit_Window_Record_Type'Class); procedure Edit_Quit(Action, Main_Window : Address); pragma Convention (C, Edit_Quit); procedure Save_Menu(Action, Main_Window : Address); pragma Convention (C, Save_Menu); procedure Save_As_Menu(Action, Main_Window : Address); pragma Convention (C, Save_As_Menu); package Edit_Conversions is new Address_To_Access_Conversions(Edit_Window_Record_Type); procedure Save_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Object : constant access Edit_Window_Record_Type'Class := Edit_Conversions.To_Pointer(Main_Window); begin Edit_Save(Object); end Save_Menu; procedure Save_As_Menu(Action, Main_Window : Address) is pragma Unreferenced (Action); Object : constant access Edit_Window_Record_Type'Class := Edit_Conversions.To_Pointer(Main_Window); begin Edit_Save_As(Object); end Save_As_Menu; procedure Edit_Destroy (Window : access Edit_Window_Record_Type'class) is begin Destroy(Window); end Edit_Destroy; Edit_Entries : constant Action_Entry_Array := (1 => Create (Name => "FileMenu", Label => "_File"), 2 => Create (Name => "Save", Stock_Id => Stock_Save, Label => "_Save", Accelerator => "S", Tooltip => "Save", Callback => Save_Menu'Access), 3 => Create (Name => "Save _As", Stock_Id => Stock_Save_As, Label => "Save _As", Accelerator => "A", Tooltip => "Save _As", Callback => Save_As_Menu'Access), 4 => Create (Name => "Quit", Stock_Id => Stock_Quit, Label => "_Quit", Accelerator => "Q", Tooltip => "Quit", Callback => Edit_Quit'Access)); Edit_UI_Info : constant String := "" & " " & " " & " " & " " & " " & " " & " " & " " & ""; procedure Edit_Quit(Action, Main_Window : Address) is pragma Unreferenced (Action); Dialog : Gtk.Dialog.Gtk_Dialog; Yes : Gtk.Widget.Gtk_Widget; No : Gtk.Widget.Gtk_Widget; Object : constant Edit_Conversions.Object_Pointer := Edit_Conversions.To_Pointer(Main_Window); begin if Object.Editable then loop Gtk.Dialog.Gtk_New(Dialog, "Save ?", Gtk_Window(Object), Gtk.dialog.modal); Yes := Gtk.Dialog.Add_Button(Dialog, "Yes", Gtk.Dialog.Gtk_Response_Yes); No := Gtk.Dialog.Add_Button(Dialog, "No", Gtk.Dialog.Gtk_Response_No); case Gtk.Dialog.Run(Dialog) is when Gtk.Dialog.Gtk_Response_Yes => Gtk.Dialog.Destroy(Dialog); exit; when Gtk.Dialog.Gtk_Response_No => Gtk.Dialog.Destroy(Dialog); exit; when others => Gtk.Dialog.Destroy(Dialog); exit; end case; end loop; end if; Edit_Destroy(Object); end Edit_Quit; procedure Edit_Save_As (Editor : access Edit_Window_Record_Type'Class) is File : Wide_Text_Io.File_Type; Top : Gtk.Text_Iter.Gtk_Text_Iter; Bot : Gtk.Text_Iter.Gtk_Text_Iter; Title : constant string := gtkada.file_selection.File_selection_Dialog(default_dir => "."); begin if Extension(Title) = "txt" or Extension(Title) = "ads" or Extension(Title) = "adb" then Get_Bounds(Editor.Buffer, Top, Bot); set_title(Editor, Title); Wide_Text_Io.Create(File, Wide_Text_Io.Out_File, Title); Wide_Text_Io.Put_Line(File, UTF_Encoding.Wide_Strings.Encode(Handling.To_Wide_String(Get_Text(Editor.Buffer, Top, Bot, True)))); Wide_Text_Io.Close(File); end if; end Edit_Save_As; procedure Edit_Save (Editor : access Edit_Window_Record_Type'Class) is File : Wide_Text_Io.File_Type; Top : Gtk.Text_Iter.Gtk_Text_Iter; Bot : Gtk.Text_Iter.Gtk_Text_Iter; begin if Get_Title(Editor)'Length /= 0 then Get_Bounds(Editor.Buffer, Top, Bot); Wide_Text_Io.Create(File, Wide_Text_Io.Out_File, Get_Title(Editor)); Wide_Text_Io.Put_Line(File, UTF_Encoding.Wide_Strings.Encode(Handling.To_Wide_String(Get_Text(Editor.Buffer, Top, Bot, True)))); Wide_Text_Io.Close(File); end if; end Edit_Save; -- Insert_With_Tag -- --------------------- procedure Insert_With_Tag (Buffer : access Gtk_Text_Buffer_Record'Class; Tag : String; Text : String) is T : Gtk_Text_Tag; Iter, Start_Iter : Gtk_Text_Iter; Table : Gtk_Text_Tag_Table; Result : Boolean; pragma Warnings (Off, Result); begin Get_End_Iter (Buffer, Iter); if Tag = "" then Insert (Buffer, Iter, Text & Character'Val(10)); else Table := Get_Tag_Table (Buffer); T := Lookup (Table, Tag); Insert (Buffer, Iter, Text & Character'Val(10)); Copy (Source => Iter, Dest => Start_Iter); Backward_Chars (Start_Iter, Text'Length + 1, Result); Apply_Tag (Buffer, T, Start_Iter, Iter); end if; end Insert_With_Tag; procedure On_Link_Button_Clicked (Button : access Gtk_Link_Button_Record'Class; Link : UTF8_String; Data : Boolean) is Edit_window : constant Edit_Conversions.Object_Pointer := new Edit_Window_Record_Type; Tags : Gtk_Text_Tag_Table; pragma Unreferenced (Button); Vbox : Gtk_Vbox; UI : Gtk_UI_Manager; Actions : Gtk_Action_Group; Error : aliased GError := null; File : Wide_Text_Io.File_Type; begin --Text_Io.Put_Line ("Link_Button edition clicked: " & Link); Edit_Window.Editable := Data; Initialize(Edit_Window, Gtk.Enums.Window_toplevel); Set_Title(Edit_Window, Link); Gtk_New(Tags); Gtk_New (Edit_Window.Buffer, Tags); Gtk_New (Edit_Window.View, Edit_Window.Buffer); Set_wrap_mode(Edit_Window.View, Gtk.enums. wrap_char); Gtk_New(Edit_Window.Page_Frame); Gtk.Window.Set_Default_Size(Gtk_Window(Edit_Window), 810, 600); Gtk.Window.Set_Position(Gtk_Window(Edit_Window), Gtk.Enums.Win_Pos_Center); if Link = "" then Insert_With_Tag (Edit_Window.Buffer, "", Glib.Convert.Locale_To_Utf8(Handling.To_String("-- Date := """" ; "))); Insert_With_Tag (Edit_Window.Buffer, "", Glib.Convert.Locale_To_Utf8(Handling.To_String("-- Version := """" ; "))); else Wide_Text_Io.Open(File, Wide_Text_Io.In_File, Link, Form => "WCEM=8"); while not Wide_Text_Io.End_Of_File(File) loop declare Line : constant Wide_String := UTF_Encoding.Wide_Strings.Decode(Wide_Text_Io.Get_Line(File)); begin if Line'Length > 0 then Insert_With_Tag (Edit_Window.Buffer, "", Glib.Convert.Locale_To_Utf8(Handling.To_String(Line))); else Insert_With_Tag (Edit_Window.Buffer, "", ""); end if; end; end loop; Wide_Text_Io.Close(File); end if; Set_Editable(Edit_Window.View, Data); Gtk_New (Edit_Window.Scrolled); Set_Policy (Edit_Window.Scrolled, Policy_Automatic, Policy_Always); Add (Edit_Window.Scrolled, Edit_Window.View); Add (Edit_Window.Page_Frame, Edit_Window.Scrolled); Gtk_New_Vbox(Vbox); Gtk_New (Actions, "Actions"); Add_Actions (Actions, Edit_Entries, Edit_Conversions.To_Address(Edit_Window.all'Access)); Gtk_New (UI); Insert_Action_Group (UI, Actions, 0); Add_Accel_Group (Edit_window, Get_Accel_Group (UI)); if Add_UI_From_String (UI, Edit_UI_Info, Error'Unchecked_Access) = 0 then Text_Io.Put_Line ("Building menus failed: " & Get_Message (Error)); Error_Free (Error); end if; Gtk.Action.Set_Sensitive(Get_Action(Actions, "Save"), Data); -- Pack start Menu bar : Pack_Start (Vbox, Get_Widget (UI, "/MenuBar"), False, False, 5); Pack_Start(Vbox, Edit_Window.Page_Frame, True, True); Edit_Cb_Handlers.Connect (Edit_Window, "destroy", Edit_Cb_Handlers.To_Marshaller (Edit_Destroy'Access)); Add(Edit_Window, Vbox); Show_All(Gtk_Window(Edit_Window)); end On_Link_Button_Clicked; procedure New_file(Action, Main_Window : Address) is pragma Unreferenced (Action); begin On_Link_Button_clicked (null, "", True); end New_File; procedure Open_file(Action, Main_Window : Address) is pragma Unreferenced (Action); Title : constant String := (gtkada.file_selection.File_selection_Dialog(default_dir => "")); begin if (Title'Length /= 0) and then Is_Regular_File(Title) and then (Extension(Title) = "txt" or Extension(Title) = "ads" or Extension(Title) = "adb") then On_Link_Button_clicked (null, Title, True); end if; end Open_File; function On_Button_click(Item : access Display_Item_Record; Event : Gdk.Event.Gdk_Event_Button) return Boolean is pragma Unreferenced (Event); begin On_Link_Button_clicked (null, Item.Filename(1..Index_Non_Blank(Item.Filename, Backward)), True); return False; end On_Button_click; package Link_Button_Cb is new Gtk.Handlers.Callback(Gtk_Link_Button_Record); ------------------------------------------ -- Canvas definition for Project Graph. -- ------------------------------------------ ---------------- -- Initialize -- ---------------- procedure Initialize_Main_Item (Item : access Display_Item_Record'Class; Canvas : access Interactive_Canvas_Record'Class; Name : in String; Filename : in String) is Width : constant Gint := Gint(Name'Length) * 10; begin Move(Name, Item.Name, Ada.Strings.Error, Left, ' '); Move(Filename, Item.Filename, Ada.Strings.Error, Left, ' '); Item.Canvas := Interactive_Canvas (Canvas); Item.Color := Colors(3); Item.W := Width; Item.H := 30; Item.Num := 1; Set_Screen_Size (Item, Item.W, Item.H); end Initialize_Main_Item; procedure Initialize_Lib_Item (Item : access Display_Item_Record'Class; Canvas : access Interactive_Canvas_Record'Class; Name : in String; Filename : in String; Color : in Color_Type) is Width : constant Gint := Gint(Name'Length) * 10; begin Move(Name, Item.Name, Ada.Strings.Error, Left, ' '); Move(Filename, Item.Filename, Ada.Strings.Error, Left, ' '); Item.Canvas := Interactive_Canvas (Canvas); Item.Color := Colors(Color); Item.W := Width; Item.H := 30; Item.Num := 2; Set_Screen_Size (Item, Item.W, Item.H); end Initialize_Lib_Item; --------------------- -- Add_*_Item -- --------------------- procedure Add_Main_Item (Canvas : access Interactive_Canvas_Record'Class; Name : in String; Filename : in String; Tab : in out Item_Array_Type; Index : in out Natural) is Item : constant Display_Item := new Display_Item_Record; begin Initialize_Main_Item (Item, Canvas, Name, Filename); Tab(Index+1) := Item; Index := Index + 1; Put (Canvas, Item, 800, 10); Refresh_Canvas (Canvas); Show_Item (Canvas, Item); end Add_Main_Item; procedure Add_Lib_Item (Canvas : access Interactive_Canvas_Record'Class; Name : in String; Filename : in String; X, Y : in Gint; Tab : in out Item_Array_Type; Index : in out Natural; Color : in Color_Type) is Item : constant Display_Item := new Display_Item_Record; begin Initialize_Lib_Item (Item, Canvas, Name, Filename, color); Tab(Index+1) := Item; Index := Index + 1; Put (Canvas, Item, X, Y); Refresh_Canvas (Canvas); Show_Item (Canvas, Item); end Add_Lib_Item; procedure Add_Canvas_Link (Canvas : access Interactive_Canvas_Record'Class; Item1, Item2 : access Canvas_Item_Record'Class; Text : String := ""); -- Add a link between Item1 and Item2 --------------------- -- Add_Canvas_Link -- --------------------- procedure Add_Canvas_Link (Canvas : access Interactive_Canvas_Record'Class; Item1, Item2 : access Canvas_Item_Record'Class; Text : String := "") is Link : constant Canvas_Link := new Canvas_Link_Record; begin Add_Link (Canvas, Link, Item1, Item2, End_Arrow, Text); end Add_Canvas_Link; ----------- -- Clear -- ----------- procedure Clear_Canvas (Canvas : access Interactive_Canvas_Record'Class) is function Remove_Internal (Canvas : access Interactive_Canvas_Record'Class; Item : access Canvas_Item_Record'Class) return Boolean is begin Remove (Canvas, Item); return True; end Remove_Internal; begin For_Each_Item (Canvas, Remove_Internal'Unrestricted_Access); Refresh_Canvas (Canvas); end Clear_Canvas; procedure Reverse_Canvas_Constructor(Canvas : in Canvas_Record_Access; Units : in Unit_Array_Type; Last : in Positive; As_Lib : Boolean); procedure Reverse_Canvas_Menu(Action, Main_Window : Address) is pragma Unreferenced(Action); Object : constant Gnose_Access := To_Pointer(Main_Window).all'Access; begin if Object.Gnose_Interface.Graph_set(Project_Define).Canvas/= null then Clear_Canvas(Object.Gnose_Interface.Graph_set(Project_Define).Canvas); end if; if Object.Context.Project.Proj_Library.Unit_Index > 0 then Reverse_Canvas_Constructor (Object.Gnose_Interface.Graph_Set(Project_Define), Object.Context.Project.Proj_Library.Library_Unit, Object.Context.Project.Proj_Library.Unit_Index, False ); end if; end Reverse_Canvas_Menu; procedure Reverse_Canvas_Constructor(Canvas : in Canvas_Record_Access; Units : in Unit_Array_Type; Last : in Positive; As_Lib : Boolean) is Start_Index : Positive := 2; begin Canvas.X_Ads := 400; Canvas.Y_ads := 50; Canvas.X_Adb := 200; Canvas.Y_Adb := 100; Canvas.Item_Last := 0; ---------------------------------------------------------------------- -- Adding Item to Canvas : -- if not As_Lib then Add_Main_Item( Canvas.Canvas, Units(1).Unit_Name (1..Index_Non_Blank(Units(1).Unit_Name, Backward)), Units(1).File_Name, Canvas.Item_Array, Canvas.Item_Last ); else Start_Index := 1; end if; if Last > 1 then for I in Start_index..Last loop --Text_Io.Put_Line("item 4.1"); declare Unitname : constant String := Units(I).Unit_Name (1..Index_Non_Blank(Units(I).Unit_Name, Backward)); Extension : constant String := File_Extension(units(I).Unit_Name(1..Index_Non_Blank(units(I).Unit_Name, Backward))); begin --Text_Io.Put_Line("item 4.2"); if Extension = ".ads" then Add_Lib_Item (Canvas.Canvas, Unitname, Units(I).File_Name, Canvas.X_ads, Canvas.Y_ads, Canvas.Item_Array, Canvas.Item_Last, Color => 10); Canvas.X_ads := Canvas.X_ads + 50; Canvas.Y_ads := Canvas.Y_ads + 70; --Text_Io.Put_Line("item 4.3"); else Add_Lib_Item (Canvas.Canvas, Unitname, Units(I).File_Name, Canvas.X_adb, Canvas.Y_adb, Canvas.Item_Array, Canvas.Item_Last, Color => 19); Canvas.X_adb := Canvas.X_adb + 25; Canvas.Y_adb := Canvas.Y_adb + 70; --Text_Io.Put_Line("item 4.4"); end if; end; end loop; end if; ---------------------------------------------------------------------- -- Adding Link between Item to Canvas. if Canvas.Item_Last > 0 then for I in reverse 1..Canvas.Item_Last loop declare Extension : constant String := File_Extension(Canvas.Item_Array(I).Name (1..Index_Non_Blank(Canvas.Item_Array(I).Name, Backward))); Basename : constant String := Base_Name(Canvas.Item_Array(I).Name (1..Index_Non_Blank(Canvas.Item_Array(I).Name, Backward)), extension); begin if Extension = ".adb" then declare Body_Item : constant Display_Item := Canvas.Item_Array(I); begin for J in 1..Canvas.Item_Last loop declare Item_Extension : constant String := File_Extension(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward))); Item_Basename : constant String := Base_Name(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward)), Item_Extension); begin if Item_Basename = Basename and Item_Extension = ".ads" then declare Spec_Item : constant Display_Item := Canvas.Item_Array(J); begin Add_Canvas_Link(Canvas.Canvas, Body_Item, Spec_Item, "implementation"); end; end if; end; end loop; end; end if; declare File : Wide_Text_Io.File_Type; Filename : constant String := Canvas.Item_Array(I).Filename (1..Index_Non_Blank(Canvas.Item_Array(I).Filename, Backward)); begin Wide_Text_Io.Open(File, Wide_Text_Io.In_File, Filename, Form => "WCEM=8"); while not Wide_Text_Io.End_Of_File(File) loop declare Line : constant Wide_String := UTF_Encoding.Wide_Strings.Decode(Wide_Text_Io.Get_Line(File)); The_Index : Natural := 0; begin --Wide_Text_Io.Put_Line(Line); if Wide_Fixed.Index(Line, "package") /= 0 or Wide_Fixed.Index(Line, "procedure") /= 0 or Wide_Fixed.Index(Line, "function") /= 0 or Wide_Fixed.Index(Line, "genric")/= 0 then exit; end if; if Line'Length > 0 then The_Index := Wide_Fixed.Index(Line, "--"); if ((The_Index /= 0) and then Wide_Fixed.Index(Line, "with") > The_Index) then null; elsif Wide_Fixed.Index(Line, "with") /= 0 then The_Index := Wide_Fixed.Index(Line, "with"); while The_Index /= 0 loop declare End_Of : constant Natural := Wide_Fixed.Index(Line, ";", The_index); Section : constant String := Handling.To_Lower (Handling.To_String (Line(Wide_Fixed.Index_Non_Blank(Line, The_Index + 5)..End_Of -1))); Section_Dot : constant Natural := Index(Section, "."); begin if Section_Dot /= 0 then for J in 1..Canvas.Item_Last loop declare Item_Extension : constant String := File_Extension(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward))); Item_Basename : constant String := Base_Name(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward)), Item_Extension); Doted_Basename : constant String := Translate(Item_Basename, Maps.To_Mapping("-", ".")); begin if Doted_Basename = section then if Item_Extension = ".ads" then declare Spec_Item : constant Display_Item := Canvas.Item_Array(J); begin Add_Canvas_Link (Canvas.Canvas, Canvas.Item_Array(I), Spec_Item, Basename & " depend of " & section); end; end if; end if; end; end loop; else for J in 1..Canvas.Item_Last loop declare Item_Extension : constant String := File_Extension(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward))); Item_Basename : constant String := Base_Name(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward)), Item_Extension); Doted_Basename : constant String := Translate(Item_Basename, Maps.To_Mapping("-", ".")); begin if Doted_Basename = section then if Item_Extension = ".ads" then declare Spec_Item : constant Display_Item := Canvas.Item_Array(J); begin Add_Canvas_Link (Canvas.Canvas, Canvas.Item_Array(I), Spec_Item, Basename & " depend of " & section); end; end if; end if; end; end loop; end if; end; if The_Index + 5 < Line'Length then The_Index := Wide_Fixed.Index(Line, "with", The_Index + 5); end if; end loop; end if; end if; end; end loop; Wide_Text_Io.Close(File); end; end; end loop; end if; --Text_Io.Put_Line("End of reverse Graph construction"); end Reverse_Canvas_Constructor; procedure Canvas_Project_Constructor(Canvas : in Canvas_Record_Access; Units : in Unit_Array_Type; Last : in Positive; As_Lib : Boolean) is Start_Index : Positive := 2; begin Canvas.X_Ads := 400; Canvas.Y_ads := 50; Canvas.X_Adb := 200; Canvas.Y_Adb := 100; Canvas.Item_Last := 0; ---------------------------------------------------------------------- -- Adding Item to Canvas : -- if not As_Lib then Add_Main_Item( Canvas.Canvas, Units(1).Unit_Name (1..Index_Non_Blank(Units(1).Unit_Name, Backward)), Units(1).File_Name, Canvas.Item_Array, Canvas.Item_Last ); else Start_Index := 1; end if; if Last > 1 then for I in reverse Start_index..Last loop --Text_Io.Put_Line("item 4.1"); declare Unitname : constant String := Units(I).Unit_Name (1..Index_Non_Blank(Units(I).Unit_Name, Backward)); Extension : constant String := File_Extension(units(I).Unit_Name(1..Index_Non_Blank(units(I).Unit_Name, Backward))); begin --Text_Io.Put_Line("item 4.2"); if Extension = ".ads" then Add_Lib_Item (Canvas.Canvas, Unitname, Units(I).File_Name, Canvas.X_ads, Canvas.Y_ads, Canvas.Item_Array, Canvas.Item_Last, Color => 10); Canvas.X_ads := Canvas.X_ads + 50; Canvas.Y_ads := Canvas.Y_ads + 70; --Text_Io.Put_Line("item 4.3"); else Add_Lib_Item (Canvas.Canvas, Unitname, Units(I).File_Name, Canvas.X_adb, Canvas.Y_adb, Canvas.Item_Array, Canvas.Item_Last, Color => 19); Canvas.X_adb := Canvas.X_adb + 25; Canvas.Y_adb := Canvas.Y_adb + 70; --Text_Io.Put_Line("item 4.4"); end if; end; end loop; end if; ---------------------------------------------------------------------- -- Adding Link between Item to Canvas. if Canvas.Item_Last > 0 then for I in reverse 1..Canvas.Item_Last loop declare Extension : constant String := File_Extension(Canvas.Item_Array(I).Name (1..Index_Non_Blank(Canvas.Item_Array(I).Name, Backward))); Basename : constant String := Base_Name(Canvas.Item_Array(I).Name (1..Index_Non_Blank(Canvas.Item_Array(I).Name, Backward)), extension); begin if Extension = ".adb" then declare Body_Item : constant Display_Item := Canvas.Item_Array(I); begin for J in 1..Canvas.Item_Last loop declare Item_Extension : constant String := File_Extension(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward))); Item_Basename : constant String := Base_Name(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward)), Item_Extension); begin if Item_Basename = Basename and Item_Extension = ".ads" then declare Spec_Item : constant Display_Item := Canvas.Item_Array(J); begin Add_Canvas_Link(Canvas.Canvas, Body_Item, Spec_Item, "implementation"); end; end if; end; end loop; end; end if; declare File : Wide_Text_Io.File_Type; Filename : constant String := Canvas.Item_Array(I).Filename (1..Index_Non_Blank(Canvas.Item_Array(I).Filename, Backward)); begin Wide_Text_Io.Open(File, Wide_Text_Io.In_File, Filename, Form => "WCEM=8"); while not Wide_Text_Io.End_Of_File(File) loop declare Line : constant Wide_String := UTF_Encoding.Wide_Strings.Decode(Wide_Text_Io.Get_Line(File)); The_Index : Natural := 0; begin --Wide_Text_Io.Put_Line(Line); if Wide_Fixed.Index(Line, "package") /= 0 or Wide_Fixed.Index(Line, "procedure") /= 0 or Wide_Fixed.Index(Line, "function") /= 0 or Wide_Fixed.Index(Line, "genric")/= 0 then exit; end if; if Line'Length > 0 then The_Index := Wide_Fixed.Index(Line, "--"); if ((The_Index /= 0) and then Wide_Fixed.Index(Line, "with") > The_Index) then null; elsif Wide_Fixed.Index(Line, "with") /= 0 then The_Index := Wide_Fixed.Index(Line, "with"); while The_Index /= 0 loop declare End_Of : constant Natural := Wide_Fixed.Index(Line, ";", The_index); Section : constant String := Handling.To_Lower (Handling.To_String (Line(Wide_Fixed.Index_Non_Blank(Line, The_Index + 5)..End_Of -1))); Section_Dot : constant Natural := Index(Section, "."); begin if Section_Dot /= 0 then for J in 1..Canvas.Item_Last loop declare Item_Extension : constant String := File_Extension(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward))); Item_Basename : constant String := Base_Name(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward)), Item_Extension); Doted_Basename : constant String := Translate(Item_Basename, Maps.To_Mapping("-", ".")); begin if Doted_Basename = section then if Item_Extension = ".ads" then declare Spec_Item : constant Display_Item := Canvas.Item_Array(J); begin Add_Canvas_Link (Canvas.Canvas, Canvas.Item_Array(I), Spec_Item, Basename & " depend of " & section); end; end if; end if; end; end loop; else for J in 1..Canvas.Item_Last loop declare Item_Extension : constant String := File_Extension(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward))); Item_Basename : constant String := Base_Name(Canvas.Item_Array(J).Name (1..Index_Non_Blank(Canvas.Item_Array(J).Name, Backward)), Item_Extension); Doted_Basename : constant String := Translate(Item_Basename, Maps.To_Mapping("-", ".")); begin if Doted_Basename = section then if Item_Extension = ".ads" then declare Spec_Item : constant Display_Item := Canvas.Item_Array(J); begin Add_Canvas_Link (Canvas.Canvas, Canvas.Item_Array(I), Spec_Item, Basename & " depend of " & section); end; end if; end if; end; end loop; end if; end; if The_Index + 5 < Line'Length then The_Index := Wide_Fixed.Index(Line, "with", The_Index + 5); end if; end loop; end if; end if; end; end loop; Wide_Text_Io.Close(File); end; end; end loop; end if; --Text_Io.Put_Line("End of Graph construction"); end Canvas_Project_Constructor; procedure Page_Switched (Notebook : access Gtk_Notebook_Record'Class; User_Data : in Object_Pointer) is Old_Page : constant Gint := Gtk.Notebook.Get_Current_Page(Notebook); begin if User_Data.Gnose_Interface.Graph_set(Machine_Lang_Enum'Val(Old_Page)) /= null then Text_Io.Put_line(Machine_Lang_Enum'Image(Machine_Lang_Enum'Val(Old_Page))); end if; end Page_Switched; procedure Notebook_set (Notebook : access Gtk_Notebook_Record'Class; Set : in out Canvas_Set; Lib : in Library_Record_Type; Machine_Lang : in Machine_Lang_Enum) is Label : Gtk_Label; As_Lib : constant Boolean := not (Machine_Lang = Project_Define); begin Text_Io.Put_Line("Graph construction for Language : " & Machine_Lang_Enum'Image(Machine_Lang)); Set(Machine_Lang) := new Canvas_Record_Type; Gtk_New(Set(Machine_Lang).Frame, Machine_Lang_Enum'Image(Machine_Lang)); Gtk_New(Set(Machine_Lang).Scroll); Gtk_New_Vbox(Set(Machine_Lang).Box); Pack_Start(Set(Machine_Lang).Box, Set(Machine_Lang).Scroll); --Set_USize (Set(Machine_Lang).Scroll, Canvas_Width, Canvas_Height);  Add(Set(Machine_Lang).Frame, Set(Machine_Lang).Box); Set(Machine_Lang).Canvas := new Image_Canvas_Record; Initialize(Set(Machine_Lang).Canvas); --Set_Orthogonal_Links(Set(Machine_Lang).Canvas, True); Configure(Set(Machine_Lang).Canvas); Gtk_New(Label, Machine_Lang_Enum'Image(Machine_Lang)); Add(Set(Machine_Lang).Scroll, Set(Machine_Lang).Canvas); Append_Page (Notebook, Child => Set(Machine_Lang).Frame, Tab_Label => Label); Set(Machine_Lang).Layout := Create_Pango_Layout (set(Machine_Lang).Scroll); Canvas_Project_Constructor (Set(Machine_Lang), Lib.Library_Unit, Lib.Unit_Index, As_Lib ); end Notebook_Set; procedure View_Window (Button : access Gtk_Link_Button_Record'Class) is begin On_Link_Button_Clicked(null, Get_Uri(Button), False); end View_Window; procedure Edit_Window (Button : access Gtk_Link_Button_Record'Class) is begin On_Link_Button_Clicked(null, Get_Uri(Button), True); end Edit_Window; procedure Load_Machine_Box(Object : in Object_Pointer; Lib : in Library_Record_Type; Machine_Lang : in Machine_Lang_Enum) is Link_Button : Gtk_Link_Button; Hbox : Gtk_Hbox; begin --Text_Io.Put_Line("Loading box"); for I in 1..Lib.Unit_Index loop --Text_Io.Put_Line("init names"); declare Filename : constant String := Lib.Library_Unit(I).File_Name (1..Index_Non_Blank(Lib.Library_Unit(I).File_Name, Backward)); Unitname : constant String := Lib.Library_Unit(I).Unit_Name (1..Index_Non_Blank(Lib.Library_Unit(I).Unit_Name, Backward)); begin --Text_Io.Put_Line("Add names"); Gtk_New_Hbox(Hbox); Gtk_New_With_Label (Widget => Link_Button, Uri => Filename, Label => Unitname); case Machine_Lang is when Ada_2012 | Ada_Web_Server | Gtk_Ada => Link_Button_CB.Connect (Link_Button, "clicked", Link_Button_CB.To_Marshaller(View_window'Access)); when others => Link_Button_CB.Connect (Link_Button, "clicked", Link_Button_CB.To_Marshaller(Edit_window'Access)); end case; --Text_Io.Put_Line("Add link buton"); Pack_Start(Hbox, Link_Button, False, False, 0); --Text_Io.Put_Line("Link added"); Pack_Start(Object.Gnose_Interface.Language_Set(Machine_Lang).box, Hbox, False, False, 2); --Text_Io.Put_Line("Box added"); end; end loop; end Load_Machine_box; procedure Machine_Init (Machine : in out Machine_Language_Frame_Type; Machine_Lang : in Machine_Lang_Enum) is begin Gtk_New(Machine.Frame, Machine_Lang_Enum'Image(Machine_Lang)); --Set_USize (Machine.Frame, 150, 100); Gtk_New_Vbox(Machine.Box); Gtk_New(Machine.Scroll); Add_With_viewport(Machine.Scroll, Machine.Box); Add(Machine.Frame, Machine.Scroll); end Machine_init; ---------------------------------------------------------- -- Reload Project... -- ---------------------------------------------------------- procedure Reload_Project(Object : in Object_Pointer) is begin if Object.Context.Project /= null and then Object.Context.Project.Project_Name /= null then loop declare Child : constant Gtk.Widget.Gtk_Widget := Get_Child(Object.Gnose_Interface.Language_Set(Project_Define).box, 0); begin if Gtk.Widget."/="(Child,null) then Remove(Object.Gnose_Interface.Language_Set(Project_Define).box, Child); else exit; end if; end; end loop; end if; Agnose.Load_Project(Object.Context.all, Ada_Path, Gtk_Path, Aws_Path, Pro_Path); for Machine_Lang in Machine_Lang_Enum'Range loop case Machine_Lang is when Project_Define => if Object.Context.Project /= null and then Object.Context.Project.Project_Name /= null then Load_Machine_Box(Object, Object.Context.Project.Proj_Library, Machine_Lang); if Object.Gnose_Interface.Graph_set(Machine_Lang).Canvas/= null then Clear_Canvas(Object.Gnose_Interface.Graph_set(Machine_Lang).Canvas); end if; if Object.Context.Project.Proj_Library.Unit_Index > 0 then Canvas_Project_Constructor (Object.Gnose_Interface.Graph_Set(Machine_Lang), Object.Context.Project.Proj_Library.Library_Unit, Object.Context.Project.Proj_Library.Unit_Index, False ); end if; end if; when Ada_2012 => Text_Io.Put_Line("Reaload Ada 2012"); if Object.Context.projects_Params.With_ada then Text_Io.Put_Line("with Ada is setted"); Load_Machine_Box(Object, Object.Context.Project.Ada_Library, Machine_Lang); Text_Io.Put_Line("clear canvas"); Clear_Canvas(Object.Gnose_Interface.Graph_set(Machine_Lang).Canvas); if Object.Context.Project.Ada_Library.Unit_Index > 0 then Canvas_Project_Constructor (Object.Gnose_Interface.Graph_Set(Machine_Lang), Object.Context.Project.Ada_Library.Library_Unit, Object.Context.Project.Ada_Library.Unit_Index, True ); end if; end if; when Ada_Web_server => Text_Io.Put_Line("Reaload AWS"); if Object.Context.projects_Params.With_aws then Load_Machine_Box(Object, Object.Context.Project.Aws_Library, Machine_Lang); Clear_Canvas(Object.Gnose_Interface.Graph_set(Machine_Lang).Canvas); if Object.Context.Project.Aws_Library.Unit_Index > 0 then Canvas_Project_Constructor (Object.Gnose_Interface.Graph_Set(Machine_Lang), Object.Context.Project.Aws_Library.Library_Unit, Object.Context.Project.Aws_Library.Unit_Index, True ); end if; end if; when Gtk_Ada => Text_Io.Put_Line("Reaload GtkAda"); if Object.Context.projects_Params.With_Gtk then Load_Machine_Box(Object, Object.Context.Project.Gtk_Library, Machine_Lang); Clear_Canvas(Object.Gnose_Interface.Graph_set(Machine_Lang).Canvas); if Object.Context.Project.Gtk_Library.Unit_Index > 0 then Canvas_Project_Constructor (Object.Gnose_Interface.Graph_Set(Machine_Lang), Object.Context.Project.Gtk_Library.Library_Unit, Object.Context.Project.Gtk_Library.Unit_Index, True ); end if; end if; end case; end loop; Show_All(Gtk_Window(Object.Gnose_interface)); end Reload_Project; package Common_Notebook_Cb is new Gtk.Handlers.User_Callback (Gtk_Notebook_Record, Object_Pointer); Null_Args : Argument_List(1..0); procedure On_change(Text : access Gtk_Text_Buffer_record'Class; Main : Object_Pointer); package User_Cb_Handlers is new Gtk.Handlers.User_Callback(Gtk.Text_buffer.Gtk_Text_Buffer_record, Object_pointer); procedure On_change(Text : access Gtk_Text_Buffer_record'Class; Main : Object_Pointer) is Top : Gtk_Text_Iter; Bot : Gtk_Text_Iter; Pos : Gint := 0; Mark : Gtk.Text_Mark.Gtk_Text_Mark; Result : Results.Spawn_Result_Type; begin Get_Bounds(Text, Top, Bot); declare Line : constant Wide_String := Handling.To_Wide_String(Glib.Convert.Locale_From_Utf8(Get_Slice(Text, Top, Bot))); begin Pos := Get_Char_count(Text); if Pos - 1 > Gint(Main.Gnose_Interface.User_Position) then if (Line'Length /= 0) and then (Line(Line'Last) = Wide_character'Val(10)) then declare New_Entry : constant Wide_String := Line(Positive(Main.Gnose_Interface.User_Position+1)..Line'Last-1); Non_Blank : constant Natural := Wide_Fixed.Index_Non_Blank(New_Entry); begin if Non_Blank = 0 then return; end if; Wide_Text_Io.Put_Line(New_Entry); Result := Results.Spawn(UTF_Encoding.Strings.Encode(Expand_Filename(Handling.To_String(New_Entry)))); if Result.File_Content /= null then Disconnect(Text, Main.Gnose_Interface.User_Handler); for I in Result.File_Content'Range loop Insert_With_Tag(Main.Gnose_Interface.User_Text_buffer, "", Glib.Convert.Locale_To_Utf8(Handling.To_String(UTF_Encoding.Wide_Strings.Decode(-(Result.File_Content(I)))))); end loop; Main.Gnose_Interface.User_Handler := User_Cb_Handlers.Connect (Main.Gnose_Interface.User_Text_Buffer, "changed", User_Cb_Handlers.To_Marshaller (On_change'Access), Main); Main.Gnose_Interface.User_Position := Integer(Get_char_count(Main.Gnose_Interface.User_Text_Buffer)); Get_Bounds(Main.Gnose_Interface.User_Text_buffer, Top, Bot); Mark := Create_Mark(Main.Gnose_Interface.User_Text_buffer, Where => Bot); Scroll_To_Mark(Main.Gnose_Interface.User_Text_view, Mark, 0.0, false, 0.0, 0.0); end if; end; end if; end if; end; end On_Change; ---------------------------------------------------------------------------------------- -- Initialization of Gnose record with Gnose_Interface with GtkAda. -- ---------------------------------------------------------------------------------------- type Gtk_Parameter_Record(Flag : Parameters_Flags_Enum_Type) is tagged record Label : Gtk_Label; end record; type Gtk_Parameters_Array is array (Parameters_Flags_Enum_Type) of access Gtk_Parameter_record; procedure Initialize_Parameters(Frame : access Gtk_Frame_Record'Class; Object : in Object_Pointer) is Box : Gtk_Vbox; Scroll : Gtk_Scrolled_Window; Hbox : Gtk_Hbox; -- Parameters widgets : Gtk_Parameters : Gtk_Parameters_Array; begin for Flag in Gtk_Parameters'Range loop case Flag is when Null_Parameter | Version_Edition | Help => null; when others => Gtk_Parameters(Flag) := new Gtk_Parameter_Record(Flag); end case; end loop; Gtk_New_Vbox(Box, False, 0); Gtk_New(Scroll); Add_With_Viewport(Scroll, Box); for Flag in Gtk_Parameters'Range loop Text_Io.Put_Line("params'flag => " & Parameters_Flags_Enum_Type'Image(Flag)); case Flag is when Null_Parameter | Version_Edition | Help => null; when others => if Get_Parameter(Object.Context.Gnose_Params.Kit, Flag).Is_Setted then case Flag is when Config_Filename => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Handling.To_String (Get_Parameter(Object.Context.Gnose_Params.Kit, Flag).Value.all)); Pack_Start(Box, Gtk_Parameters(Flag).Label, False, false); when Name_Length => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Name_Index_Type'Image(Object.Context.Language_Params.Name_length)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when Unit_Max => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Unit_Index_Type'Image(Object.Context.Language_Params.Unit_Max)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when Char_Max => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Char_Index_Type'Image(Object.Context.Objects_Params.Char_Max)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when Version => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Version_Index_Type'Image(Object.Context.system_Params.version)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when Object_Max => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Object_Index_Type'Image(Object.Context.System_Params.Objects_Max)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when Self_Programming => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Boolean'Image(Object.Context.Neural_Params.Self_programming)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when Self_Executed => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Boolean'Image(Object.Context.Neural_Params.Self_Executed)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when Self_Wait => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Image(Object.Context.Gnose_Params.Self_wait)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when User_Wait => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Image(Object.Context.Gnose_Params.user_wait)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when Human_Lang => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Human_Lang_Enum'Image(Object.Context.Gnose_Params.Human_lang)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when With_Gtk => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Boolean'Image(Object.Context.Language_Params.With_Gtk)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when With_Ada => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Boolean'Image(Object.Context.Language_Params.With_Ada)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when With_Aws => Gtk_New(Gtk_Parameters(Flag).Label, Parameters_Flags_Enum_Type'Image(Flag) & " := " & Boolean'Image(Object.Context.Language_Params.With_Aws)); Gtk_New_Hbox(Hbox); Pack_Start(Hbox, Gtk_Parameters(Flag).Label, False, False); Pack_Start(Box, Hbox, False, False); when others => null; end case; end if; end case; end loop; Add(Frame, Scroll); Show_All(Frame); end Initialize_Parameters; function Gnose_initialize (Gnose_Context : access Gnose_Context_Record; Gnose_Params : access Gnose_Parameters_Type) return Gnose_Access is Gnostic : constant Object_Pointer := new Gnose_Record; Label : Gtk_Label; Error : aliased GError := null; begin Text_Io.Put_Line("Going to Gtk_Window initialization..."); -- Initialize the colors for J in Color_Names'Range loop Colors (J) := Parse (Color_Names (J).all); --Alloc (Gtk.Widget.Get_Default_Colormap, Colors (J)); end loop; --Text_Io.Put_Line("Colors set initialized."); declare begin --Text_Io.Put_Line("new gnose_interafce"); Gnostic.Gnose_Interface := new Gnose_Interface_Record; --Text_Io.Put_Line("self Link gnose_interafce"); Gnostic.Gnose_Interface.Gnostic := Gnostic.all'access; --Text_Io.Put_Line("gnostic context := gnose_context"); Gnostic.Context := new gnose_context_record ' (Gnose_Context.All); --Text_Io.Put_Line("new neural system set"); Gnostic.System.Neural_Set := new Neural_Set_Array_Type(En..Fr); --Text_Io.Put_Line("Load network"); for Human_Lang in Gnostic.System.Neural_Set'Range loop Load_network(Gnostic.System.Neural_Set.all, Human_Lang); end loop; Gnostic.System.Neural_Lang := Gnostic.Context.Gnose_Params.Human_Lang; --Text_Io.Put_Line("new Language_set"); Gnostic.System.Language_Set := new Language_Set_Array_Type(Machine_Lang_Enum'range); --Text_Io.Put_Line("Loading Project and Libraries"); for Machine_Lang in Gnostic.System.Language_Set'Range loop case Machine_Lang is when Project_Define => Load_Language(Gnostic.System.Language_Set.all, Machine_Lang); when Gtk_Ada => if Gnostic.Context.projects_Params.With_Gtk then Load_Language(Gnostic.System.Language_Set.all, Machine_Lang); end if; when Ada_Web_Server => if Gnostic.Context.projects_Params.With_Aws then Load_Language(Gnostic.System.Language_Set.all, Machine_Lang); end if; when Ada_2012 => if Gnostic.Context.projects_Params.With_Ada then Load_Language(Gnostic.System.Language_Set.all, Machine_Lang); end if; end case; end loop; Text_Io.Put_Line("Machines initilaized..."); Gtk.Window.Initialize (Gtk_Window_record(Gnostic.Gnose_interface.all)'access, Gtk.Enums.Window_Toplevel); Text_Io.Put_Line("Loading project..."); Text_Io.New_Line; Agnose.Load_Project(Gnostic.Context.all, Ada_Path, Gtk_Path, Aws_Path, Pro_Path); Text_Io.New_Line; Text_Io.Put_Line("Project loaded."); ------------------------------------------------------------------------------------- -- Begin of Window construction : Gtk_New(Gnostic.Gnose_Interface.System_Frame.Frame, "system"); --Set_USize (Gnostic.Gnose_Interface.System_Frame.frame, 600, 200); Gtk_New_Vbox(Gnostic.Gnose_Interface.System_Frame.Box); Gtk_New(Gnostic.Gnose_Interface.System_Text_buffer); Gtk_New(Gnostic.Gnose_Interface.System_Text_View, Gnostic.Gnose_Interface.System_Text_Buffer); Set_Editable(Gnostic.Gnose_Interface.System_Text_View, False); Gtk_New(Gnostic.Gnose_Interface.System_Scroll); Add(Gnostic.Gnose_Interface.System_Scroll, Gnostic.Gnose_Interface.System_Text_View); Pack_Start(Gnostic.Gnose_Interface.System_Frame.Box, Gnostic.Gnose_Interface.System_Scroll); Add(Gnostic.Gnose_Interface.System_Frame.Frame, Gnostic.Gnose_Interface.System_Frame.Box); Text_Io.Put_Line("System frame"); Gtk_New(Gnostic.Gnose_Interface.user_Frame.Frame, "user"); --Set_USize (Gnostic.Gnose_Interface.User_Frame.frame, 600, 200); Gtk_New_Vbox(Gnostic.Gnose_Interface.user_Frame.Box); Gtk_New(Gnostic.Gnose_Interface.User_Text_buffer); Gtk_New(Gnostic.Gnose_Interface.User_Text_View, Gnostic.Gnose_Interface.User_Text_buffer); Set_Accepts_Tab(Gnostic.Gnose_Interface.User_Text_view, False); --Set_Editable(Gnostic.Gnose_Interface.User_Text_view, True); Gtk_New(Gnostic.Gnose_Interface.User_Scroll); Add(Gnostic.Gnose_Interface.User_Scroll, Gnostic.Gnose_Interface.User_Text_View); Pack_Start(Gnostic.Gnose_Interface.user_Frame.Box, Gnostic.Gnose_Interface.User_scroll); Add(Gnostic.Gnose_Interface.user_Frame.Frame, Gnostic.Gnose_Interface.user_Frame.Box); Gnostic.Gnose_Interface.User_Handler := User_Cb_Handlers.Connect (Gnostic.Gnose_Interface.User_Text_Buffer, "changed", User_Cb_Handlers.To_Marshaller (On_change'Access), gnostic); Text_Io.Put_Line("user interfcae frame"); Gtk_New(Gnostic.Gnose_Interface.Parmeters_Frame.Frame,"parameters"); Initialize_Parameters(Gnostic.Gnose_Interface.Parmeters_Frame.Frame, Gnostic); Text_Io.Put_Line("parameters frame initialized"); Gtk_New(Gnostic.Gnose_Interface.Graph_Book); --Text_Io.Put_Line("new graph book");  Gtk_New_Vpaned(Gnostic.Gnose_Interface.Main_Pan); Gtk_New_Hpaned(Gnostic.Gnose_Interface.Bot_Main_Pan); Pack1(Gnostic.Gnose_Interface.Main_Pan, Gnostic.Gnose_Interface.Graph_Book, False, False); Text_Io.Put_Line("Machine initialization"); for Machine_Lang in Machine_Lang_Enum'Range loop case Machine_Lang is when Project_Define => if Gnostic.Context.Project.Proj_Library.Unit_Index > 0 then --Text_Io.Put_Line("new project frame"); Gnostic.Gnose_Interface.Language_Set(Machine_Lang) := new Machine_Language_Frame_Type; --Text_Io.Put_Line("Machine_init"); Machine_Init(Gnostic.Gnose_Interface.Language_Set(Machine_Lang).all, Machine_Lang); --Text_Io.Put_Line("Load_Machine_box"); Load_Machine_Box(Gnostic, Gnostic.Context.Project.Proj_Library, Machine_Lang); --Text_Io.Put_Line("Notebook set"); Notebook_Set(Gnostic.Gnose_Interface.Graph_Book, Gnostic.Gnose_Interface.Graph_Set, Gnostic.Context.Project.Proj_Library, Project_Define); --Text_Io.Put_Line("Project frames initialized."); else Gnostic.Gnose_Interface.Graph_Set(Machine_Lang) := new Canvas_Record_Type; Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Canvas := new Image_Canvas_Record; Initialize(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Canvas); Configure(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Canvas); Gnostic.Gnose_Interface.Language_Set(Machine_Lang) := new Machine_Language_Frame_Type; Machine_Init(Gnostic.Gnose_Interface.Language_Set(Machine_Lang).all, Machine_Lang); Gtk_New(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Machine_Lang_Enum'Image(Machine_Lang)); Gtk_New(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Scroll); Add(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Scroll); Gtk_New(Label, Machine_Lang_Enum'Image(Machine_Lang)); Add(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Scroll, Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Canvas); Append_Page (Gnostic.Gnose_Interface.Graph_Book, Child => Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Tab_Label => Label); Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Layout := Create_Pango_Layout (Gnostic.Gnose_Interface.Graph_set(Machine_Lang).Scroll); --Text_Io.Put_Line("Project Canvas appened"); end if; when Gtk_Ada => if Gnostic.Context.Projects_Params.With_Gtk then Gnostic.Gnose_Interface.Language_Set(Machine_Lang) := new Machine_Language_Frame_Type; if Gnostic.Context.Project.Gtk_Library.Unit_Index > 0 then Machine_Init(Gnostic.Gnose_Interface.Language_Set(Machine_Lang).all, Machine_Lang); Load_Machine_Box(Gnostic, Gnostic.Context.Project.Gtk_Library, Machine_Lang); Notebook_Set(Gnostic.Gnose_Interface.Graph_Book, Gnostic.Gnose_Interface.Graph_Set, Gnostic.Context.Project.Gtk_Library, Gtk_Ada); end if; else Gnostic.Gnose_Interface.Graph_Set(Machine_Lang) := new Canvas_Record_Type; Gnostic.Gnose_Interface.Language_Set(Machine_Lang) := new Machine_Language_Frame_Type; Machine_Init(Gnostic.Gnose_Interface.Language_Set(Machine_Lang).all, Machine_Lang); Gtk_New(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Machine_Lang_Enum'Image(Machine_Lang)); Gtk_New(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Scroll); Add(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Scroll); Gtk_New(Label, Machine_Lang_Enum'Image(Machine_Lang)); Append_Page (Gnostic.Gnose_Interface.Graph_Book, Child => Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Tab_Label => Label); end if; when Ada_Web_Server => if Gnostic.Context.Projects_Params.With_Aws then Gnostic.Gnose_Interface.Language_Set(Machine_Lang) := new Machine_Language_Frame_Type; if Gnostic.Context.Project.Aws_Library.Unit_Index > 0 then Machine_Init(Gnostic.Gnose_Interface.Language_Set(Machine_Lang).all, Machine_Lang); Load_Machine_Box(Gnostic, Gnostic.Context.Project.Aws_Library, Machine_Lang); Notebook_Set(Gnostic.Gnose_Interface.Graph_Book, Gnostic.Gnose_Interface.Graph_Set, Gnostic.Context.Project.Aws_Library, Ada_Web_server); end if; else Gnostic.Gnose_Interface.Graph_Set(Machine_Lang) := new Canvas_Record_Type; Gnostic.Gnose_Interface.Language_Set(Machine_Lang) := new Machine_Language_Frame_Type; Machine_Init(Gnostic.Gnose_Interface.Language_Set(Machine_Lang).all, Machine_Lang); Gtk_New(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Machine_Lang_Enum'Image(Machine_Lang)); Gtk_New(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Scroll); Add(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Scroll); Gtk_New(Label, Machine_Lang_Enum'Image(Machine_Lang)); Append_Page (Gnostic.Gnose_Interface.Graph_Book, Child => Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Tab_Label => Label); end if; when Ada_2012 => if Gnostic.Context.Projects_Params.With_Ada then Gnostic.Gnose_Interface.Language_Set(Machine_Lang) := new Machine_Language_Frame_Type; if Gnostic.Context.Project.Ada_Library.Unit_Index > 0 then Machine_Init(Gnostic.Gnose_Interface.Language_Set(Machine_Lang).all, Machine_Lang); Load_Machine_Box(Gnostic, Gnostic.Context.Project.Ada_Library, Machine_Lang); Notebook_Set(Gnostic.Gnose_Interface.Graph_Book, Gnostic.Gnose_Interface.Graph_Set, Gnostic.Context.Project.Ada_Library, Ada_2012); end if; else Gnostic.Gnose_Interface.Graph_Set(Machine_Lang) := new Canvas_Record_Type; Gnostic.Gnose_Interface.Language_Set(Machine_Lang) := new Machine_Language_Frame_Type; Machine_Init(Gnostic.Gnose_Interface.Language_Set(Machine_Lang).all, Machine_Lang); Gtk_New(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Machine_Lang_Enum'Image(Machine_Lang)); Gtk_New(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Scroll); Add(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Scroll); Gtk_New(Label, Machine_Lang_Enum'Image(Machine_Lang)); Append_Page (Gnostic.Gnose_Interface.Graph_Book, Child => Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Frame, Tab_Label => Label); end if; end case; end loop; --Text_Io.Put_Line("Graph book added."); Pack2(Gnostic.Gnose_Interface.Main_Pan, Gnostic.Gnose_Interface.Bot_Main_Pan, False, False); Set_Position(Gnostic.Gnose_Interface.Bot_Main_Pan, 250); Gtk_New_Hpaned(Gnostic.Gnose_Interface.Bot_Second_Pan); Pack1(Gnostic.Gnose_Interface.Bot_Main_Pan, Gnostic.Gnose_Interface.Bot_Second_Pan, False, False); Gtk_New_Vpaned(Gnostic.Gnose_Interface.First_Machines_Left_Pan); Gtk_New_Vpaned(Gnostic.Gnose_Interface.Second_Machines_Left_Pan); Pack1(Gnostic.Gnose_Interface.First_Machines_Left_Pan, Gnostic.Gnose_Interface.Second_Machines_Left_Pan, False, False); --Text_Io.Put_Line("Language_set initialization...."); if Gnostic.Gnose_Interface.Language_Set(Gtk_Ada) /= null then Pack1(Gnostic.Gnose_Interface.Second_Machines_Left_Pan, Gnostic.Gnose_Interface.Language_Set(Gtk_Ada).Frame); end if; --Text_Io.Put_Line("Gtkada added.."); if Gnostic.Gnose_Interface.Language_Set(Ada_2012) /= null then Pack2(Gnostic.Gnose_Interface.Second_Machines_Left_Pan, Gnostic.Gnose_Interface.Language_Set(Ada_2012).Frame); end if; --Text_Io.Put_Line("Ada added.."); if Gnostic.Gnose_Interface.Language_Set(Ada_Web_Server) /= null then Pack2(Gnostic.Gnose_Interface.First_Machines_Left_Pan, Gnostic.Gnose_Interface.Language_Set(Ada_Web_Server).Frame); end if; --Text_Io.Put_Line("AWS added.."); --Text_Io.Put_Line("Language_set initialized;"); Pack1(Gnostic.Gnose_Interface.Bot_Second_Pan, Gnostic.Gnose_Interface.First_Machines_Left_Pan, False, False); Set_Position(Gnostic.Gnose_Interface.Bot_second_Pan, 250); Gtk_New_Vpaned(Gnostic.Gnose_Interface.Human_Pan); Pack1(Gnostic.Gnose_Interface.Human_Pan, Gnostic.Gnose_Interface.System_Frame.Frame, False, False); Pack2(Gnostic.Gnose_Interface.Human_Pan, Gnostic.Gnose_Interface.User_Frame.frame, False, False); Set_Position(Gnostic.Gnose_Interface.Human_Pan, 250); Pack2(Gnostic.Gnose_Interface.bot_Second_Pan, Gnostic.Gnose_Interface.Human_Pan, False, False); Gtk_New_Vpaned(Gnostic.Gnose_Interface.Project_Pan); Pack2(Gnostic.Gnose_Interface.Bot_Main_Pan, Gnostic.Gnose_Interface.Project_Pan, False, False); Set_Position(Gnostic.Gnose_Interface.Bot_Main_Pan, 800); --Text_Io.Put_Line("Add project Frame"); if Gnostic.Gnose_Interface.Language_Set(Project_Define) /= null then Pack1(Gnostic.Gnose_Interface.Project_Pan,Gnostic.Gnose_Interface.Language_Set(Project_Define).frame , False, False); end if; Pack2(Gnostic.Gnose_Interface.Project_Pan, Gnostic.Gnose_Interface.Parmeters_Frame.Frame , False, False); ------------------------------------------------ -- Initialize Main box : -- ------------------------------------------------ Gtk_New_Vbox(Gnostic.Gnose_Interface.Main_Vbox); Gtk_New (Gnostic.Gnose_Interface.Actions, "Actions"); Add_Actions (Gnostic.Gnose_Interface.Actions, Entries, To_Address(Gnostic)); Gtk_New (Gnostic.Gnose_Interface.UI); Insert_Action_Group (Gnostic.Gnose_Interface.UI, Gnostic.Gnose_Interface.Actions, 0); Add_Accel_Group (Gtk_Window(Gnostic.Gnose_Interface), Get_Accel_Group (Gnostic.Gnose_Interface.UI)); if Add_UI_From_String (Gnostic.Gnose_Interface.UI, UI_Info, Error'Unchecked_Access) = 0 then Text_Io.Put_Line ("Building menus failed: " & Get_Message (Error)); Error_Free (Error); end if; Pack_Start (Gnostic.Gnose_Interface.MAin_Vbox, Get_Widget (Gnostic.Gnose_Interface.UI, "/MenuBar"), False, False, 5); Pack_start(Gnostic.Gnose_Interface.Main_Vbox, Gnostic.Gnose_Interface.Main_Pan, True, True, 0); --Text_Io.Put_Line("Add main box to Gtk_Window"); Add(Gtk_Window_Record(Gnostic.Gnose_Interface.all)'access, Gnostic.Gnose_Interface.Main_Vbox); Gtk.Window.Set_Focus(Gtk_Window_Record(Gnostic.Gnose_Interface.all)'Access, Gtk.Widget.Gtk_Widget(Gnostic.Gnose_Interface.User_Text_View)); Set_Tab_Pos(Gnostic.Gnose_Interface.Graph_Book, Pos_Left); --Text_Io.Put_Line("-- End of Window construction."); ----------------------------------------------------------------------------------- --Text_Io.Put_Line("Attach destroy Handler..."); Main_User_Cb_Handlers.Connect (Gtk_Window_Record(Gnostic.Gnose_Interface.all)'access, "destroy", Main_User_Cb_Handlers.To_Marshaller (Main_Destroy'Access), Gnostic.all'access); --Text_Io.Put_Line("Setting the default size..."); Set_Default_Size(Gnostic.Gnose_interface, 1024, 720); Gtk.Window.set_position(Gtk_Window(Gnostic.Gnose_Interface), Gtk.Enums.Win_Pos_Center); if Gnostic.context.Project.Project_Name /= null then Gtk.Window.Set_Title(Gtk_Window(Gnostic.Gnose_Interface), Gnostic.context.Project.Project_Name.all & " - " & To_String(Versions.Version)); end if; Common_notebook_Cb.Connect (Gnostic.Gnose_Interface.Graph_book, "switch_page", Common_notebook_Cb.To_Marshaller (Page_Switched'Access), Gnostic, true); for Machine_Lang in Machine_Lang_Enum'Range loop if Gnostic.Gnose_Interface.Graph_Set(Machine_Lang) /= null and then Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Canvas /= null then Realize(Gnostic.Gnose_Interface.Graph_Set(Machine_Lang).Canvas); end if; end loop; Calendar.Split(Clock, Start_Date.Year, Start_Date.Month, Start_Date.Day, Start_Date.Hours); Gnostic.Process.Initialize (Clock, Gnostic.Context.Neural_Params.Self_Wait, Gnostic.Context.Neural_Params.Self_Wait); Gnostic.Process.Run (Gnostic.Context.System_Params.Self_Programming, Gnostic.Context.System_Params.Self_Executed); --Text_io.put_line("initialize Global layout."); Layout := Gnostic.Gnose_Interface.Graph_Set(Project_Define).Layout; --Text_io.put_line("create make file"); if not Is_Regular_File("Makefile") then declare Project_Name : constant String := Random_Name(12); begin if Environment.Version_Reset = 0 then declare Dialog : Gtk.Dialog.Gtk_Dialog; Yes : Gtk.Widget.Gtk_Widget; No : Gtk.Widget.Gtk_Widget; Box : Gtk_Vbox; Label : Gtk_Label; begin loop Gtk_New(Label, Project_Name); Gtk.Dialog.Gtk_New(Dialog, "Create project named :", Gtk_Window(Gnostic.Gnose_interface), Gtk.dialog.modal); Set_Default_Size(Gtk_Window(Dialog), 150, 70); Box := Get_Content_Area(Dialog); Pack_Start(Box, Label); Yes := Gtk.Dialog.Add_Button(Dialog, "Yes", Gtk.Dialog.Gtk_Response_Yes); No := Gtk.Dialog.Add_Button(Dialog, "No", Gtk.Dialog.Gtk_Response_No); Show_All(Box); case Gtk.Dialog.Run(Dialog) is when Gtk.Dialog.Gtk_Response_Yes => Makefile("Makefile"); if Gnostic.Context.System_Params.Self_Programming then Initialize_Project_Window(Gnostic, Project_Name); end if; if Gnostic.Context.System_Params.Self_Executed then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, Gnostic.all'access); end if; Gtk.Dialog.Destroy(Dialog); exit; when Gtk.Dialog.Gtk_Response_No => Makefile("Makefile"); Initialize_Project_Window(Gnostic, ""); if Gnostic.Context.System_Params.Self_Executed then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, Gnostic.all'access); end if; Gtk.Dialog.Destroy(Dialog); exit; when others => Gtk.Dialog.Destroy(Dialog); exit; end case; end loop; end; end if; end; elsif Gnostic.Context.System_Params.Self_Executed then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, Gnostic.all'access); end if; --Text_Io.Put_Line("Show_all Window..."); Gtk.Window.Show_All(Gtk_Window_Record(Gnostic.Gnose_Interface.all)'access); end; return Gnostic.all'Access; end Gnose_Initialize; ------------------------------------------------------------------------------- -- End of Gnose Interface. -- ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- Gnose Process body : -- ------------------------------------------------------------------------------- task body Gnose_Process is Start_Process : Time := Clock; Self_Wait : Duration := 0.0; User_Wait : Duration := 0.0; End_Of_Task : Boolean := False; begin accept Initialize (Date : in Time; Self, User : in Duration) do Self_Wait := Self; delay until Date; Start_Process := Date; User_Wait := User; end Initialize; Text_Io.Put_Line("Available Human Language : "); for Human_Lang in Gnostic.System.Neural_Set'Range loop if Gnostic.System.Neural_Set(Human_Lang) /= null then Text_Io.Put_Line("Human Lang : " & Human_Lang_Enum'Image(Gnostic.System.Neural_Set(Human_Lang).Human_Lang)); end if; end loop; Text_Io.New_Line; Text_Io.Put_Line("Neural Language : " & Human_Lang_Enum'Image(Gnostic.System.Neural_Lang)); Text_Io.New_Line; Text_Io.Put_Line("Available Machine Language : "); for Machine_Lang in Gnostic.System.Language_Set'Range loop if Gnostic.System.Language_Set /= null and then Gnostic.System.Language_Set(Machine_Lang) /= null then Text_Io.Put_Line("Machine Lang : " & Machine_Lang_Enum'Image(Gnostic.System.Language_Set(Machine_Lang).Machine_Lang)); end if; end loop; while not End_Of_Task loop Text_Io.New_Line; accept Run(Programming, Executed : in Boolean); loop select accept Halt do End_Of_Task := True; end Halt; exit; or accept Suspend; exit; or accept Respond; or accept Train; or accept Info; or accept Set_Neural(Human_Lang : in Human_Lang_Enum) do Gnostic.System.Neural_Lang := Human_Lang; end Set_Neural; or accept Get_Language(Language_Unit : out Language_Unit_Access; Machine_Lang : in Machine_Lang_Enum) do Language_Unit := Gnostic.System.Language_Set(Machine_Lang); end Get_Language; or accept Get_Neural(Neural_Unit : out Neural_Unit_Access; Human_Lang : in Human_Lang_Enum) do Neural_Unit := Gnostic.System.Neural_Set(Human_Lang); end Get_Neural; or accept Build; or accept Execute; or delay Self_Wait; end select; end loop; end loop; Text_Io.Put_Line("Process halted"); end Gnose_Process; ---------------------------------------------------------------------------------------- -- function On_Self_Execution : Timeout callback with Data_Type (Gnose_Access) -- ---------------------------------------------------------------------------------------- function On_Self_Execution(Object : Object_Pointer) return Boolean is Gnostic : constant Gnose_Access := Object.all'Access; File : Text_Io.File_Type; begin case Gnostic.System_Step is when List => if Gnostic.Context.System_Params.Self_Programming then declare Project_Name : constant String := Random_Name(12); begin Create_List_Window(Gnostic.all'access, Project_Name); end; else Create_List_Window(Gnostic.all'access, ""); end if; Gnostic.Exit_Result := Results.Spawn("make clean"); if Gnostic.Exit_Result.Success then Gnostic.System_Step := System_Step_Enum'Succ(Gnostic.System_Step); if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); Gnostic.Context.System_Params.Self_Executed := False; end if; -- For Automation message : declare Message : constant Message_Enum := Automation_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Next_Step := Gnostic.System_Step; Message_Window.Remaning_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if Message_Window.Success then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, Object.all'access); Gnostic.Context.System_Params.Self_Executed := True; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end; else Gnostic.System_Error := Gnostic.System_Step; Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; when Prepare => Text_Io.Put_Line("-- Making prepare..."); Gnostic.Exit_Result := Results.Spawn("make prepare"); if Gnostic.Exit_Result.Success then Gnostic.System_Step := System_Step_Enum'Succ(Gnostic.System_Step); if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); Gnostic.Context.System_Params.Self_Executed := False; end if; -- For Automation message : declare Message : constant Message_Enum := Automation_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Next_Step := Gnostic.System_Step; Message_Window.Remaning_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if Message_Window.Success then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, Object.all'access); Gnostic.Context.System_Params.Self_Executed := True; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end; else Gnostic.System_Error := Gnostic.System_Step; Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; when Computation => if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); Gnostic.Context.System_Params.Self_Executed := False; end if; -- For Automation message :  declare Message : constant Message_Enum := Computation_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.End_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if Message_Window.Success then declare Computation_Pointer : Computation_Conversions.Object_Pointer; begin Computation_Pointer := new Computation_Window_Access; Computation_Pointer.all := new Computation_Window_Record_Type; Computation_Initialize(Computation_Pointer, Object); end; if Message_Window.Success then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, Object.all'access); Gnostic.Context.System_Params.Self_Executed := True; end if; Gnostic.System_Step := System_Step_Enum'Succ(Gnostic.System_Step); Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); else Gnostic.System_Error := Gnostic.System_Step; Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end; when Reload => Text_Io.Put_Line("Reaload"); Reload_Project(Gnostic.all'access); if Gnostic.Exit_Result.Success then Gnostic.System_Step := System_Step_Enum'Succ(Gnostic.System_Step); if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); Gnostic.Context.System_Params.Self_Executed := False; end if; -- For Automation message : declare Message : constant Message_Enum := Automation_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Next_Step := Gnostic.System_Step; Message_Window.Remaning_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if Message_Window.Success then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, Object.all'access); Gnostic.Context.System_Params.Self_Executed := True; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end; else Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; when Update => Text_Io.Put_Line("Update"); Upgrade(Gnostic.all'Access); if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); Gnostic.Context.System_Params.Self_Executed := False; end if; begin text_io.Open(File, text_io.Append_File, "Versions.default"); exception when text_io.Name_Error => text_io.create(File, text_io.out_File, "Versions.default"); end; text_io.Put_Line(File, To_String(Versions.Version)); text_io.Close(File); -- Make update. Text_Io.Put_Line("-- Making update..."); Gnostic.Exit_Result := Results.Spawn("make update"); if Gnostic.Exit_Result.Success then Gnostic.System_Step := System_Step_Enum'Succ(Gnostic.System_Step); declare Message : constant Message_Enum := Automation_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Next_Step := Gnostic.System_Step; Message_Window.Remaning_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if Message_Window.Success then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, Object.all'access); Gnostic.Context.System_Params.Self_Executed := True; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end; else Gnostic.System_Error := Gnostic.System_Step; Gnostic.System_Step := On_Error; end if; when Clean => -- make clean. if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); Gnostic.Context.System_Params.Self_Executed := False; end if; Text_Io.Put_Line("-- Making mrproper..."); Gnostic.Exit_Result := Results.Spawn("make mrproper"); if Gnostic.Exit_Result.Success then Gnostic.System_Step := System_Step_Enum'Succ(Gnostic.System_Step); -- For Automation message : declare Message : constant Message_Enum := Automation_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Next_Step := Gnostic.System_Step; Message_Window.Remaning_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if Message_Window.Success then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, Object.all'access); Gnostic.Context.System_Params.Self_Executed := True; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end; else Gnostic.System_Error := Gnostic.System_Step; Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; when Arch => if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); Gnostic.Context.System_Params.Self_Executed := False; end if; declare Computation_Pointer : Computation_Conversions.Object_Pointer; begin Computation_Pointer := new Computation_Window_Access; Computation_Pointer.all := new Computation_Window_Record_Type; Computation_Initialize(Computation_Pointer, Object); end; -- make arch. Gnostic.Exit_Result := Results.Spawn("make enlight-sources"); Text_Io.Put_Line("-- Making arch.."); Gnostic.Exit_Result := Results.Spawn("make arch"); if Gnostic.Exit_Result.Success then case Gnostic.Plan is when Spec => Gnostic.System_Step := Computation; Gnostic.Plan := Impl; when Impl => Gnostic.Plan := Spec; Gnostic.System_Step := Build; end case; -- For Automation message : declare Message : constant Message_Enum := Automation_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Next_Step := Gnostic.System_Step; Message_Window.Remaning_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if Message_Window.Success then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, Object.all'access); Gnostic.Context.System_Params.Self_Executed := True; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end; else Gnostic.System_Error := Gnostic.System_Step; Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; when Build => -- make all;  Text_Io.Put_Line("-- Making all..."); if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); Gnostic.Context.System_Params.Self_Executed := False; end if; Gnostic.Exit_Result := Results.Spawn("make all"); if Gnostic.Exit_Result.Success then Gnostic.System_Step := System_Step_Enum'Succ(Gnostic.System_Step); -- For Automation message : declare Message : constant Message_Enum := Automation_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Next_Step := Gnostic.System_Step; Message_Window.Remaning_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if Message_Window.Success then Gnostic.Self_Execute_Timeout := Main_timeout.Timeout_Add(Guint(Gnostic.Context.Neural_Params.Self_Wait*1000.0), On_Self_Execution'Access, Object.all'access); Gnostic.Context.System_Params.Self_Executed := True; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; end; else Gnostic.System_Error := Gnostic.System_Step; Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; when Restart => if Gnostic.Exit_Result.Success then delay 0.5; Restart(Gnostic.all'access); delay 0.5; Destroy(Gnostic.Gnose_Interface); else Gnostic.System_Error := Gnostic.System_Step; Gnostic.System_Step := On_Error; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to next step : " & System_Step_Enum'image(Gnostic.System_Step)); end if; when At_Limit => if Gnostic.Exit_Result.Success then Gnostic.System_Step := System_Step_Enum'First; Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Going to first step : " & System_Step_Enum'image(Gnostic.System_Step)); if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; Gnostic.Context.System_Params.Self_Executed := False; else Gnostic.System_Step := On_Error; end if; when On_Error => Insert_With_Tag(Gnostic.Gnose_Interface.System_Text_Buffer, "", "Step On Error: " & System_Step_Enum'image(Gnostic.System_Step)); declare Message : constant Message_Enum := On_Error_Message; Message_Window : Message_Timeout_Window_Type(Message); begin Message_Window.Step_On_Error := Gnostic.System_Error; Message_Window.Result := Gnostic.Exit_Result; Message_Window.End_Time := Clock + Gnostic.Context.Neural_Params.User_Wait; Initialize_Message_Window(Message_Window, gtk_window(Gnostic.Gnose_Interface)); if not Message_Window.Success then if Gnostic.Context.System_Params.Self_Executed then Remove(Gnostic.Self_Execute_Timeout); end if; Gnostic.Context.System_Params.Self_Executed := False; else Gnostic.System_Step := Message_Window.Step_On_Error; end if; end; end case; return True; end On_Self_Execution; end Gnos.Windows;