src/languages.adb

   1 ------------------------------------------------------------------------------
   2 --                              Style Checker                               --
   3 --                                                                          --
   4 --                   Copyright (C) 2006-2010, 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_Tabulation --
 227    --------------------
 228
 229    function Get_Tabulation (L : in Lang) return Checks.Mode is
 230    begin
 231       return L.C.Tabulation;
 232    end Get_Tabulation;
 233
 234    -------------------------
 235    -- Get_Trailing_Spaces --
 236    -------------------------
 237
 238    function Get_Trailing_Spaces (L : in Lang) return Checks.Mode is
 239    begin
 240       return L.C.Trailing_Spaces;
 241    end Get_Trailing_Spaces;
 242
 243    ------------------
 244    -- Is_Extension --
 245    ------------------
 246
 247    function Is_Extension (L : in Lang; Ext : in String) return Boolean is
 248       pragma Unreferenced (L, Ext);
 249    begin
 250       return False;
 251    end Is_Extension;
 252
 253    ----------
 254    -- List --
 255    ----------
 256
 257    procedure List is
 258    begin
 259       for K in 1 .. Index loop
 260          declare
 261             L_Name : constant String := Name (Lang_Set (K).all);
 262          begin
 263             if L_Name /= "unknown" then
 264                Text_IO.Put_Line ("   " & L_Name);
 265             end if;
 266          end;
 267       end loop;
 268    end List;
 269
 270    ----------
 271    -- Name --
 272    ----------
 273
 274    function Name (L : in Lang) return String is
 275    begin
 276       return To_String (L.Name);
 277    end Name;
 278
 279    --------------
 280    -- Register --
 281    --------------
 282
 283    procedure Register (L : in Lang'Class; Name : in String) is
 284    begin
 285       Index := Index + 1;
 286       Lang_Set (Index) :=  new Lang'Class'(L);
 287       Lang_Set (Index).Name := To_Unbounded_String (Name);
 288    end Register;
 289
 290    ----------------------
 291    -- Run_Syntax_Check --
 292    ----------------------
 293
 294    function Run_Syntax_Check
 295      (L : in Lang; Filename : in String) return Boolean is
 296       pragma Unreferenced (L, Filename);
 297    begin
 298       return True;
 299    end Run_Syntax_Check;
 300
 301    -------------------------
 302    -- Set_Comment_Dot_EOL --
 303    -------------------------
 304
 305    procedure Set_Comment_Dot_EOL
 306      (L    : in Lang_Access;
 307       Mode : in Boolean) is
 308    begin
 309       if L = null then
 310          for K in 1 .. Index loop
 311             Set_Comment_Dot_EOL (Lang_Set (K), Mode);
 312          end loop;
 313
 314       else
 315          L.C.Comment_Dot_EOL := Mode;
 316       end if;
 317    end Set_Comment_Dot_EOL;
 318
 319    ---------------------------
 320    -- Set_Copyright_Pattern --
 321    ---------------------------
 322
 323    procedure Set_Copyright_Pattern
 324      (L       : in Lang_Access;
 325       Pattern : in String) is
 326    begin
 327       if L = null then
 328          for K in 1 .. Index loop
 329             Set_Copyright_Pattern (Lang_Set (K), Pattern);
 330          end loop;
 331
 332       else
 333          L.C.Copyright_Pattern := To_Unbounded_String (Pattern);
 334       end if;
 335    end Set_Copyright_Pattern;
 336
 337    ---------------------------
 338    -- Set_Copyright_Present --
 339    ---------------------------
 340
 341    procedure Set_Copyright_Present
 342      (L    : in Lang_Access;
 343       Mode : in Boolean) is
 344    begin
 345       if L = null then
 346          for K in 1 .. Index loop
 347             Set_Copyright_Present (Lang_Set (K), Mode);
 348          end loop;
 349
 350       else
 351          L.C.Copyright_Present := Mode;
 352       end if;
 353    end Set_Copyright_Present;
 354
 355    ------------------------
 356    -- Set_Copyright_Year --
 357    ------------------------
 358
 359    procedure Set_Copyright_Year
 360      (L    : in Lang_Access;
 361       Mode : in Boolean) is
 362    begin
 363       if L = null then
 364          for K in 1 .. Index loop
 365             Set_Copyright_Year (Lang_Set (K), Mode);
 366          end loop;
 367
 368       else
 369          L.C.Copyright_Year := Mode;
 370       end if;
 371    end Set_Copyright_Year;
 372
 373    ------------------------------
 374    -- Set_Duplicate_Blank_Line --
 375    ------------------------------
 376
 377    procedure Set_Duplicate_Blank_Line
 378      (L    : in Lang_Access;
 379       Mode : in Checks.Mode) is
 380    begin
 381       if L = null then
 382          for K in 1 .. Index loop
 383             Set_Duplicate_Blank_Line (Lang_Set (K), Mode);
 384          end loop;
 385
 386       else
 387          L.C.Duplicate_Blank_Line := Mode;
 388       end if;
 389    end Set_Duplicate_Blank_Line;
 390
 391    ---------------------
 392    -- Set_Header_Size --
 393    ---------------------
 394
 395    procedure Set_Header_Size
 396      (L    : in Lang_Access;
 397       Size : in Natural) is
 398    begin
 399       if L = null then
 400          for K in 1 .. Index loop
 401             Set_Header_Size (Lang_Set (K), Size);
 402          end loop;
 403
 404       else
 405          L.C.Header_Size := Size;
 406       end if;
 407    end Set_Header_Size;
 408
 409    ---------------------
 410    -- Set_Line_Ending --
 411    ---------------------
 412
 413    procedure Set_Line_Ending
 414      (L      : in Lang_Access;
 415       Ending : in Checks.Line_Ending_Style) is
 416    begin
 417       if L = null then
 418          for K in 1 .. Index loop
 419             Set_Line_Ending (Lang_Set (K), Ending);
 420          end loop;
 421
 422       else
 423          L.C.Line_Ending := Ending;
 424       end if;
 425    end Set_Line_Ending;
 426
 427    -------------------------
 428    -- Set_Line_Length_Max --
 429    -------------------------
 430
 431    procedure Set_Line_Length_Max
 432      (L      : in Lang_Access;
 433       Length : in Positive) is
 434    begin
 435       if L = null then
 436          for K in 1 .. Index loop
 437             Set_Line_Length_Max (Lang_Set (K), Length);
 438          end loop;
 439
 440       else
 441          L.C.Line_Length_Max := Length;
 442       end if;
 443    end Set_Line_Length_Max;
 444
 445    -----------------------
 446    -- Set_Space_Comment --
 447    -----------------------
 448
 449    procedure Set_Space_Comment
 450      (L      : in Lang_Access;
 451       Number : in Natural) is
 452    begin
 453       if L = null then
 454          for K in 1 .. Index loop
 455             Set_Space_Comment (Lang_Set (K), Number);
 456          end loop;
 457
 458       else
 459          L.C.Space_Comment := Number;
 460       end if;
 461    end Set_Space_Comment;
 462
 463    ----------------------
 464    -- Set_Syntax_Check --
 465    ----------------------
 466
 467    procedure Set_Syntax_Check
 468      (L    : in Lang_Access;
 469       Mode : in Boolean) is
 470    begin
 471       if L = null then
 472          for K in 1 .. Index loop
 473             Set_Syntax_Check (Lang_Set (K), Mode);
 474          end loop;
 475
 476       else
 477          L.C.Check_Syntax := Mode;
 478       end if;
 479    end Set_Syntax_Check;
 480
 481    --------------------
 482    -- Set_Tabulation --
 483    --------------------
 484
 485    procedure Set_Tabulation
 486      (L    : in Lang_Access;
 487       Mode : in Checks.Mode) is
 488    begin
 489       if L = null then
 490          for K in 1 .. Index loop
 491             Set_Tabulation (Lang_Set (K), Mode);
 492          end loop;
 493
 494       else
 495          L.C.Tabulation := Mode;
 496       end if;
 497    end Set_Tabulation;
 498
 499    -------------------------
 500    -- Set_Trailing_Spaces --
 501    -------------------------
 502
 503    procedure Set_Trailing_Spaces
 504      (L    : in Lang_Access;
 505       Mode : in Checks.Mode) is
 506    begin
 507       if L = null then
 508          for K in 1 .. Index loop
 509             Set_Trailing_Spaces (Lang_Set (K), Mode);
 510          end loop;
 511
 512       else
 513          L.C.Trailing_Spaces := Mode;
 514       end if;
 515    end Set_Trailing_Spaces;
 516
 517    -----------------------------
 518    -- Start_Multiline_Comment --
 519    -----------------------------
 520
 521    function Start_Multiline_Comment (L : in Lang) return String is
 522       pragma Unreferenced (L);
 523    begin
 524       return "";
 525    end Start_Multiline_Comment;
 526
 527 end Languages;