File : marks-scanners.adb
-- Marks.Scanners (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.Latin_1;
with Ada.Strings;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Text_IO;
package body Marks.Scanners is
use Ada.Text_IO;
--
--- The set of available scanners
--
Max_Number_Scanners : Natural := 50;
--
-- The maximum number of scanners that can be in the set.
Set : array (1 .. Max_Number_Scanners) of Scanner_Ref;
Num : Natural := 0;
--
-- The set consists of the scanners (referenced by) Set(1 .. Num).
-- If Num > Set'Last, there is an overflow.
procedure Register (Me : Scanner_Ref)
is
begin
Num := Num + 1;
if Num <= Set'Last then
Set(Num) := Me;
elsif Num = Set'Last + 1 then
Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error,
"Registering too many scanners (over"
& Natural'Image (Set'Length)
& ").");
end if;
end Register;
function Scanner_By_Option (Option : String) return Scanner_Ref
is
Valid : Boolean;
-- Whether some registered scanner accepts the Option.
Chosen : Boolean;
-- Whether some registered scanner is chosen by the Option.
begin
for S in 1 .. Num loop
Handle_Option (
Option => Option,
Scanner => Set(S).all,
Valid => Valid,
Chosen => Chosen);
if Chosen then
return Set(S);
elsif Valid then
exit;
end if;
end loop;
if not Valid then
Put_Line (Standard_Error,
"Option """ & Option & """ not recognized.");
end if;
return null;
end Scanner_By_Option;
function Scanner_By_Suffix (Suffix : String) return Scanner_Ref
is
begin
for S in 1 .. Num loop
if Suffix_Chooses_Me (Suffix, Set(S).all) then
return Set(S);
end if;
end loop;
return null;
end Scanner_By_Suffix;
--
--- Scanning utilities for use in specific scanners
--
function Begins_By (Prefix, Text : String) return Boolean
is
begin
return Prefix'Length <= Text'Length
and then Prefix = Text(Text'First .. Text'First + Prefix'Length - 1);
end Begins_By;
Whitespace : constant Ada.Strings.Maps.Character_Set :=
Ada.Strings.Maps.To_Set (String'(
Ada.Characters.Latin_1.Space,
Ada.Characters.Latin_1.HT,
Ada.Characters.Latin_1.LF,
Ada.Characters.Latin_1.CR));
--
-- The whitespace characters.
function First_Visible (Text : String) return Natural
is
begin
return Ada.Strings.Fixed.Index (
Source => Text,
Set => Whitespace,
Test => Ada.Strings.Outside);
end First_Visible;
procedure Find_First_Word (
Within : in String;
First : in out Positive;
Last : out Natural)
is
begin
Ada.Strings.Fixed.Find_Token (
Source => Within(First .. Within'Last),
Set => Whitespace,
Test => Ada.Strings.Outside,
First => First,
Last => Last);
end Find_First_Word;
procedure To_Part (
Word : in String;
Valid : out Boolean;
Part : in out Part_T)
is
Was_Defined : constant Boolean := Part /= Any;
begin
Valid := True;
-- Optimism we may regret...
if Word = "subprogram" then Part := Subprogram;
elsif Word = "loop" then Part := Luup;
elsif Word = "call" then Part := Call;
else Valid := False;
end if;
if Valid and Was_Defined then
Report_Error (
'"'
& Word
& """ overrides earlier part keyword.");
end if;
end To_Part;
procedure To_Position (
Word : in String;
Valid : out Boolean;
Position : in out Position_T)
is
Was_Defined : constant Boolean := Position /= Any;
begin
Valid := True;
-- Optimism we may regret.
if Word = "here" then Position := Here;
elsif Word = "above" then Position := Above;
elsif Word = "below" then Position := Below;
else Valid := False;
end if;
if Valid and Was_Defined then
Report_Error (
'"'
& Word
& """ overrides earlier position keyword.");
end if;
end To_Position;
procedure To_Relation (
Word : in String;
Valid : out Boolean;
Relation : in out Relation_T)
is
Was_Defined : constant Boolean := Relation /= Any;
begin
Valid := True;
-- Optimism we may regret.
if Word = "this" then Relation := This;
elsif Word = "containing" then Relation := Contain;
elsif Word = "spanning" then Relation := Span;
else Valid := False;
end if;
if Valid and Was_Defined then
Report_Error (
'"'
& Word
& """ overrides earlier relation keyword.");
end if;
end To_Relation;
procedure Find_Mark_Properties (
Within : in String;
Properties : in out Properties_T;
First : in out Positive;
Last : out Natural)
is
Valid : Boolean;
-- Whether a word is a valid part, position, or relation.
begin
loop
Find_First_Word (Within, First, Last);
exit when Last < First;
declare
Word : String renames Within(First .. Last);
begin
To_Part (Word, Valid, Properties.Part);
if not Valid then
To_Position (Word, Valid, Properties.Position);
end if;
if not Valid then
To_Relation (Word, Valid, Properties.Relation);
end if;
exit when (not Valid)
and (Word /= "line");
end;
First := Last + 1;
end loop;
end Find_Mark_Properties;
procedure Find_Properties_And_Names (
Text : in String;
Quit : in String)
is
Properties : Properties_T := Any_Properties;
-- The properties of the marks.
First : Positive := Text'First;
Last : Natural;
-- Delimit a white-space-separated word in the Text.
begin
-- First the mark properties:
Find_Mark_Properties (
Within => Text,
Properties => Properties,
First => First,
Last => Last);
-- After the properties come zero or more marker names,
-- terminated by end of text or by Quit (if /= ""):
while First <= Last
and then Text(First .. Last) /= Quit
loop
Define (
Marker => Text(First .. Last),
Properties => Properties);
First := Last + 1;
Find_First_Word (Text, First, Last);
end loop;
end Find_Properties_And_Names;
end Marks.Scanners;