DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ T V ┃
Length: 10237 (0x27fd) Types: TextFile Names: »V«
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3 └─ ⟦fc9b38f02⟧ »DATA« └─⟦9b46a407a⟧ └─⟦12c68c704⟧ └─⟦this⟧ └─⟦5f3412b64⟧ Bits:30000745 8mm tape, Rational 1000, ENVIRONMENT 12_6_5 TOOLS └─ ⟦91c658230⟧ »DATA« └─⟦458657fb6⟧ └─⟦220843204⟧ └─⟦this⟧
with Diana; with Directory; with Directory_Tools; package Ada_Text is pragma Subsystem (Tools); pragma Module_Name (4, 3548); -- Ada objects have two components: a Diana tree and a textual image. -- This package exports a mapping between the tree and the image, and -- provides read access to the image. type Handle is private; Nil_Handle : constant Handle; procedure Open (Ada_Object : Directory_Tools.Object.Handle; Unit : out Handle; Status : out Directory_Tools.Object.Error_Code); procedure Open (Ada_Object : Directory.Version; Unit : out Handle; Status : out Directory.Error_Status); -- Open acquires a read lock on both the tree and the image, returning -- a handle that can be used to make further queries. Nil_Handle is -- returned if the Open fails. procedure Close (Unit : in out Handle; Status : out Directory_Tools.Object.Error_Code); procedure Close (Unit : in out Handle; Status : out Directory.Error_Status); -- Close releases the locks acquired by Open and sets Unit to -- Nil_Handle. Using a handle or iterators obtained from it after the -- handle has been closed will have unpredictable erroneous results. function Root (Unit : Handle) return Diana.Tree; -- Returns the root of the unit; returns Diana.Empty if the -- opened Ada unit is in archive state. type Area is record First_Line : Positive; First_Column : Positive; Last_Line : Natural; Last_Column : Natural; end record; Nil_Area : constant Area := (1, 1, 0, 0); -- An area indicates a stream of contiguous characters on the screen. -- First_Line and First_Column are the coordinates of the first -- character of the stream; Last_Line and Last_Column are the -- coordinates of the last character in the stream. Lines and -- columns are numbered beginning from 1. function Is_Empty (Where : Area) return Boolean; -- An area A is considered empty iff A.Last_Line < A.First_Line or -- A.First_Line = A.Last_Line and then A.Last_Column < A.First_Column. function Entire (Unit : Handle) return Area; -- Returns the area corresponding to the entire image. function Has_Partial_Lines (Subtree : Diana.Tree) return Boolean; -- Indicates whether the image of a subtree uses an integral number -- of lines (such as a statement), or whether it may start or end -- in the middle of a line (as an expression). If this function -- returns True for some node, it will also return True for all its -- children (even for a child whose image happens to occupy an integral -- number of lines.) function Where_Is (Subtree : Diana.Tree; Unit : Handle; And_Post_Comment : Boolean := True) return Area; -- Returns the area in the image that corresponds to some subtree. -- If Has_Partial_Lines (Subtree) is true, then the area returned will -- not included any leading blanks. If Has_Partial_Lines (Subtree) is -- False, then the area returned will begin in column 1. The area -- returned will include a trailing Same_Line comment (see below) if -- one is present and the And_Post_Comment parameter is true. function What_Line (Subtree : Diana.Tree; Unit : Handle) return Natural; -- Returns 0 for Diana.Empty, and the line number the subtree begins -- on for nonempty trees. function What_Is (Where_Is : Area; Unit : Handle) return Diana.Tree; -- Returns the smallest subtree whose image contains the area. function What_Is (On_Line : Positive; Unit : Handle) return Diana.Tree; -- Returns the smallest subtree T such that Has_Partial_Lines (T) is -- False and the image of T contains line On_Line. function What_Statement (On_Line : Positive; Unit : Handle) return Diana.Tree; -- Similar to What_Is, but has a slightly coarser granularity. -- What_Statement will always return a tree of class DECL or STM, or -- an ancestor of such a tree. type Comment_Kind is (Same_Line, Own_Line, Both); -- A Same_Line comment begins on the same line as an Ada token. -- Subsequent comment lines are considered to be a continuation of the -- Same_Line comment, as long as their double-dash delimiter is in the -- same column as the initial comment. There may be intervening empty -- lines as long as they are followed by another properly aligned comment -- line. -- An Own_Line comment consists of lines that contain only comments (no -- Ada tokens). -- The collection of comments and white space between two Ada tokens -- are considered by this package to be either a Same_Line comment, an -- Own_Line comment, or a Same_Line comment followed by an Own_Line -- comment. -- The Comment_Kind Both refers to either kind of comment if only one -- is present, or their concatentation if both are present. -- Examples: -- -- A := 0; -- A single-line Same_Line comment -- B := 0; -- This Same_Line comment -- -- contains two lines. -- C := 0; -- -- These lines make up -- -- an own-line comment. -- D := 0; -- -- -- The blanks lines before, after, and between these lines -- -- -- are all part of the own-line comment -- -- E := 0; -- -- F := 0; -- The blank line before this line is considered -- -- to be an Own-line comment. -- G := 0; -- A same-line comment -- -- Followed by an Own-line comment -- H := 0; -- Same-line comments may have blank lines -- -- -- Embedded within them, -- -- -- but the blank line that precedes this one is part of -- -- the Own_Line comment. -- I := 0; function Pre_Comment (Tree : Diana.Tree; Kind : Comment_Kind; Unit : Handle) return Area; function Post_Comment (Tree : Diana.Tree; Kind : Comment_Kind; Unit : Handle) return Area; -- These functions examine the comment text before the first token -- or after the last token of program text corresponding to the given -- Diana tree. If there is a comment there that matches the Kind -- parameter, then the Area for that comment is returned; otherwise -- Nil_Area is returned. -- In general, the same comment can be returned for more than one tree. -- For example, in: -- -- A.B := 1; -- -- comment -- C.D := 2; -- -- the comment can be returned as a post-comment of the first Dn_Assign -- node, or as a pre-comment on the second Dn_Assign node, the -- Dn_Selected node for C.D or the Dn_Used_Name_Id node for C. -- If a piece of a comment that matches the Kind parameter, just the -- piece will be returned. For example, in: -- -- P; -- comment 1 -- -- comment 2 -- Q; -- -- the first comment will be returned as the Same_Line post-comment of -- P and the Same_Line pre-comment of Q. Likewise, the second comment -- be returned as the Own_Line post-comment of P and the Own_Line -- pre-comment of Q. The value of Same_Line pre-comments is dubious, -- but they have been provided for the sake of completeness. type Iterator is private; Nil_Iterator : constant Iterator; procedure Initialize (Unit : Handle; Where : Area; Iter : out Iterator); function Done (Iter : Iterator) return Boolean; procedure Next (Iter : in out Iterator); -- Iterators can be used to retreive the text that is in some area -- of an image. An iterator will return a sequence of strings; -- one string for each line in the area. For an area A, -- if A.Last_Line < A.First_Line, then no strings will be returned. -- Otherwise, A.Last_Line - A.First_Line + 1 strings will be returned. -- The first string returned will be truncated so that characters -- before (A.First_Line, A.Last_Line) will not be returned. The -- last string returned will be truncated so that characters after -- (A.Last_Line, A.Last_Column) will not be returned. function Value (Iter : Iterator) return String; function Leading_Blanks (Iter : Iterator) return Natural; function Nonblank_Value (Iter : Iterator) return String; -- Most of the strings returned by the iterator will begin with -- some leading blanks. The Value function returns the string -- with its leading blanks. Alternatively, the Leading_Blanks and -- Nonblank_Value can be used to get these values separately. These -- functions obey the identity: -- -- Value (I) = String'(1..Leading_Blanks (I) => ' ') & -- Nonblank_Value(I) -- -- Warning: the string values returned will be a slice of some internal -- buffer, so that the numeric values of the lower and upper bounds -- will not have any meaningful value. -- If the iterator is not convenient, the following functions may -- be used examine the image. function Number_Of_Lines (Unit : Handle) return Natural; function Get_Line (Line : Positive; Unit : Handle) return String; -- Returns the null string if Line is out of bounds. -- The lower bound of the returned string will be 1. function Line_Length (Line : Positive; Unit : Handle) return Natural; -- Returns zero if Line is out of bounds. function Get_Character (Line : Positive; Column : Positive; Unit : Handle) return Character; -- Returns space if Line or Column is out of bounds. private type Open_State; type Handle is access Open_State; pragma Segmented_Heap (Handle); Nil_Handle : constant Handle := null; type Iterator_State; type Iterator is access Iterator_State; pragma Segmented_Heap (Iterator); Nil_Iterator : constant Iterator := null; end Ada_Text;