⟦449acfb27⟧

E3 Source Code



with Class_Window;
with Easy_Y;
with Bounded_String;
with Message;
with Requester;
with Scanner;
with Start;

package body Bug_Report is

    procedure Open (X, Y : Object.Index; Screen : String) is
        use Object;
    begin
        Easy_Y.Put_Title (Window => Error_Window,
                          Title => Bounded_String.Value ("Erreur", 80));
        Easy_Y.Put_Left (Window => Error_Window, Left => X);
        Easy_Y.Put_Right (Window => Error_Window, Right => Y);
        Easy_Y.Put_Width (Window => Error_Window, Width => The_Width);
        Easy_Y.Put_Height (Window => Error_Window, Height => The_Height);
        Easy_Y.Open (Display => Screen, Window => Error_Window);

        Easy_Y.Put_Font (To => Easy_Y.Small_Font);
        Easy_Y.Put_Size (Window => Error_Window, Size => 1);

        Easy_Y.Update;
    end Open;

    procedure Close is
        Button : Message.Unary;
        Result : Object.Index;
    begin
        Message.Free (Button);
        Message.Put (This_Name => Bounded_String.Value ("Fin", 80),
                     Into => Button);
        Requester.Open
           (X => 500,
            Y => 250,
            Screen => Bounded_String.Image (Class_Window.Get_Terminal_Name),
            The_Message => Button,
            Str => Bounded_String.Value ("Cliquez pour finir", 80));
        Result := Requester.Choice (Button);
        Message.Free (Button);
        Requester.Close;

        Easy_Y.Close (Window => Error_Window);
    end Close;

    procedure Put (The_String : String) is
        use Object;
        Pos : Object.Index;
    begin
        Open (X => 100,
              Y => 100,
              Screen => Bounded_String.Image (Class_Window.Get_Terminal_Name));

        Easy_Y.Set_Display (Window => Error_Window);
        Pos := (The_Width - The_String'Length * 8) / 2;
        Easy_Y.Print (Pos, 50, Bounded_String.Value (The_String, 80));

        Close;   end Put;

    procedure Print (Message : String) is
    begin
        Put (Message);
    end Print;

    procedure Print (Message : String; Ligne : Object.Index) is
    begin
        Put (Message & " a la ligne" & Object.Index'Image (Ligne) & ".");
    end Print;

    procedure Print (Message : String;
                     Objet : Object.Tiny_String;
                     Ligne : Object.Index) is
    begin
        Put (Message & " `" & Bounded_String.Image (Objet) &
             "' de la ligne" & Object.Index'Image (Ligne) & ".");
    end Print;

    procedure Supervisor (The_File : String) is
    begin

        Start (File => The_File);

    exception
        when Constraint_Error =>
            Print ("Erreur imprevue : Constraint_Error a ete levee",
                   Scanner.Get_Line_Number);
        when Numeric_Error =>
            Print ("Erreur imprevue : Numeric_Error a ete levee",
                   Scanner.Get_Line_Number);
        when Program_Error =>
            Print ("Erreur imprevue : Program_Error a ete levee",
                   Scanner.Get_Line_Number);
        when Storage_Error =>
            Print ("Erreur imprevue : Storage_Error a ete levee",
                   Scanner.Get_Line_Number);
        when Tasking_Error =>
            Print ("Erreur imprevue : Tasking_Error a ete levee",
                   Scanner.Get_Line_Number);
        when Identifier_Is_Missing =>
            Print ("Erreur de syntaxe : ceci n'est pas un identifier =>",
                   Scanner.Get_Value, Scanner.Get_Line_Number);
        when Parenthesis_Is_Missing =>
            Print ("Erreur de syntaxe : il manque une parenthese fermante",
                   Scanner.Get_Line_Number);
        when Point_Is_Missing =>
            Print ("Erreur de syntaxe : il manque un point",
                   Scanner.Get_Line_Number);
        when Brace_Is_Missing =>
            Print ("Erreur de syntaxe : il manque une accolade fermante",
                   Scanner.Get_Line_Number);
        when Prendre_Is_Missing =>
            Print ("Erreur de syntaxe : le mot clef PRENDRE est attendu",
                   Scanner.Get_Line_Number);
        when Unexpected_Token =>
            Print
               ("Erreur de syntaxe : je ne comprend pas la chaine suivante =>",
                Scanner.Get_Value, Scanner.Get_Line_Number);
        when Boolean_Bad_Type =>
            Print ("Erreur d'execution : conflit de type avec un objet booleen",
                   Scanner.Get_Line_Number);
        when Integer_Bad_Type =>
            Print ("Erreur d'execution : conflit de type avec un objet entier",
                   Scanner.Get_Line_Number);
        when String_Bad_Type =>
            Print ("Erreur d'execution : conflit de type avec un objet chaine",
                   Scanner.Get_Line_Number);
        when Block_Bad_Type =>
            Print ("Erreur d'execution : conflit de type avec un objet bloc",
                   Scanner.Get_Line_Number);
        when Turtle_Bad_Type =>
            Print ("Erreur d'execution : conflit de type avec un objet tortue",
                   Scanner.Get_Line_Number);
        when Pen_Bad_Type =>
            Print ("Erreur d'execution : conflit de type avec un objet stylo",
                   Scanner.Get_Line_Number);
        when Window_Bad_Type =>
            Print ("Erreur d'execution : conflit de type avec un objet fenetre",
                   Scanner.Get_Line_Number);
        when Undefined_Identifier =>
            Print
               ("Erreur d'execution : une variable utilisee n'a pas ete definie",
                Scanner.Get_Line_Number);
        when Unknown_Unary_Message =>
            Print
               ("Erreur d'execution : un objet ne comprend pas un message unaire",
                Scanner.Get_Line_Number);
        when Unknown_Binary_Message =>
            Print
               ("Erreur d'execution : un objet ne comprend pas un message binaire",
                Scanner.Get_Line_Number);
        when Unknown_Keyword_Message =>
            Print
               ("Erreur d'execution : un objet ne comprend pas un message a selecteurs",
                Scanner.Get_Line_Number);
        when Mismatch_Parameters =>
            Print
               ("Erreur d'execution : les parametres passes a un bloc ne correspondent pas",
                Scanner.Get_Line_Number);
        when Full_Block_Table =>
            Print
               ("Erreur d'execution : je n'ai plus de place pour reserver des blocs",
                Scanner.Get_Line_Number);
        when Full_String_Table =>
            Print
               ("Erreur d'execution : je n'ai plus de place pour reserver des chaines",
                Scanner.Get_Line_Number);
        when Full_Turtle_Table =>
            Print
               ("Erreur d'execution : je n'ai plus de place pour reserver des tortues",
                Scanner.Get_Line_Number);
        when Full_Pen_Table =>
            Print
               ("Erreur d'execution : je n'ai plus de place pour reserver des stylos",
                Scanner.Get_Line_Number);
        when Full_Window_Table =>
            Print
               ("Erreur d'execution : je n'ai plus de place pour reserver des fenetres",
                Scanner.Get_Line_Number);
        when Divide_By_Zero =>
            Print ("Erreur d'execution : tentative de division par zero",
                   Scanner.Get_Line_Number);
        when others =>
            null;
    end Supervisor;

end Bug_Report;
DataMuseum.dk

Rational R1000/400

⟦449acfb27⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
