src/languages.adb

   1 ------------------------------------------------------------------------------
   2 --                              Style Checker                               --
   3 --                                                                          --
   4 --                 Copyright (C) 2006-2008, 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.Text_IO;
  25
  26 package body Languages is
  27
  28    use Ada;
  29    use Ada.Characters.Handling;
  30
  31    Lang_Set : array (1 .. 50) of Lang_Access;
  32    Index    : Natural := 0;
  33
  34    function Get_From_Name (Name : in String) return Lang'Class;
  35    --  Return a language given its name
  36
  37    ---------------------------------
  38    -- Add_Style_Checker_Parameter --
  39    ---------------------------------
  40
  41    procedure Add_Style_Checker_Parameter
  42      (L         : in Lang_Access;
  43       Parameter : in String) is
  44    begin
  45       if L = null then
  46          raise Checks.Syntax_Error;
  47
  48       else
  49          L.C.Index := L.C.Index + 1;
  50
  51          if L.C.Index > L.C.Checker_Params'Last then
  52             raise Checks.Syntax_Error;
  53          else
  54             L.C.Checker_Params (L.C.Index) := new String'(Parameter);
  55          end if;
  56       end if;
  57    end Add_Style_Checker_Parameter;
  58
  59    -------------
  60    -- Comment --
  61    -------------
  62
  63    function Comment (L : in Lang) return String is
  64       pragma Unreferenced (L);
  65    begin
  66       return "";
  67    end Comment;
  68
  69    ---------------------------
  70    -- End_Multiline_Comment --
  71    ---------------------------
  72
  73    function End_Multiline_Comment (L : in Lang) return String is
  74       pragma Unreferenced (L);
  75    begin
  76       return "";
  77    end End_Multiline_Comment;
  78
  79    ---------
  80    -- Get --
  81    ---------
  82
  83    function Get (Filename : in String) return Lang'Class is
  84       Ext   : aliased constant String := Directories.Extension (Filename);
  85       Base  : aliased constant String := Directories.Base_Name (Filename);
  86       Check : access constant String;
  87    begin
  88       if Ext = "" then
  89          Check := Base'Access;
  90       else
  91          Check := Ext'Access;
  92       end if;
  93
  94       for K in 1 .. Index loop
  95          if Is_Extension (Lang_Set (K).all, Check.all) then
  96             return Lang_Set (K).all;
  97          end if;
  98       end loop;
  99
 100       return Get_From_Name ("unknown");
 101    end Get;
 102
 103    -------------------------
 104    -- Get_Comment_Dot_EOL --
 105    -------------------------
 106
 107    function Get_Comment_Dot_EOL (L : in Lang) return Boolean is
 108    begin
 109       return L.C.Comment_Dot_EOL;
 110    end Get_Comment_Dot_EOL;
 111
 112    ---------------------------
 113    -- Get_Copyright_Pattern --
 114    ---------------------------
 115
 116    function Get_Copyright_Pattern (L : in Lang) return String is
 117    begin
 118       return To_String (L.C.Copyright_Pattern);
 119    end Get_Copyright_Pattern;
 120
 121    ---------------------------
 122    -- Get_Copyright_Present --
 123    ---------------------------
 124
 125    function Get_Copyright_Present (L : in Lang) return Boolean is
 126    begin
 127       return L.C.Copyright_Present;
 128    end Get_Copyright_Present;
 129
 130    ------------------------
 131    -- Get_Copyright_Year --
 132    ------------------------
 133
 134    function Get_Copyright_Year (L : in Lang) return Boolean is
 135    begin
 136       return L.C.Copyright_Year;
 137    end Get_Copyright_Year;
 138
 139    ------------------------------
 140    -- Get_Duplicate_Blank_Line --
 141    ------------------------------
 142
 143    function Get_Duplicate_Blank_Line (L : in Lang) return Checks.Mode is
 144    begin
 145       return L.C.Duplicate_Blank_Line;
 146    end Get_Duplicate_Blank_Line;
 147
 148    -------------------
 149    -- Get_From_Name --
 150    -------------------
 151
 152    function Get_From_Name (Name : in String) return Lang_Access is
 153       L_Name : constant String := To_Lower (Name);
 154    begin
 155       for K in 1 .. Index loop
 156          if To_Lower (To_String (Lang_Set (K).Name)) = L_Name then
 157             return Lang_Set (K);
 158          end if;
 159       end loop;
 160
 161       return Get_From_Name ("unknown");
 162    end Get_From_Name;
 163
 164    function Get_From_Name (Name : in String) return Lang'Class is
 165    begin
 166       return Get_From_Name (Name).all;
 167    end Get_From_Name;
 168
 169    ---------------------
 170    -- Get_Header_Size --
 171    ---------------------
 172
 173    function Get_Header_Size (L : in Lang) return Natural is
 174    begin
 175       return  L.C.Header_Size;
 176    end Get_Header_Size;
 177
 178    ---------------------
 179    -- Get_Line_Ending --
 180    ---------------------
 181
 182    function Get_Line_Ending
 183      (L : in Lang) return Checks.Line_Ending_Style is
 184    begin
 185       return L.C.Line_Ending;
 186    end Get_Line_Ending;
 187
 188    -------------------------
 189    -- Get_Line_Length_Max --
 190    -------------------------
 191
 192    function Get_Line_Length_Max (L : in Lang) return Positive is
 193    begin
 194       return L.C.Line_Length_Max;
 195    end Get_Line_Length_Max;
 196
 197    -----------------------
 198    -- Get_Space_Comment --
 199    -----------------------
 200
 201    function Get_Space_Comment (L : in Lang) return Natural is
 202    begin
 203       return L.C.Space_Comment;
 204    end Get_Space_Comment;
 205
 206    ----------------------------------
 207    -- Get_Style_Checker_Parameters --
 208    ----------------------------------
 209
 210    function Get_Style_Checker_Parameters
 211      (L : in Lang) return GNAT.OS_Lib.Argument_List is
 212    begin
 213       return L.C.Checker_Params (1 .. L.C.Index);
 214    end Get_Style_Checker_Parameters;
 215
 216    ----------------------
 217    -- Get_Syntax_Check --
 218    ----------------------
 219
 220    function Get_Syntax_Check (L : in Lang) return Boolean is
 221    begin
 222       return L.C.Check_Syntax;
 223    end Get_Syntax_Check;
 224
 225    -------------------------
 226    -- Get_Trailing_Spaces --
 227    -------------------------
 228
 229    function Get_Trailing_Spaces (L : in Lang) return Checks.Mode is
 230    begin
 231       return L.C.Trailing_Spaces;
 232    end Get_Trailing_Spaces;
 233
 234    ------------------
 235    -- Is_Extension --
 236    ------------------
 237
 238    function Is_Extension (L : in Lang; Ext : in String) return Boolean is
 239       pragma Unreferenced (L, Ext);
 240    begin
 241       return False;
 242    end Is_Extension;
 243
 244    ----------
 245    -- List --
 246    ----------
 247
 248    procedure List is
 249    begin
 250       for K in 1 .. Index loop
 251          declare
 252             L_Name : constant String := Name (Lang_Set (K).all);
 253          begin
 254             if L_Name /= "unknown" then
 255                Text_IO.Put_Line ("   " & L_Name);
 256             end if;
 257          end;
 258       end loop;
 259    end List;
 260
 261    ----------
 262    -- Name --
 263    ----------
 264
 265    function Name (L : in Lang) return String is
 266    begin
 267       return To_String (L.Name);
 268    end Name;
 269
 270    --------------
 271    -- Register --
 272    --------------
 273
 274    procedure Register (L : in Lang'Class; Name : in String) is
 275    begin
 276       Index := Index + 1;
 277       Lang_Set (Index) :=  new Lang'Class'(L);
 278       Lang_Set (Index).Name := To_Unbounded_String (Name);
 279    end Register;
 280
 281    ----------------------
 282    -- Run_Syntax_Check --
 283    ----------------------
 284
 285    function Run_Syntax_Check
 286      (L : in Lang; Filename : in String) return Boolean is
 287       pragma Unreferenced (L, Filename);
 288    begin
 289       return True;
 290    end Run_Syntax_Check;
 291
 292    -------------------------
 293    -- Set_Comment_Dot_EOL --
 294    -------------------------
 295
 296    procedure Set_Comment_Dot_EOL
 297      (L    : in Lang_Access;
 298       Mode : in Boolean) is
 299    begin
 300       if L = null then
 301          for K in 1 .. Index loop
 302             Set_Comment_Dot_EOL (Lang_Set (K), Mode);
 303          end loop;
 304
 305       else
 306          L.C.Comment_Dot_EOL := Mode;
 307       end if;
 308    end Set_Comment_Dot_EOL;
 309
 310    ---------------------------
 311    -- Set_Copyright_Pattern --
 312    ---------------------------
 313
 314    procedure Set_Copyright_Pattern
 315      (L       : in Lang_Access;
 316       Pattern : in String) is
 317    begin
 318       if L = null then
 319          for K in 1 .. Index loop
 320             Set_Copyright_Pattern (Lang_Set (K), Pattern);
 321          end loop;
 322
 323       else
 324          L.C.Copyright_Pattern := To_Unbounded_String (Pattern);
 325       end if;
 326    end Set_Copyright_Pattern;
 327
 328    ---------------------------
 329    -- Set_Copyright_Present --
 330    ---------------------------
 331
 332    procedure Set_Copyright_Present
 333      (L    : in Lang_Access;
 334       Mode : in Boolean) is
 335    begin
 336       if L = null then
 337          for K in 1 .. Index loop
 338             Set_Copyright_Present (Lang_Set (K), Mode);
 339          end loop;
 340
 341       else
 342          L.C.Copyright_Present := Mode;
 343       end if;
 344    end Set_Copyright_Present;
 345
 346    ------------------------
 347    -- Set_Copyright_Year --
 348    ------------------------
 349
 350    procedure Set_Copyright_Year
 351      (L    : in Lang_Access;
 352       Mode : in Boolean) is
 353    begin
 354       if L = null then
 355          for K in 1 .. Index loop
 356             Set_Copyright_Year (Lang_Set (K), Mode);
 357          end loop;
 358
 359       else
 360          L.C.Copyright_Year := Mode;
 361       end if;
 362    end Set_Copyright_Year;
 363
 364    ------------------------------
 365    -- Set_Duplicate_Blank_Line --
 366    ------------------------------
 367
 368    procedure Set_Duplicate_Blank_Line
 369      (L    : in Lang_Access;
 370       Mode : in Checks.Mode) is
 371    begin
 372       if L = null then
 373          for K in 1 .. Index loop
 374             Set_Duplicate_Blank_Line (Lang_Set (K), Mode);
 375          end loop;
 376
 377       else
 378          L.C.Duplicate_Blank_Line := Mode;
 379       end if;
 380    end Set_Duplicate_Blank_Line;
 381
 382    ---------------------
 383    -- Set_Header_Size --
 384    ---------------------
 385
 386    procedure Set_Header_Size
 387      (L    : in Lang_Access;
 388       Size : in Natural) is
 389    begin
 390       if L = null then
 391          for K in 1 .. Index loop
 392             Set_Header_Size (Lang_Set (K), Size);
 393          end loop;
 394
 395       else
 396          L.C.Header_Size := Size;
 397       end if;
 398    end Set_Header_Size;
 399
 400    ---------------------
 401    -- Set_Line_Ending --
 402    ---------------------
 403
 404    procedure Set_Line_Ending
 405      (L      : in Lang_Access;
 406       Ending : in Checks.Line_Ending_Style) is
 407    begin
 408       if L = null then
 409          for K in 1 .. Index loop
 410             Set_Line_Ending (Lang_Set (K), Ending);
 411          end loop;
 412
 413       else
 414          L.C.Line_Ending := Ending;
 415       end if;
 416    end Set_Line_Ending;
 417
 418    -------------------------
 419    -- Set_Line_Length_Max --
 420    -------------------------
 421
 422    procedure Set_Line_Length_Max
 423      (L      : in Lang_Access;
 424       Length : in Positive) is
 425    begin
 426       if L = null then
 427          for K in 1 .. Index loop
 428             Set_Line_Length_Max (Lang_Set (K), Length);
 429          end loop;
 430
 431       else
 432          L.C.Line_Length_Max := Length;
 433       end if;
 434    end Set_Line_Length_Max;
 435
 436    -----------------------
 437    -- Set_Space_Comment --
 438    -----------------------
 439
 440    procedure Set_Space_Comment
 441      (L      : in Lang_Access;
 442       Number : in Natural) is
 443    begin
 444       if L = null then
 445          for K in 1 .. Index loop
 446             Set_Space_Comment (Lang_Set (K), Number);
 447          end loop;
 448
 449       else
 450          L.C.Space_Comment := Number;
 451       end if;
 452    end Set_Space_Comment;
 453
 454    ----------------------
 455    -- Set_Syntax_Check --
 456    ----------------------
 457
 458    procedure Set_Syntax_Check
 459      (L    : in Lang_Access;
 460       Mode : in Boolean) is
 461    begin
 462       if L = null then
 463          for K in 1 .. Index loop
 464             Set_Syntax_Check (Lang_Set (K), Mode);
 465          end loop;
 466
 467       else
 468          L.C.Check_Syntax := Mode;
 469       end if;
 470    end Set_Syntax_Check;
 471
 472    -------------------------
 473    -- Set_Trailing_Spaces --
 474    -------------------------
 475
 476    procedure Set_Trailing_Spaces
 477      (L    : in Lang_Access;
 478       Mode : in Checks.Mode) is
 479    begin
 480       if L = null then
 481          for K in 1 .. Index loop
 482             Set_Trailing_Spaces (Lang_Set (K), Mode);
 483          end loop;
 484
 485       else
 486          L.C.Trailing_Spaces := Mode;
 487       end if;
 488    end Set_Trailing_Spaces;
 489
 490    -----------------------------
 491    -- Start_Multiline_Comment --
 492    -----------------------------
 493
 494    function Start_Multiline_Comment (L : in Lang) return String is
 495       pragma Unreferenced (L);
 496    begin
 497       return "";
 498    end Start_Multiline_Comment;
 499
 500 end Languages;