src/languages.adb

   1 ------------------------------------------------------------------------------
   2 --                              Style Checker                               --
   3 --                                                                          --
   4 --                    Copyright (C) 2006, Pascal Obry                       --
   5 --                                                                          --
   6 --  This library is free software; you can redistribute it and/or modify    --
   7 --  it under the terms of the GNU General Public License as published by    --
   8 --  the Free Software Foundation; either version 2 of the License, or (at   --
   9 --  your option) any later version.                                         --
  10 --                                                                          --
  11 --  This library is distributed in the hope that it will be useful, but     --
  12 --  WITHOUT ANY WARRANTY; without even the implied warranty of              --
  13 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
  14 --  General Public License for more details.                                --
  15 --                                                                          --
  16 --  You should have received a copy of the GNU General Public License       --
  17 --  along with this library; if not, write to the Free Software Foundation, --
  18 --  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --
  19 --                                                                          --
  20 ------------------------------------------------------------------------------
  21
  22 with Ada.Characters.Handling;
  23 with Ada.Directories;
  24 with Ada.Strings.Unbounded;
  25 with Ada.Text_IO;
  26
  27 package body Languages is
  28
  29    use Ada;
  30    use Ada.Strings.Unbounded;
  31    use Ada.Characters.Handling;
  32
  33    Lang_Set : array (1 .. 50) of Lang_Access;
  34    Index    : Natural := 0;
  35
  36    function Get_From_Name (Name : in String) return Lang'Class;
  37    --  Return a language given its name
  38
  39    ---------------------------------
  40    -- Add_Style_Checker_Parameter --
  41    ---------------------------------
  42
  43    procedure Add_Style_Checker_Parameter
  44      (L         : in Lang_Access;
  45       Parameter : in String) is
  46    begin
  47       if L = null then
  48          raise Checks.Syntax_Error;
  49
  50       else
  51          L.C.Index := L.C.Index + 1;
  52
  53          if L.C.Index > L.C.Checker_Params'Last then
  54             raise Checks.Syntax_Error;
  55          else
  56             L.C.Checker_Params (L.C.Index) := new String'(Parameter);
  57          end if;
  58       end if;
  59    end Add_Style_Checker_Parameter;
  60
  61    -------------
  62    -- Comment --
  63    -------------
  64
  65    function Comment (L : in Lang) return String is
  66    begin
  67       return "";
  68    end Comment;
  69
  70    ----------------------
  71    -- Run_Syntax_Check --
  72    ----------------------
  73
  74    function Run_Syntax_Check
  75      (L : in Lang; Filename : in String) return Boolean is
  76    begin
  77       return True;
  78    end Run_Syntax_Check;
  79
  80    ---------
  81    -- Get --
  82    ---------
  83
  84    function Get (Filename : in String) return Lang'Class is
  85       Ext : constant String := Directories.Extension (Filename);
  86    begin
  87       for K in 1 .. Index loop
  88          if Is_Extension (Lang_Set (K).all, Ext) then
  89             return Lang_Set (K).all;
  90          end if;
  91       end loop;
  92
  93       return Get_From_Name ("unknown");
  94    end Get;
  95
  96    ---------------------------
  97    -- Get_Copyright_Pattern --
  98    ---------------------------
  99
 100    function Get_Copyright_Pattern (L : in Lang) return String is
 101    begin
 102       return To_String (L.C.Copyright_Pattern);
 103    end Get_Copyright_Pattern;
 104
 105    -------------------
 106    -- Get_From_Name --
 107    -------------------
 108
 109    function Get_From_Name (Name : in String) return Lang_Access is
 110       L_Name : constant String := To_Lower (Name);
 111    begin
 112       for K in 1 .. Index loop
 113          if To_Lower (To_String (Lang_Set (K).Name)) = L_Name then
 114             return Lang_Set (K);
 115          end if;
 116       end loop;
 117
 118       return Get_From_Name ("unknown");
 119    end Get_From_Name;
 120
 121    function Get_From_Name (Name : in String) return Lang'Class is
 122    begin
 123       return Get_From_Name (Name).all;
 124    end Get_From_Name;
 125
 126    ------------------
 127    -- Is_Extension --
 128    ------------------
 129
 130    function Is_Extension (L : in Lang; Ext : in String) return Boolean is
 131    begin
 132       return False;
 133    end Is_Extension;
 134
 135    ----------
 136    -- List --
 137    ----------
 138
 139    procedure List is
 140    begin
 141       for K in 1 .. Index loop
 142          declare
 143             L_Name : constant String := Name (Lang_Set (K).all);
 144          begin
 145             if L_Name /= "unknown" then
 146                Text_IO.Put_Line ("   " & L_Name);
 147             end if;
 148          end;
 149       end loop;
 150    end List;
 151
 152    ----------
 153    -- Name --
 154    ----------
 155
 156    function Name (L : in Lang) return String is
 157    begin
 158       return To_String (L.Name);
 159    end Name;
 160
 161    --------------
 162    -- Register --
 163    --------------
 164
 165    procedure Register (L : in Lang'Class; Name : in String) is
 166    begin
 167       Index := Index + 1;
 168       Lang_Set (Index) :=  new Lang'Class'(L);
 169       Lang_Set (Index).Name := To_Unbounded_String (Name);
 170    end Register;
 171
 172    ---------------------------
 173    -- Set_Copyright_Pattern --
 174    ---------------------------
 175
 176    procedure Set_Copyright_Pattern
 177      (L       : in Lang_Access;
 178       Pattern : in String) is
 179    begin
 180       if L = null then
 181          for K in 1 .. Index loop
 182             Set_Copyright_Pattern (Lang_Set (K), Pattern);
 183          end loop;
 184
 185       else
 186          L.C.Copyright_Pattern := To_Unbounded_String (Pattern);
 187       end if;
 188    end Set_Copyright_Pattern;
 189
 190    ------------------------------
 191    -- Set_Duplicate_Blank_Line --
 192    ------------------------------
 193
 194    procedure Set_Duplicate_Blank_Line
 195      (L    : in Lang_Access;
 196       Mode : in Checks.Mode) is
 197    begin
 198       if L = null then
 199          for K in 1 .. Index loop
 200             Set_Duplicate_Blank_Line (Lang_Set (K), Mode);
 201          end loop;
 202
 203       else
 204          L.C.Duplicate_Blank_Line := Mode;
 205       end if;
 206    end Set_Duplicate_Blank_Line;
 207
 208    ---------------------
 209    -- Set_Line_Ending --
 210    ---------------------
 211
 212    procedure Set_Line_Ending
 213      (L      : in Lang_Access;
 214       Ending : in Checks.Line_Ending_Style) is
 215    begin
 216       if L = null then
 217          for K in 1 .. Index loop
 218             Set_Line_Ending (Lang_Set (K), Ending);
 219          end loop;
 220
 221       else
 222          L.C.Line_Ending := Ending;
 223       end if;
 224    end Set_Line_Ending;
 225
 226    -------------------------
 227    -- Set_Line_Length_Max --
 228    -------------------------
 229
 230    procedure Set_Line_Length_Max
 231      (L      : in Lang_Access;
 232       Length : in Positive) is
 233    begin
 234       if L = null then
 235          for K in 1 .. Index loop
 236             Set_Line_Length_Max (Lang_Set (K), Length);
 237          end loop;
 238
 239       else
 240          L.C.Line_Length_Max := Length;
 241       end if;
 242    end Set_Line_Length_Max;
 243
 244    -----------------------
 245    -- Set_Space_Comment --
 246    -----------------------
 247
 248    procedure Set_Space_Comment
 249      (L      : in Lang_Access;
 250       Number : in Natural) is
 251    begin
 252       if L = null then
 253          for K in 1 .. Index loop
 254             Set_Space_Comment (Lang_Set (K), Number);
 255          end loop;
 256
 257       else
 258          L.C.Space_Comment := Number;
 259       end if;
 260    end Set_Space_Comment;
 261
 262    ---------------------
 263    -- Set_Header_Size --
 264    ---------------------
 265
 266    procedure Set_Header_Size
 267      (L    : in Lang_Access;
 268       Size : in Natural) is
 269    begin
 270       if L = null then
 271          for K in 1 .. Index loop
 272             Set_Header_Size (Lang_Set (K), Size);
 273          end loop;
 274
 275       else
 276          L.C.Header_Size := Size;
 277       end if;
 278    end Set_Header_Size;
 279
 280    ---------------------------
 281    -- Set_Copyright_Present --
 282    ---------------------------
 283
 284    procedure Set_Copyright_Present
 285      (L    : in Lang_Access;
 286       Mode : in Boolean) is
 287    begin
 288       if L = null then
 289          for K in 1 .. Index loop
 290             Set_Copyright_Present (Lang_Set (K), Mode);
 291          end loop;
 292
 293       else
 294          L.C.Copyright_Present := Mode;
 295       end if;
 296    end Set_Copyright_Present;
 297
 298    ------------------------
 299    -- Set_Copyright_Year --
 300    ------------------------
 301
 302    procedure Set_Copyright_Year
 303      (L    : in Lang_Access;
 304       Mode : in Boolean) is
 305    begin
 306       if L = null then
 307          for K in 1 .. Index loop
 308             Set_Copyright_Year (Lang_Set (K), Mode);
 309          end loop;
 310
 311       else
 312          L.C.Copyright_Year := Mode;
 313       end if;
 314    end Set_Copyright_Year;
 315
 316    ----------------------
 317    -- Set_Syntax_Check --
 318    ----------------------
 319
 320    procedure Set_Syntax_Check
 321      (L    : in Lang_Access;
 322       Mode : in Boolean) is
 323    begin
 324       if L = null then
 325          for K in 1 .. Index loop
 326             Set_Syntax_Check (Lang_Set (K), Mode);
 327          end loop;
 328
 329       else
 330          L.C.Check_Syntax := Mode;
 331       end if;
 332    end Set_Syntax_Check;
 333
 334    -------------------------
 335    -- Set_Trailing_Spaces --
 336    -------------------------
 337
 338    procedure Set_Trailing_Spaces
 339      (L    : in Lang_Access;
 340       Mode : in Checks.Mode) is
 341    begin
 342       if L = null then
 343          for K in 1 .. Index loop
 344             Set_Trailing_Spaces (Lang_Set (K), Mode);
 345          end loop;
 346
 347       else
 348          L.C.Trailing_Spaces := Mode;
 349       end if;
 350    end Set_Trailing_Spaces;
 351
 352    ---------------------------
 353    -- Get_Copyright_Present --
 354    ---------------------------
 355
 356    function Get_Copyright_Present (L : in Lang) return Boolean is
 357    begin
 358       return L.C.Copyright_Present;
 359    end Get_Copyright_Present;
 360
 361    ------------------------
 362    -- Get_Copyright_Year --
 363    ------------------------
 364
 365    function Get_Copyright_Year (L : in Lang) return Boolean is
 366    begin
 367       return L.C.Copyright_Year;
 368    end Get_Copyright_Year;
 369
 370    ------------------------------
 371    -- Get_Duplicate_Blank_Line --
 372    ------------------------------
 373
 374    function Get_Duplicate_Blank_Line (L : in Lang) return Checks.Mode is
 375    begin
 376       return L.C.Duplicate_Blank_Line;
 377    end Get_Duplicate_Blank_Line;
 378
 379    ---------------------
 380    -- Get_Header_Size --
 381    ---------------------
 382
 383    function Get_Header_Size (L : in Lang) return Natural is
 384    begin
 385       return  L.C.Header_Size;
 386    end Get_Header_Size;
 387
 388    ---------------------
 389    -- Get_Line_Ending --
 390    ---------------------
 391
 392    function Get_Line_Ending
 393      (L : in Lang) return Checks.Line_Ending_Style is
 394    begin
 395       return L.C.Line_Ending;
 396    end Get_Line_Ending;
 397
 398    -------------------------
 399    -- Get_Line_Length_Max --
 400    -------------------------
 401
 402    function Get_Line_Length_Max (L : in Lang) return Positive is
 403    begin
 404       return L.C.Line_Length_Max;
 405    end Get_Line_Length_Max;
 406
 407    -----------------------
 408    -- Get_Space_Comment --
 409    -----------------------
 410
 411    function Get_Space_Comment (L : in Lang) return Natural is
 412    begin
 413       return L.C.Space_Comment;
 414    end Get_Space_Comment;
 415
 416    ----------------------
 417    -- Get_Syntax_Check --
 418    ----------------------
 419
 420    function Get_Syntax_Check (L : in Lang) return Boolean is
 421    begin
 422       return L.C.Check_Syntax;
 423    end Get_Syntax_Check;
 424
 425    -------------------------
 426    -- Get_Trailing_Spaces --
 427    -------------------------
 428
 429    function Get_Trailing_Spaces (L : in Lang) return Checks.Mode is
 430    begin
 431       return L.C.Trailing_Spaces;
 432    end Get_Trailing_Spaces;
 433
 434    ----------------------------------
 435    -- Get_Style_Checker_Parameters --
 436    ----------------------------------
 437
 438    function Get_Style_Checker_Parameters
 439      (L : in Lang) return GNAT.OS_Lib.Argument_List is
 440    begin
 441       return L.C.Checker_Params (1 .. L.C.Index);
 442    end Get_Style_Checker_Parameters;
 443
 444 end Languages;