home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / adav313.zip / gnat-3_13p-os2-bin-20010916.zip / emx / gnatlib / g-speche.adb < prev    next >
Text File  |  2000-07-19  |  6KB  |  156 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                 G N A T . S P E L L I N G _ C H E C K E R                --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.1 $                              --
  10. --                                                                          --
  11. --              Copyright (C) 1998 Ada Core Technologies, Inc.              --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22. -- MA 02111-1307, USA.                                                      --
  23. --                                                                          --
  24. -- As a special exception,  if other files  instantiate  generics from this --
  25. -- unit, or you link  this unit with other files  to produce an executable, --
  26. -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27. -- covered  by the  GNU  General  Public  License.  This exception does not --
  28. -- however invalidate  any other reasons why  the executable file  might be --
  29. -- covered by the  GNU Public License.                                      --
  30. --                                                                          --
  31. -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).   --
  32. --                                                                          --
  33. ------------------------------------------------------------------------------
  34.  
  35. package body GNAT.Spelling_Checker is
  36.  
  37.    ------------------------
  38.    -- Is_Bad_Spelling_Of --
  39.    ------------------------
  40.  
  41.    function Is_Bad_Spelling_Of
  42.      (Found  : String;
  43.       Expect : String)
  44.       return   Boolean
  45.    is
  46.       FN : constant Natural := Found'Length;
  47.       FF : constant Natural := Found'First;
  48.       FL : constant Natural := Found'Last;
  49.  
  50.       EN : constant Natural := Expect'Length;
  51.       EF : constant Natural := Expect'First;
  52.       EL : constant Natural := Expect'Last;
  53.  
  54.    begin
  55.       --  If both strings null, then we consider this a match, but if one
  56.       --  is null and the other is not, then we definitely do not match
  57.  
  58.       if FN = 0 then
  59.          return (EN = 0);
  60.       
  61.       elsif EN = 0 then
  62.          return False;
  63.  
  64.       --  If first character does not match, then definitely not misspelling
  65.  
  66.       elsif Found (FF) /= Expect (EF) then
  67.          return False;
  68.  
  69.       --  Not a bad spelling if both strings are 1-2 characters long
  70.  
  71.       elsif FN < 3 and then EN < 3 then
  72.          return False;
  73.  
  74.       --  Lengths match. Execute loop to check for a single error, single
  75.       --  transposition or exact match (we only fall through this loop if
  76.       --  one of these three conditions is found).
  77.  
  78.       elsif FN = EN then
  79.          for J in 1 .. FN - 2 loop
  80.             if Expect (EF + J) /= Found (FF + J) then
  81.  
  82.                --  If both mismatched characters are digits, then we do
  83.                --  not consider it a misspelling (e.g. B345 is not a
  84.                --  misspelling of B346, it is something quite different)
  85.  
  86.                if Expect (EF + J) in '0' .. '9'
  87.                  and then Found (FF + J) in '0' .. '9'
  88.                then
  89.                   return False;
  90.  
  91.                elsif Expect (EF + J + 1) = Found (FF + J + 1)
  92.                  and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
  93.                then
  94.                   return True;
  95.  
  96.                elsif Expect (EF + J) = Found (FF + J + 1)
  97.                  and then Expect (EF + J + 1) = Found (FF + J)
  98.                  and then Expect (EF + J + 2 .. EL) = Found (FF + J + 2 .. FL)
  99.                then
  100.                   return True;
  101.  
  102.                else
  103.                   return False;
  104.                end if;
  105.             end if;
  106.          end loop;
  107.  
  108.          --  At last character. Test digit case as above, otherwise we
  109.          --  have a match since at most this last character fails to match.
  110.  
  111.          if Expect (EL) in '0' .. '9'
  112.            and then Found (FL) in '0' .. '9'
  113.          then
  114.             return False;
  115.          else
  116.             return True;
  117.          end if;
  118.  
  119.       --  Length is 1 too short. Execute loop to check for single deletion
  120.  
  121.       elsif FN = EN - 1 then
  122.          for J in 1 .. FN - 1 loop
  123.             if Found (FF + J) /= Expect (EF + J) then
  124.                return Found (FF + J .. FL) = Expect (EF + J + 1 .. EL);
  125.             end if;
  126.          end loop;
  127.  
  128.          --  If we fall through then the last character was missing, which
  129.          --  we consider to be a match (e.g. found xyz, expected xyza).
  130.  
  131.          return True;
  132.  
  133.       --  Length is 1 too long. Execute loop to check for single insertion
  134.  
  135.       elsif FN = EN + 1 then
  136.          for J in 1 .. FN - 1 loop
  137.             if Found (FF + J) /= Expect (EF + J) then
  138.                return Found (FF + J + 1 .. FL) = Expect (EF + J .. EL);
  139.             end if;
  140.          end loop;
  141.  
  142.          --  If we fall through then the last character was an additional
  143.          --  character, which is a match (e.g. found xyza, expected xyz).
  144.  
  145.          return True;
  146.  
  147.       --  Length is completely wrong
  148.  
  149.       else
  150.          return False;
  151.       end if;
  152.  
  153.    end Is_Bad_Spelling_Of;
  154.  
  155. end GNAT.Spelling_Checker;
  156.