-------------------------------------------------------------------------------
--
--  This file is part of AdaBrowse.
--
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
--    AdaBrowse 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 2, or (at your option) any
--    later version. AdaBrowse is distributed in the hope that it will be
--    useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
-- </BLOCKQUOTE>
--
-- <DL><DT><STRONG>
-- Author:</STRONG><DD>
--   Thomas Wolf  (TW)
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
--
-- <DL><DT><STRONG>
-- Purpose:</STRONG><DD>
--   Utility routines for syntax coloring.</DL>
--
-- <!--
-- Revision History
--
--   02-FEB-2002   TW  First release.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Strings.Maps;

package body AD.Syntax is

   package ASM renames Ada.Strings.Maps;

   A_Keyword_Start    : constant ASM.Character_Set :=
     ASM.To_Set ("abcedfg" & 'i' & "lmnop" & "rstu" & 'w' & 'x');
   -- True for possible keyword starts

   A_Word_Delimiter   : constant ASM.Character_Set :=
     ASM."not"
       (ASM.To_Set ("abcdefghijklmnopqrstuvwxyz" & "0123456789" & '_'));

   --  Note: for these two constants, we only have to care about lower-case
   --  letters.

   procedure Find_Keyword
     (S      : in     String;
      Before : in     Character;
      Last   : in     Natural;
      Start  :    out Natural;
      Stop   :    out Natural)
   is
      --  Precondition: S contains only lower-case letters.
      Ch, Left : Character;
      I        : Positive;
   begin
      Start := 0; Stop := 0; Left := Before;
      I := S'First;
      while I < Last loop
         while not ASM.Is_In (S (I), A_Keyword_Start) or else
               (not ASM.Is_In (Left, A_Word_Delimiter))
         loop
            --  Special cases for comments and string and character literals:
            if S (I) = '-' and then Left = '-' then
               --  We *know* that I > S'First.
               Start := I - 1; Stop := I;
               return;
            elsif S (I) = '"' then
               exit;
            elsif S (I) = ''' then
               --  Might also be an attribute?
               if S (I + 2) = ''' then
                  --  We assume there are no attributes of length 1!
                  --  (And anyway, attributes are handled by the semantic
                  --  part of AD.Scanner. We should never see them here.)
                  Start := I; Stop := I + 2;
                  return;
               end if;
            end if;
            Left := S (I); I := I + 1;
            if I > Last then return; end if;
         end loop;
         --  S (I) is on a word start, and furthermore may be the start of
         --  a keyword.
         Start := I;
         --  See RM 2.9. This is a trie!
         --
         --  Don't worry about 'I' overflowing here: 'S' is guaranteed to have
         --  enough blanks at the end!
         Ch := S (I); I := I + 1;
         case Ch is
            when '"' =>
               --  A string literal. We *know* that the closing quote is
               --  on this line!
               loop
                  while S (I) /= '"' loop
                     I := I + 1;
                  end loop;
                  exit when S (I + 1) /= '"';
                  --  Skip the doubled quote
                  I := I + 2;
               end loop;
               Stop := I;
               return;

            when 'a' =>
               case S (I) is
                  when 'b' =>
                     I := I + 1;
                     if S (I)     = 'o' and then
                        S (I + 1) = 'r' and then
                        S (I + 2) = 't'
                     then
                        Stop := I + 2; --  abort
                     elsif S (I)     = 's' then
                        if S (I + 1) = 't' and then
                           S (I + 2) = 'r' and then
                           S (I + 3) = 'a' and then
                           S (I + 4) = 'c' and then
                           S (I + 5) = 't'
                        then
                           Stop := I + 5; --  abstract
                        else
                           Stop := I; --  abs
                        end if;
                        I := Stop + 1;
                     end if;

                  when 'c' =>
                     I := I + 1;
                     if S (I)     = 'c' and then
                        S (I + 1) = 'e'
                     then
                        if (S (I + 2) = 'p' and then S (I + 3) = 't')
                           or else
                           (S (I + 2) = 's' and then S (I + 3) = 's')
                        then
                           --  accept, access
                           Stop := I + 3;
                        else
                           I := I + 2;
                        end if;
                     end if;

                  when 'l' =>
                     I := I + 1;
                     if S (I) = 'l' then
                        Stop := I; --  all
                     elsif S (I)     = 'i' and then
                           S (I + 1) = 'a' and then
                           S (I + 2) = 's' and then
                           S (I + 3) = 'e' and then
                           S (I + 4) = 'd'
                     then
                        Stop := I + 4; --  aliased
                     end if;

                  when 'n' =>
                     I := I + 1;
                     if S (I) = 'd' then
                        Stop := I; --  and
                     end if;

                  when 'r' =>
                     I := I + 1;
                     if S (I)     = 'r' and then
                        S (I + 1) = 'a' and then
                        S (I + 2) = 'y'
                     then
                        Stop := I + 2; --  array
                     end if;

                  when 't' =>
                     Stop := I; --  at

                  when others =>
                     null;

               end case;

            when 'b' =>
               if S (I)     = 'e' and then
                  S (I + 1) = 'g' and then
                  S (I + 2) = 'i' and then
                  S (I + 3) = 'n'
               then
                  Stop := I + 3; --  begin
               elsif S (I)     = 'o' and then
                     S (I + 1) = 'd' and then
                     S (I + 2) = 'y'
               then
                  Stop := I + 2; --  body
               end if;

            when 'c' =>
               if S (I)     = 'a' and then
                  S (I + 1) = 's' and then
                  S (I + 2) = 'e'
               then
                  Stop := I + 2; --  case
               elsif S (I)     = 'o' and then
                     S (I + 1) = 'n' and then
                     S (I + 2) = 's' and then
                     S (I + 3) = 't' and then
                     S (I + 4) = 'a' and then
                     S (I + 5) = 'n' and then
                     S (I + 6) = 't'
               then
                  Stop := I + 6; --  constant
               end if;

            when 'd' =>
               if S (I) = 'e' then
                  I := I + 1;
                  if S (I)     = 'c' and then
                     S (I + 1) = 'l' and then
                     S (I + 2) = 'a' and then
                     S (I + 3) = 'r' and then
                     S (I + 4) = 'e'
                  then
                     Stop := I + 4; --  declare
                  elsif S (I) = 'l' then
                     I := I + 1;
                     if (S (I) = 'a' and then S (I + 1) = 'y')
                        or else
                        (S (I) = 't' and then S (I + 1) = 'a')
                     then
                        Stop := I + 1; --  delay, delta
                     end if;
                  end if;
               elsif S (I)     = 'i' and then
                     S (I + 1) = 'g' and then
                     S (I + 2) = 'i' and then
                     S (I + 3) = 't' and then
                     S (I + 4) = 's'
               then
                  Stop := I + 4; --  digits
               elsif S (I) = 'o' then
                  Stop := I; --  do
               end if;

            when 'e' =>
               if S (I)     = 'l' and then
                  S (I + 1) = 's'
               then
                  I := I + 2;
                  if S (I) = 'e' then
                     Stop := I; --  else
                  elsif S (I) = 'i' and then S (I + 1) = 'f' then
                     Stop := I + 1; --  elsif
                  end if;
               elsif S (I) = 'n' then
                  I := I + 1;
                  if S (I) = 'd' then
                     Stop := I; --  end
                  elsif S (I)     = 't' and then
                        S (I + 1) = 'r' and then
                        S (I + 2) = 'y'
                  then
                     Stop := I + 2; --  entry
                  end if;
               elsif S (I) = 'x' then
                  I := I + 1;
                  if S (I)     = 'c' and then
                     S (I + 1) = 'e' and then
                     S (I + 2) = 'p' and then
                     S (I + 3) = 't' and then
                     S (I + 4) = 'i' and then
                     S (I + 5) = 'o' and then
                     S (I + 6) = 'n'
                  then
                     Stop := I + 6; --  exception
                  elsif S (I) = 'i' and then S (I + 1) = 't' then
                     Stop := I + 1; --  exit
                  end if;
               end if;

            when 'f' =>
               if S (I) = 'o' and then S (I + 1) = 'r' then
                  Stop := I + 1; --  for
               elsif S (I)     = 'u' and then
                     S (I + 1) = 'n' and then
                     S (I + 2) = 'c' and then
                     S (I + 3) = 't' and then
                     S (I + 4) = 'i' and then
                     S (I + 5) = 'o' and then
                     S (I + 6) = 'n'
               then
                  Stop := I + 6; --  function
               end if;

            when 'g' =>
               if S (I)     = 'e' and then
                  S (I + 1) = 'n' and then
                  S (I + 2) = 'e' and then
                  S (I + 3) = 'r' and then
                  S (I + 4) = 'i' and then
                  S (I + 5) = 'c'
               then
                  Stop := I + 5; --  generic
               elsif S (I)     = 'o' and then
                     S (I + 1) = 't' and then
                     S (I + 2) = 'o'
               then
                  Stop := I + 2; --  goto
               end if;

            when 'i' =>
               if S (I) = 'f' or else S (I) = 'n' or else S (I) = 's' then
                  Stop := I; --  if, in, is
               end if;

            when 'l' =>
               if S (I)     = 'i' and then
                  S (I + 1) = 'm' and then
                  S (I + 2) = 'i' and then
                  S (I + 3) = 't' and then
                  S (I + 4) = 'e' and then
                  S (I + 5) = 'd'
               then
                  Stop := I + 5; --  limited
               elsif S (I)     = 'o' and then
                     S (I + 1) = 'o' and then
                     S (I + 2) = 'p'
               then
                  Stop := I + 2; --  loop
               end if;

            when 'm' =>
               if S (I) = 'o' and then S (I + 1) = 'd' then
                  Stop := I + 1; --  mod
               end if;

            when 'n' =>
               if S (I) = 'e' and then S (I + 1) = 'w' then
                  Stop := I + 1; --  new
               elsif S (I) = 'o' and then S (I + 1) = 't' then
                  Stop := I + 1; --  not
               elsif S (I)     = 'u' and then
                     S (I + 1) = 'l' and then
                     S (I + 2) = 'l'
               then
                  Stop := I + 2; --  null
               end if;

            when 'o' =>
               if S (I) = 'f' or else S (I) = 'r' then
                  Stop := I; --  of, or
               elsif S (I) = 't' and then
                     S (I + 1) = 'h' and then
                     S (I + 2) = 'e' and then
                     S (I + 3) = 'r' and then
                     S (I + 4) = 's'
               then
                  Stop := I + 4;
               elsif S (I) = 'u' and then S (I + 1) = 't' then
                  Stop := I + 1;
               end if;

            when 'p' =>
               if S (I) = 'a' and then
                  S (I + 1) = 'c' and then
                  S (I + 2) = 'k' and then
                  S (I + 3) = 'a' and then
                  S (I + 4) = 'g' and then
                  S (I + 5) = 'e'
               then
                  Stop := I + 5; --  package
               elsif S (I) = 'r' then
                  I := I + 1;
                  if S (I)     = 'a' and then
                     S (I + 1) = 'g' and then
                     S (I + 2) = 'm' and then
                     S (I + 3) = 'a'
                  then
                     Stop := I + 3; --  pragma
                  elsif S (I)     = 'i' and then
                        S (I + 1) = 'v' and then
                        S (I + 2) = 'a' and then
                        S (I + 3) = 't' and then
                        S (I + 4) = 'e'
                  then
                     Stop := I + 4; --  private
                  elsif S (I) = 'o' then
                     I := I + 1;
                     if S (I)     = 'c' and then
                        S (I + 1) = 'e' and then
                        S (I + 2) = 'd' and then
                        S (I + 3) = 'u' and then
                        S (I + 4) = 'r' and then
                        S (I + 5) = 'e'
                     then
                        Stop := I + 5; --  procedure
                     elsif S (I)     = 't' and then
                           S (I + 1) = 'e' and then
                           S (I + 2) = 'c' and then
                           S (I + 3) = 't' and then
                           S (I + 4) = 'e' and then
                           S (I + 5) = 'd'
                     then
                        Stop := I + 5;
                     end if;
                  end if;
               end if;

            when 'r' =>
               if S (I) = 'a' then
                  I := I + 1;
                  if S (I)     = 'i' and then
                     S (I + 1) = 's' and then
                     S (I + 2) = 'e'
                  then
                     Stop := I + 2; --  raise
                  elsif S (I)     = 'n' and then
                        S (I + 1) = 'g' and then
                        S (I + 2) = 'e'
                  then
                     Stop := I + 2; --  range
                  end if;
               elsif S (I) = 'e' then
                  I := I + 1;
                  case S (I) is
                     when 'c' =>
                        I := I + 1;
                        if S (I)     = 'o' and then
                           S (I + 1) = 'r' and then
                           S (I + 2) = 'd'
                        then
                           Stop := I + 2; --  record
                        end if;

                     when 'm' =>
                        Stop := I; --  rem

                     when 'n' =>
                        I := I + 1;
                        if S (I)     = 'a' and then
                           S (I + 1) = 'm' and then
                           S (I + 2) = 'e' and then
                           S (I + 3) = 's'
                        then
                           Stop := I + 3; --  renames
                        end if;

                     when 'q' =>
                        I := I + 1;
                        if S (I)     = 'u' and then
                           S (I + 1) = 'e' and then
                           S (I + 2) = 'u' and then
                           S (I + 3) = 'e' and then
                           S (I + 4) = 's'
                        then
                           Stop := I + 4; --  requeues
                        end if;

                     when 't' =>
                        I := I + 1;
                        if S (I)     = 'u' and then
                           S (I + 1) = 'r' and then
                           S (I + 2) = 'n'
                        then
                           Stop := I + 2; --  return
                        end if;

                     when 'v' =>
                        I := I + 1;
                        if S (I)     = 'e' and then
                           S (I + 1) = 'r' and then
                           S (I + 2) = 's' and then
                           S (I + 3) = 'e'
                        then
                           Stop := I + 3; --  reverse
                        end if;

                     when others =>
                        null;
                  end case;
               end if;

            when 's' =>
               if S (I) = 'e' then
                  I := I + 1;
                  if S (I)     = 'l' and then
                     S (I + 1) = 'e' and then
                     S (I + 2) = 'c' and then
                     S (I + 3) = 't'
                  then
                     Stop := I + 3; --  select
                  elsif S (I)     = 'p' and then
                        S (I + 1) = 'a' and then
                        S (I + 2) = 'r' and then
                        S (I + 3) = 'a' and then
                        S (I + 4) = 't' and then
                        S (I + 5) = 'e'
                  then
                     Stop := I + 5; --  separate
                  end if;
               elsif S (I)     = 'u' and then
                     S (I + 1) = 'b' and then
                     S (I + 2) = 't' and then
                     S (I + 3) = 'y' and then
                     S (I + 4) = 'p' and then
                     S (I + 5) = 'e'
               then
                  Stop := I + 5; --  subtype
               end if;

            when 't' =>
               case S (I) is
                  when 'a' =>
                     I := I + 1;
                     if S (I)     = 'g' and then
                        S (I + 1) = 'g' and then
                        S (I + 2) = 'e' and then
                        S (I + 3) = 'd'
                     then
                        Stop := I + 3; --  tagged
                     elsif S (I) = 's' and then S (I + 1) = 'k' then
                        Stop := I + 1; --  task;
                     end if;

                  when 'e' =>
                     I := I + 1;
                     if S (I)     = 'r' and then
                        S (I + 1) = 'm' and then
                        S (I + 2) = 'i' and then
                        S (I + 3) = 'n' and then
                        S (I + 4) = 'a' and then
                        S (I + 5) = 't' and then
                        S (I + 6) = 'e'
                     then
                        Stop := I + 6; --  terminate
                     end if;

                  when 'h' =>
                     I := I + 1;
                     if S (I) = 'e' and then S (I + 1) = 'n' then
                        Stop := I + 1; --  then
                     end if;

                  when 'y' =>
                     I := I + 1;
                     if S (I) = 'p' and then S (I + 1) = 'e' then
                        Stop := I + 1; --  type
                     end if;

                  when others =>
                     null;
               end case;

            when 'u' =>
               if S (I)     = 'n' and then
                  S (I + 1) = 't' and then
                  S (I + 2) = 'i' and then
                  S (I + 3) = 'l'
               then
                  Stop := I + 3; --  until
               elsif S (I) = 's' and then S (I + 1) = 'e' then
                  Stop := I + 1; --  use
               end if;

            when 'w' =>
               if S (I) = 'h' then
                  I := I + 1;
                  if S (I) = 'e' and then S (I + 1) = 'n' then
                     Stop := I + 1; --  when
                  elsif S (I)     = 'i' and then
                        S (I + 1) = 'l' and then
                        S (I + 2) = 'e'
                  then
                     Stop := I + 2;
                  end if;
               elsif S (I)     = 'i' and then
                     S (I + 1) = 't' and then
                     S (I + 2) = 'h'
               then
                  Stop := I + 2; --  with
               end if;

            when 'x' =>
               if S (I) = 'o' and then S (I + 1) = 'r' then
                  Stop := I + 1; --  xor
               end if;

            when others =>
               --  Can't happen.
               raise Program_Error;

         end case;
         if Stop /= 0 then
            I := Stop + 1;
            --  We think we've found a keyword... but it must be followed by
            --  a word delimiter!
            exit when ASM.Is_In (S (I), A_Word_Delimiter);
            --  Sorry, no.
            Stop := 0;
         end if;
         Left := S (I); I := I + 1; Start := 0;
      end loop;
   end Find_Keyword;

end AD.Syntax;
