DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - metrics - download

⟦2b1026462⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body List_Editor, seg_0278c5

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─⟦5a81ac88f⟧ »Space Info Vol 1« 
        └─⟦this⟧ 

with Process_Events_State;
with Local_Frames;
with Events;
package body List_Editor is
    List_Path : constant String := "F1.SL1.SList";
    Menu_Path : constant String := "MenuBar";
    Label_Path : constant String := "F0.Label";

    Base_Widget_Path : constant String := Widget_Path;

    List_Lf : Local_Frames.Local_Frame;

    type Access_String is access String;
    Selection_String : Access_String;

    procedure Init is
    begin
        List_Lf := Local_Frames.Get_Id_With_Name ("List", Lf, Base_Widget_Path);
    end Init;

    procedure Add_Item (Item : String) is
    begin
        Events.Action (List_Lf, "ListAddItem", List_Path, Item);
    end Add_Item;


    procedure Delete_Item (Item : String) is
    begin
        Events.Action (List_Lf, "ListDelItem", List_Path, Item);
    end Delete_Item;


    procedure Delete_Item_At_Position (Position : Integer) is
    begin
        Events.Action (List_Lf, "ListDelItemPos", List_Path,
                       Integer'Image (Position));
    end Delete_Item_At_Position;


    procedure Delete_All_Items is
    begin
        Events.Action (List_Lf, "ListDelAllItems", List_Path, "");
    end Delete_All_Items;


    procedure Select_Item (Item : String) is
    begin
        Events.Action (List_Lf, "ListSelItem", List_Path, Item);
    end Select_Item;


    procedure Select_Item_At_Position (Position : Integer) is
    begin
        Events.Action (List_Lf, "ListSelPos", List_Path,
                       Integer'Image (Position));
    end Select_Item_At_Position;


    procedure Deselect_All_Items is
    begin
        Events.Action (List_Lf, "ListDesAll", List_Path, "");
    end Deselect_All_Items;


    procedure Deselect_Item (Item : String) is
    begin
        Events.Action (List_Lf, "ListDesItem", List_Path, Item);
    end Deselect_Item;


    procedure Deselect_Item_At_Position (Position : Integer) is
    begin
        Events.Action (List_Lf, "ListDesPos", List_Path,
                       Integer'Image (Position));
    end Deselect_Item_At_Position;


    procedure Set_Add_Mode (Add_Mode_On : Boolean) is
    begin
        if Add_Mode_On then
            Events.Action (List_Lf, "ListAddMode", List_Path, "1");
        else
            Events.Action (List_Lf, "ListAddMode", List_Path, "0");
        end if;
    end Set_Add_Mode;


    procedure Set_Horizontal_Position (Position : Integer) is
    begin
        Events.Action (List_Lf, "ListHorizPos", List_Path,
                       Integer'Image (Position));
    end Set_Horizontal_Position;


    procedure Set_Bottom_Item (Item : String) is
    begin
        Events.Action (List_Lf, "ListBottomItem", List_Path, Item);
    end Set_Bottom_Item;


    procedure Set_Bottom_At_Position (Position : Integer) is
    begin
        Events.Action (List_Lf, "ListBottomPos", List_Path,
                       Integer'Image (Position));
    end Set_Bottom_At_Position;


    procedure Set_Top_Item (Item : String) is
    begin
        Events.Action (List_Lf, "ListSetItem", List_Path, Item);
    end Set_Top_Item;


    procedure Set_Top_At_Position (Position : Integer) is
    begin
        Events.Action (List_Lf, "ListBottomPos", List_Path,
                       Integer'Image (Position));
    end Set_Top_At_Position;


    function Exist_Item (Item : String) return Boolean is
        S : constant String := Events.Action
                                  (List_Lf, "ListItemExists", List_Path, Item);
    begin
        if S = "1" then
            return True;
        else
            return False;
        end if;
    end Exist_Item;


    function Item_Position (Item : String) return Integer is
        S : constant String := Events.Action
                                  (List_Lf, "ListItemExists", List_Path, Item);
    begin
        return Integer'Value (S);
    end Item_Position;


    function Get_Selected_Item return String is
    begin
        return Selection_String.all;
    end Get_Selected_Item;

    procedure Set_Label (Label : String) is
    begin
        Events.Action (List_Lf, "LabelSetString", Label_Path, Label);
    end Set_Label;

    function Process_Events return Process_Events_State.Elements is
        Result_State : Process_Events_State.Elements :=
           Process_Events_State.Not_Processed;
    begin
        if not Events.Empty then
            declare  
                Lf : constant Local_Frames.Local_Frame := Events.Get_Lf;
                Evt_Type : constant String := Events.Get_Type;
                Field : constant String := Events.Get_Field;
                Value : constant String := Events.Get_Value;
            begin
                if Evt_Type = "List_editor_selection" and Lf = List_Lf then  
                    Selection_String := new String'(Value);
                end if;  
                Result_State := Process_Events_State.Not_Processed;
            end;
        end if;
        return Result_State;
    end Process_Events;
end List_Editor;

    nblk1=7
    nid=4
    hdr6=c
        [0x00] rec0=24 rec1=00 rec2=01 rec3=070
        [0x01] rec0=25 rec1=00 rec2=03 rec3=010
        [0x02] rec0=20 rec1=00 rec2=02 rec3=032
        [0x03] rec0=21 rec1=00 rec2=05 rec3=02e
        [0x04] rec0=1b rec1=00 rec2=07 rec3=014
        [0x05] rec0=07 rec1=00 rec2=06 rec3=000
        [0x06] rec0=c5 rec1=a0 rec2=00 rec3=019
    tail 0x21520b55883ac65658a28 0x42a00088462060003
Free Block Chain:
  0x4: 0000  00 00 00 45 00 0f 20 20 20 20 20 20 20 20 65 6e  ┆   E          en┆