diouzhtu/src/diouzhtu-block.adb

   1 ------------------------------------------------------------------------------
   2 --                               Diouzhtu                                   --
   3 --                                                                          --
   4 --                        Copyright (C) 2007-2008                           --
   5 --                            Olivier Ramonat                               --
   6 --                                                                          --
   7 --  This library is free software; you can redistribute it and/or modify    --
   8 --  it under the terms of the GNU General Public License as published by    --
   9 --  the Free Software Foundation; either version 2 of the License, or (at   --
  10 --  your option) any later version.                                         --
  11 --                                                                          --
  12 --  This library is distributed in the hope that it will be useful, but     --
  13 --  WITHOUT ANY WARRANTY; without even the implied warranty of              --
  14 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
  15 --  General Public License for more details.                                --
  16 --                                                                          --
  17 --  You should have received a copy of the GNU General Public License       --
  18 --  along with this library; if not, write to the Free Software Foundation, --
  19 --  Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.       --
  20 ------------------------------------------------------------------------------
  21
  22 with Diouzhtu.Attribute;
  23 with GNAT.Regpat;
  24 with Ada.Strings.Unbounded;
  25
  26 package body Diouzhtu.Block is
  27
  28    use GNAT.Regpat;
  29    use Ada.Strings.Unbounded;
  30    use Diouzhtu;
  31
  32    function Blockquote
  33      (Wiki : in Wiki_Information; Index : in Positive; Block : in String)
  34       return String;
  35    --  bq. Blockquote element
  36
  37    function Header
  38      (Wiki : in Wiki_Information; Index : in Positive; Block : in String)
  39       return String;
  40    --  <h1>, <h2>, ... element
  41
  42    function List
  43      (Wiki : in Wiki_Information; Index : in Positive; Block : in String)
  44       return String;
  45    --  list element <ul>, <ol>
  46
  47    function Paragraph
  48      (Wiki : in Wiki_Information; Index : in Positive; Block : in String)
  49       return String;
  50    --  <p> element
  51
  52    function Table
  53      (Wiki : in Wiki_Information; Index : in Positive; Block : in String)
  54       return String;
  55    --  table element
  56
  57    ----------------
  58    -- Blockquote --
  59    ----------------
  60
  61    function Blockquote
  62      (Wiki : in Wiki_Information; Index : in Positive; Block : in String)
  63       return String is
  64       Extract : constant Pattern_Matcher :=
  65         Compile (Expression => "^bq" & Attribute.Get_Pattern & "\.\s(.*)$",
  66                  Flags      => Case_Insensitive + Single_Line);
  67       Count   : constant Match_Count := Paren_Count (Extract);
  68       Matches : Match_Array (0 .. Paren_Count (Extract));
  69       Result  : Unbounded_String := Null_Unbounded_String;
  70    begin
  71       Match (Extract, Block, Matches);
  72       if Matches (0) = No_Match then
  73          return Parse (Wiki    => Wiki,
  74                        Level   => Block_Level,
  75                        Content => Block,
  76                        Index   => Index);
  77       end if;
  78
  79       Result := To_Unbounded_String ("<blockquote");
  80
  81       if Matches (1) /= No_Match then
  82          Append (Result, Attribute.Extract
  83                    (Block (Matches (1).First .. Matches (1).Last)));
  84       end if;
  85
  86       if Matches (Count) /= No_Match then
  87          Append
  88            (Result, "><p>" &
  89             Parse (Wiki, Inline_Level,
  90               Block (Matches (Count).First .. Matches (Count).Last)) &
  91             "</p></blockquote>" & ASCII.LF);
  92       end if;
  93       return To_String (Result);
  94
  95    end Blockquote;
  96
  97    ------------
  98    -- Header --
  99    ------------
 100
 101    function Header
 102      (Wiki : in Wiki_Information; Index : in Positive; Block : in String)
 103       return String
 104    is
 105       Extract : constant Pattern_Matcher :=
 106         Compile (Expression => "^h(\d)" & Attribute.Get_Pattern & "\.\s(.*)$",
 107                  Flags => Case_Insensitive + Single_Line);
 108
 109       --  Get all hn.
 110       Count   : constant Match_Count := Paren_Count (Extract);
 111       Matches : Match_Array (0 .. Paren_Count (Extract));
 112       Result  : Unbounded_String := Null_Unbounded_String;
 113       Header  : Character;
 114    begin
 115       --   Search for block level
 116       Match (Extract, Block, Matches);
 117       if Matches (0) = No_Match then
 118          return Parse (Wiki    => Wiki,
 119                        Level   => Block_Level,
 120                        Content => Block,
 121                        Index   => Index);
 122       end if;
 123
 124       Header := Block (Matches (1).First);
 125
 126       Result := To_Unbounded_String
 127         ("<h" & Header);
 128
 129       if Matches (2) /= No_Match then
 130          Append (Result, Attribute.Extract
 131                    (Block (Matches (2).First .. Matches (2).Last)));
 132       end if;
 133
 134       if Matches (Count) /= No_Match then
 135          Append (Result, ">" &
 136                    Parse (Wiki, Inline_Level,
 137                           Block (Matches
 138                                    (Count).First .. Matches (Count).Last)) &
 139                    "</h" & Header & ">" & ASCII.LF);
 140       end if;
 141
 142       return To_String (Result);
 143    end Header;
 144
 145    function List
 146      (Wiki : in Wiki_Information; Index : in Positive; Block : in String)
 147       return String
 148    is
 149       type Elements is array (1 .. 2) of String (1 .. 2);
 150       type Tags is array (1 .. 2) of Character;
 151
 152       Element     : constant Elements  := Elements'(1 => "ol", 2 => "ul");
 153       Tag         : constant Tags := Tags'(1 => '#', 2 => '*');
 154       Indentation : constant String := "  ";
 155
 156       Get_Element : String (1 .. 2);
 157       Get_Tag     : Character;
 158       Result      : Unbounded_String := Null_Unbounded_String;
 159
 160       type List_Level is new Natural;
 161
 162       procedure Parse_Line
 163         (Wiki       : in Wiki_Information;
 164          Line       : in String;
 165          Level      : in out List_Level;
 166          Line_Level : in List_Level;
 167          First_Line : in Boolean := False);
 168
 169       function Get_Current_Level (Line : in String) return List_Level;
 170
 171       function Indent (Level : in List_Level) return String;
 172
 173       -----------------------
 174       -- Get_Current_Level --
 175       -----------------------
 176
 177       function Get_Current_Level (Line : in String) return List_Level is
 178          Level : List_Level := 0;
 179       begin
 180          Get_Level :
 181          for K in Line'Range loop
 182             exit Get_Level when Block (K) /= Get_Tag;
 183             Level := Level + 1;
 184          end loop Get_Level;
 185          return Level;
 186       end Get_Current_Level;
 187
 188       ------------
 189       -- Indent --
 190       ------------
 191
 192       function Indent (Level : in List_Level) return String is
 193          pragma Warnings (Off);
 194          N : Natural;
 195       begin
 196          if Level > 0 then
 197             N := 2 * (Positive (Level) - 1);
 198             return To_String (N * Indentation);
 199          end if;
 200          return "";
 201       end Indent;
 202
 203       ----------------
 204       -- Parse_Line --
 205       ----------------
 206
 207       procedure Parse_Line
 208         (Wiki       : in Wiki_Information;
 209          Line       : in String;
 210          Level      : in out List_Level;
 211          Line_Level : in List_Level;
 212          First_Line : in Boolean := False) is
 213          pragma Warnings (Off);
 214       begin
 215          if Line_Level > Level then
 216             if Line_Level > 1 then
 217                Append (Result, ASCII.LF);
 218             end if;
 219             Level := Level + 1;
 220             Append (Result, Indent (Level)
 221                       & '<' & Get_Element & '>' & ASCII.LF);
 222             Parse_Line (Wiki, Line, Level, Line_Level, First_Line => True);
 223
 224          elsif Line_Level < Level then
 225             Append (Result, ASCII.LF & Indent (Level) & Indentation
 226                     & "</li>" & ASCII.LF & Indent (Level)
 227                     & "</" & Get_Element & '>');
 228             if Level > 1 then
 229                Level := Level - 1;
 230                Parse_Line (Wiki, Line, Level, Line_Level);
 231             end if;
 232
 233          else
 234             if Line /= "" then
 235                if not First_Line then
 236                   Append (Result, ASCII.LF & Indent (Level) & Indentation
 237                           & "</li>" & ASCII.LF);
 238                end if;
 239                Append (Result, Indent (Level) & Indentation);
 240                Append_Last_Content :
 241                declare
 242                   Content_First : constant Positive :=
 243                                     Line'First + Natural (Level) + 1;
 244                   Content_Last  : Positive := Line'Last;
 245                begin
 246                   if Line (Content_Last) = ASCII.LF then
 247                      Content_Last := Content_Last - 1;
 248                   end if;
 249                   Append
 250                     (Result, "<li>" &
 251                      Parse
 252                        (Wiki, Inline_Level,
 253                         Line (Content_First .. Content_Last)));
 254                end Append_Last_Content;
 255             end if;
 256          end if;
 257       end Parse_Line;
 258
 259    begin
 260       if Block'Length < 3 then
 261          return Parse (Wiki    => Wiki,
 262                        Level   => Block_Level,
 263                        Content => Block,
 264                        Index   => Index);
 265       end if;
 266
 267       Get_Tag := Block (Block'First);
 268
 269       if Block (Block'First .. Block'First + 1) = Tag (1) & ' ' then
 270          Get_Element := Element (1);
 271       elsif Block (Block'First .. Block'First + 1) = Tag (2) & ' ' then
 272          Get_Element := Element (2);
 273       else
 274          return Parse (Wiki    => Wiki,
 275                        Level   => Block_Level,
 276                        Content => Block,
 277                        Index   => Index);
 278       end if;
 279
 280       Parse_Lines :
 281       declare
 282          Last       : Positive   := Block'First;
 283          Last_Level : List_Level := 0; -- List_Level'First
 284       begin
 285          for K in Block'Range loop
 286             if K = Block'Last
 287               or else (Block (K) = ASCII.LF and then Block (K + 1) = Get_Tag)
 288             then
 289                Parse_Current_Line :
 290                declare
 291                   Line       : constant String := Block (Last .. K);
 292                   Line_Level : constant List_Level := Get_Current_Level (Line);
 293                begin
 294                   Parse_Line (Wiki       => Wiki,
 295                               Line       => Line,
 296                               Level      => Last_Level,
 297                               Line_Level => Line_Level);
 298                   Last := K + 1;
 299                end Parse_Current_Line;
 300             end if;
 301          end loop;
 302          Parse_Line (Wiki       => Wiki,
 303                      Line       => "",
 304                      Level      => Last_Level,
 305                      Line_Level => 0);
 306       end Parse_Lines;
 307       return To_String (Result) & ASCII.LF;
 308    end List;
 309
 310    ---------------
 311    -- Paragraph --
 312    ---------------
 313
 314    function Paragraph
 315      (Wiki : in Wiki_Information; Index : in Positive; Block : in String)
 316       return String
 317    is
 318       pragma Unreferenced (Index);
 319       Extract : constant Pattern_Matcher :=
 320         Compile (Expression => "^p" & Attribute.Get_Pattern & "\.\s(.*)$",
 321                  Flags      => Case_Insensitive + Single_Line);
 322       Count   : constant Match_Count := Paren_Count (Extract);
 323       Matches : Match_Array (0 .. Paren_Count (Extract));
 324       Result  : Unbounded_String := Null_Unbounded_String;
 325    begin
 326       Match (Extract, Block, Matches);
 327       if Matches (0) = No_Match then
 328          return "<p>" & Parse (Wiki, Inline_Level, Block) & "</p>" & ASCII.LF;
 329       end if;
 330
 331       Result := To_Unbounded_String ("<p");
 332
 333       if Matches (1) /= No_Match then
 334          Append (Result, Attribute.Extract
 335                    (Block (Matches (1).First .. Matches (1).Last)));
 336       end if;
 337
 338       if Matches (Count) /= No_Match then
 339
 340          Append
 341            (Result, ">" &
 342               Parse (Wiki, Inline_Level,
 343                      Block (Matches (Count).First .. Matches (Count).Last))
 344               & "</p>" & ASCII.LF);
 345       end if;
 346       return To_String (Result);
 347    end Paragraph;
 348
 349    --------------
 350    -- Register --
 351    --------------
 352
 353    procedure Register is
 354    begin
 355       Internal_Register (Block_Level, Header'Access);
 356       Internal_Register (Block_Level, List'Access);
 357       Internal_Register (Block_Level, Blockquote'Access);
 358       Internal_Register (Block_Level, Table'Access);
 359       Internal_Register (Block_Level, Paragraph'Access);
 360    end Register;
 361
 362    -----------
 363    -- Table --
 364    -----------
 365
 366    function Table
 367      (Wiki : in Wiki_Information; Index : in Positive; Block : in String)
 368       return String
 369    is
 370
 371       Nb_Cols     : Natural          := 0;
 372       Nb_Rows     : Natural          := 0;
 373       Table_Block : String           := Block;
 374       Result      : Unbounded_String := Null_Unbounded_String;
 375
 376       procedure Get_Dimension;
 377       --  Get maximum of cols and number of rows
 378
 379       -------------------
 380       -- Get_Dimension --
 381       -------------------
 382
 383       procedure Get_Dimension is
 384          Line_Nb_Cols  : Natural := 0;
 385       begin
 386          Main_Loop :
 387          for I in Table_Block'Range loop
 388             if Table_Block (I) = ASCII.LF then
 389                if I > Table_Block'First + 1
 390                  and then Table_Block (I - 2 .. I - 1) /= " |" then
 391                   --  A table line MUST end with |
 392                   exit Main_Loop;
 393                end if;
 394                if I < Table_Block'Last - 1
 395                  and then Table_Block (I + 1 .. I + 2) /= "| " then
 396                   --  A table line MUST begin with |
 397                   exit Main_Loop;
 398                end if;
 399                if Line_Nb_Cols > Nb_Cols then
 400                   Nb_Cols := Line_Nb_Cols;
 401                end if;
 402                Nb_Rows := Nb_Rows + 1;
 403                Line_Nb_Cols := 0;
 404             end if;
 405
 406             if Table_Block (I) = '|' then
 407                if (I = Table_Block'First or else
 408                      Table_Block (I - 1) = ' ' or else
 409                        Table_Block (I - 1) = ASCII.LF) and then
 410                  (I = Table_Block'Last or else
 411                     Table_Block (I + 1) = ' ' or else
 412                       Table_Block (I + 1) = ASCII.LF)
 413                then
 414                   Line_Nb_Cols := Line_Nb_Cols + 1;
 415                else
 416                   Table_Block (I) := ' ';
 417                end if;
 418             end if;
 419          end loop Main_Loop;
 420       end Get_Dimension;
 421
 422    begin
 423       Get_Dimension;
 424
 425       if Nb_Cols = 0 or else Nb_Rows = 0 then
 426          return Parse
 427            (Wiki    => Wiki,
 428             Level   => Block_Level,
 429             Content => Table_Block,
 430             Index   => Index);
 431       end if;
 432
 433       Parse_Lines :
 434       declare
 435          Line_Cols     : Natural := 0;
 436          Last_Position : Natural := 0;
 437       begin
 438          for K in Table_Block'Range loop
 439             if Table_Block (K) = '|' then
 440                if Line_Cols > 0 and then Last_Position + 2 < K - 2 then
 441                   Append
 442                     (Result, Parse (Wiki, Inline_Level,
 443                      Table_Block (Last_Position + 2 .. K - 2)));
 444                   Append (Result, "</td>" & ASCII.LF);
 445                end if;
 446
 447                if Line_Cols < Nb_Cols - 1 then
 448                   Append (Result, "<td>");
 449                end if;
 450                Line_Cols := Line_Cols + 1;
 451                Last_Position := K;
 452             end if;
 453
 454             if Table_Block (K) = ASCII.LF or else K = Table_Block'Last then
 455                if Line_Cols < Nb_Cols then
 456                   Adds_Empty_Cols :
 457                   declare
 458                      Nb_Empty_Cols : constant Natural := Nb_Cols - Line_Cols;
 459                      Empty_Col     : constant String := "<td></td>" & ASCII.LF;
 460                   begin
 461                      Append (Result, "</td>" & ASCII.LF &
 462                              (Nb_Empty_Cols - 1) * Empty_Col);
 463                   end Adds_Empty_Cols;
 464                end if;
 465
 466                if K /= Table_Block'Last then
 467                   Append (Result, "</tr>" & ASCII.LF & "<tr>" & ASCII.LF);
 468                else
 469                   Append (Result, "</tr>" & ASCII.LF);
 470                end if;
 471                Line_Cols := 0;
 472             end if;
 473          end loop;
 474       end Parse_Lines;
 475
 476       return "<table>" & ASCII.LF & "<tr>" & ASCII.LF
 477         & To_String (Result) & "</table>" & ASCII.LF;
 478    end Table;
 479
 480 end Diouzhtu.Block;