File : marks.adb
-- Marks (body)
--
-- Copyright (c) 2009 Tidorum Ltd.
--
-- This file is part of Find_Marks.
--
-- Find_Marks is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
with Ada.Characters.Handling;
with Ada.Strings;
with Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Marks.Scanners;
package body Marks is
use Ada.Strings.Unbounded;
use Ada.Text_IO;
use type Scanners.Scanner_Ref;
--
--- Utilities for self and children
--
function Trim (Item : String) return String
is
begin
return Ada.Strings.Fixed.Trim (Item, Ada.Strings.Both);
end Trim;
function To_Lower (Item : String) return String
renames Ada.Characters.Handling.To_Lower;
--
--- Scanning context
--
Scanner_By_Option : Scanners.Scanner_Ref;
--
-- The scanner chosen by a command-line option, or null if none.
Source_File_Name : Unbounded_String := Null_Unbounded_String;
--
-- The name of the current source file.
-- Null_Unbounded_String if not defined.
Scanner : Scanners.Scanner_Ref;
--
-- The scanner used for the current source file.
Line_Number : Ada.Text_IO.Count := 0;
--
-- The number of the currently Scanned line, in the current source file.
-- Zero if not defined.
--
--- Emitting mark definitions
--
Quote : constant Character := '"';
--
-- The quote character can be used to enclose fields,
-- and must be doubled if it occurs within a field.
procedure Emit_Quoted_Field (Item : String)
--
-- Emits the given data Item as a CVS field by adding enclosing
-- quotes (") and doubling any internal quotes. This is only
-- necessary if the Item contains commas or quotes.
--
is
begin
Put (Quote);
for I in Item'Range loop
Put (Item(I));
if Item(I) = Quote then
Put (Quote);
end if;
end loop;
Put (Quote);
end Emit_Quoted_Field;
procedure Emit_Field (Item : String)
--
-- Emits the given Data item as a CVS field.
--
-- If the Item contains no quotes (") or commands we emit it
-- as such, without enclosing quotes.
--
-- Likewise, if the Item begins with the quote character (") we
-- assume that it already properly encodes any internal quotes
-- and we emit it as such.
--
-- If the Item contains quotes or commas, but does not begin
-- with a quote character, we Emit_Quoted_Field.
--
is
use Ada.Strings.Fixed;
begin
if Item(Item'First) = Quote
or (Index (Item, (1 => Quote)) = 0 and Index (Item, ",") = 0)
then
-- No need to encode and enclose in quotes.
Put (Item);
else
-- The Item contains '"' or ',' but does not start with '"'.
Emit_Quoted_Field (Item);
end if;
end Emit_Field;
procedure Emit_Mark (
Marker : String;
Properties : Properties_T;
Line : Positive_Count)
--
-- Emits a mark definition with the Line as the marked line.
-- The other parameters have the same meaning as in the Define
-- procedure.
--
is
use Ada.Strings, Ada.Strings.Fixed;
Comma : constant Character := ',';
begin
-- The marker name, source file, and line number:
Emit_Field (Marker); Put (Comma);
Emit_Field (To_String (Source_File_Name)); Put (Comma);
Put (Trim (Positive_Count'Image (Line),Left)); Put (Comma);
-- The kind of part that is marked:
case Properties.Part is
when Any => Put ("any" );
when Subprogram => Put ("subprogram");
when Luup => Put ("loop" );
when Call => Put ("call" );
end case;
Put (Comma);
-- The positional relation (a combination of Position
-- and Relation):
case Properties.Relation is
when Any | This =>
case Properties.Position is
when Any => Put ("any" );
when Here => Put ("here" );
when Above => Put ("above");
when Below => Put ("below");
end case;
when Contain => Put ("contain");
when Span => Put ("span" );
end case;
-- For Relation = Contain or Span, the role of the Position
-- is seen only in the Line selected.
New_Line;
end Emit_Mark;
--
--- Markable lines and pending mark definitions
--
Last_Markable_Number : Ada.Text_IO.Count := 0;
--
-- The number of the last "markable" line scanned in the current file.
-- Zero for "none".
Max_Pending_Marks : constant := 100;
--
-- The maximum number of pending (not yet completed) mark definitions.
-- A mark definition is pending if it specifies Position => Below and
-- if we have not yet seen a later "markable" line.
type Pending_Mark_T is record
Line : Positive_Count;
Marker : Unbounded_String;
Properties : Properties_T;
end record;
--
-- A pending mark definition. The Line is the number of the mark
-- line itself. The other components have the same roles as the
-- parameters of Define, below.
Pending_Marks : array (1 .. Max_Pending_Marks) of Pending_Mark_T;
Num_Pending : Natural := 0;
--
-- The pending mark definitions are Pending_Marks(1 .. Num_Pending).
-- If Num_Pending > Pending_Marks'Last, there is an overflow.
procedure Pend (Mark : in Pending_Mark_T)
--
-- Adds this pending Mark to the set of pending mark definitions.
--
is
begin
Num_Pending := Num_Pending + 1;
if Num_Pending <= Pending_Marks'Last then
-- There is room.
Pending_Marks(Num_Pending) := Mark;
elsif Num_Pending = Pending_Marks'Last + 1 then
Report_Error (
"Too many ""below"" marks (over"
& Natural'Image (Pending_Marks'Length)
& ") before the next markable line.");
end if;
end Pend;
procedure Complete_Pending_Marks (Number : Positive_Count)
--
-- Completes and emits all pending marks, making them refer
-- to the given line Number. However, no pending mark is
-- completed by its own line.
--
is
Mark : Pending_Mark_T;
-- One of the pending marks.
Left : Natural := 0;
-- The (new) index of the last mark that is left pending
-- (because this is its own line).
begin
for P in 1 .. Num_Pending loop
Mark := Pending_Marks(P);
if Mark.Line < Number then
-- Valid completion.
Emit_Mark (
Marker => To_String (Mark.Marker),
Properties => Mark.Properties,
Line => Number);
else
-- This Mark is not completed by its own line.
-- Put it back in the Pending_Marks set:
Left := Left + 1;
Pending_Marks(Left) := Mark;
end if;
end loop;
for P in Left + 1 .. Num_Pending loop
Pending_Marks(P).Marker := Null_Unbounded_String;
end loop;
Num_Pending := Left;
end Complete_Pending_Marks;
--
--- Interface to the main procedure
--
procedure Note_Option (Text : in String)
is
begin
if Text = "-auto" then
Scanner_By_Option := null;
else
Scanner_By_Option := Scanners.Scanner_By_Option (Text);
end if;
end Note_Option;
function Suffix (Name : String) return String
--
-- The suffix of the file Name, defined as the substring
-- following the last period ('.') in the Name, or null
-- if there is no period.
--
is
begin
for N in reverse Name'Range loop
if Name(N) = '.' then
return Name(N + 1 .. Name'Last);
end if;
end loop;
-- No period in Name.
return "";
end Suffix;
procedure Define_File (Name : in String)
is
begin
Source_File_Name := To_Unbounded_String (Name);
if Scanner_By_Option /= null then
Scanner := Scanner_By_Option;
else
Scanner := Scanners.Scanner_By_Suffix (Suffix (Name));
end if;
if Scanner = null then
Report_Error ("No format chosen.");
end if;
end Define_File;
procedure Scan (
Line : in String;
Number : in Ada.Text_IO.Positive_Count)
is
Markable : Boolean;
-- Whether the Scanner considers this Line to be markable.
begin
if Scanner /= null then
Line_Number := Number;
Scanners.Scan (
Line => Line,
Scanner => Scanner.all,
Markable => Markable);
--
-- Expected to call Define for each mark found on the Line.
if Markable then
Complete_Pending_Marks (Number);
Last_Markable_Number := Line_Number;
end if;
end if;
end Scan;
procedure Note_End_Of_File
is
begin
if Num_Pending > 0 then
Report_Error (
"No markable line for"
& Natural'Image (Num_Pending)
& " pending ""below"" marks.");
Complete_Pending_Marks (Number => Line_Number + 1);
--
-- The Line_Number is the number of the last line in the
-- current source file. The current source file cannot be
-- empty since it has defined some pending marks.
Num_Pending := 0;
-- Just to make sure. It should have been zeroed by
-- the call of Complete_Pending_Marks above.
end if;
Source_File_Name := Null_Unbounded_String;
Line_Number := 0;
end Note_End_Of_File;
procedure Report_Error (Text : in String)
is
begin
if Source_File_Name /= Null_Unbounded_String then
Put (Standard_Error, To_String (Source_File_Name));
Put (Standard_Error, ':');
end if;
if Line_Number /= 0 then
Put (Standard_Error, Trim (Ada.Text_IO.Count'Image (Line_Number)));
Put (Standard_Error, ':');
end if;
Put_Line (Standard_Error, Text);
end Report_Error;
--
--- Interface to the language-specific scanners
--
procedure Define (
Marker : in String;
Properties : in Properties_T)
is
Marked_Number : Positive_Count;
-- The number of the marked line, as defined by Position.
begin
case Properties.Position is
when Any | Here | Above =>
if Properties.Position /= Above then
-- Use current line number (= mark line).
Marked_Number := Line_Number;
elsif Last_Markable_Number > 0 then
-- There is a preceding markable line.
Marked_Number := Last_Markable_Number;
else
Report_Error ("No markable line above this line.");
Marked_Number := Line_Number;
end if;
Emit_Mark (
Marker => Marker,
Properties => Properties,
Line => Marked_Number);
when Below =>
-- This mark definition will be left pending and
-- completeted when we find the next markable line.
Pend (Mark => (
Line => Line_Number,
Marker => To_Unbounded_String (Marker),
Properties => Properties));
end case;
end Define;
end Marks;