lithium3

Check-in [2f20876918]
Login

Check-in [2f20876918]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:lithium-spoiler_filters: new filter to rot13-scramble spoiler spans
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 2f20876918b439fa6a22a70753e9f32f6b9f59e3
User & Date: nat 2019-03-04 19:59:02.729
Context
2019-03-30
22:38
lithium-dispatchers: add a user database backend check-in: c899867743 user: nat tags: trunk
2019-03-04
19:59
lithium-spoiler_filters: new filter to rot13-scramble spoiler spans check-in: 2f20876918 user: nat tags: trunk
2019-03-03
19:37
lithium-markdown: add a "spoiler" span element, marked by double '%' check-in: 00a97167e5 user: nat tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to src/lithium-dispatchers.adb. 
1
2
3
4
5
6
7
8
9

------------------------------------------------------------------------------
-- Copyright (c) 2015-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --


|








1
2
3
4
5
6
7
8
9

------------------------------------------------------------------------------
-- Copyright (c) 2015-2019, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
︙︙
29
30
31
32
33
34
35

36
37
38
39
40
41
42

with Natools.Web.Tag_Pages;

with Lithium.Access_Log;
with Lithium.Comment_Cookie_Smaz;
with Lithium.Exception_Log;
with Lithium.Legacy_Filters;
with Lithium.Markdown.Filters;


package body Lithium.Dispatchers is

   overriding function Clone (Object : Handler) return Handler is
   begin
      return Object;
   end Clone;








>








29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

with Natools.Web.Tag_Pages;

with Lithium.Access_Log;
with Lithium.Comment_Cookie_Smaz;
with Lithium.Exception_Log;
with Lithium.Legacy_Filters;
with Lithium.Markdown.Filters;
with Lithium.Spoiler_Filters;

package body Lithium.Dispatchers is

   overriding function Clone (Object : Handler) return Handler is
   begin
      return Object;
   end Clone;
︙︙
100
101
102
103
104
105
106


107
108
109
110
111
112
113

        ("html-escape", Natools.Web.Escapes.Filters.Create'Access);
      Holder.Register
        ("legacy-comment", Lithium.Legacy_Filters.Create'Access);
      Holder.Register
        ("pass-through", Natools.Web.Filters.Pass_Through.Create'Access);
      Holder.Register
        ("replace-text", Natools.Web.Filters.Text_Replacement.Create'Access);


      Holder.Register
        ("text-block", Natools.Web.Filters.Text_Blocks.Create'Access);

      Holder.Register
        (Comment_Cookie_Smaz.Key, Comment_Cookie_Smaz.Decoder'Access);
      Holder.Set_Cookie_Encoder
        (Comment_Cookie_Smaz.Encoder'Access,








>
>








101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116

        ("html-escape", Natools.Web.Escapes.Filters.Create'Access);
      Holder.Register
        ("legacy-comment", Lithium.Legacy_Filters.Create'Access);
      Holder.Register
        ("pass-through", Natools.Web.Filters.Pass_Through.Create'Access);
      Holder.Register
        ("replace-text", Natools.Web.Filters.Text_Replacement.Create'Access);
      Holder.Register
        ("spoiler-filter", Lithium.Spoiler_Filters.Create'Access);
      Holder.Register
        ("text-block", Natools.Web.Filters.Text_Blocks.Create'Access);

      Holder.Register
        (Comment_Cookie_Smaz.Key, Comment_Cookie_Smaz.Decoder'Access);
      Holder.Set_Cookie_Encoder
        (Comment_Cookie_Smaz.Encoder'Access,
︙︙
Changes to src/lithium-markdown.adb. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21


22
23
24
25
26
27
28

------------------------------------------------------------------------------
-- Copyright (c) 2015-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Exceptions;
with Ada.Text_IO;
with Markup.Parsers.Markdown.Extensions;
with Markup.Renderers.Html;
with Natools.S_Expressions.Atom_Buffers;



package body Lithium.Markdown is

   package Sx renames Natools.S_Expressions;

   type Buffer_Access is access Sx.Atom_Buffers.Atom_Buffer;



|



















>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

------------------------------------------------------------------------------
-- Copyright (c) 2015-2019, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Exceptions;
with Ada.Text_IO;
with Markup.Parsers.Markdown.Extensions;
with Markup.Renderers.Html;
with Natools.S_Expressions.Atom_Buffers;

with Lithium.Spoiler_Filters;

package body Lithium.Markdown is

   package Sx renames Natools.S_Expressions;

   type Buffer_Access is access Sx.Atom_Buffers.Atom_Buffer;
︙︙
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89

   begin
      Element.Buffer.Append (Sx.To_Atom (Text));
   end Append;


   overriding procedure Close (Element : in out Spoiler_Span) is
   begin
      Element.Buffer.Append (Sx.To_Atom ("</span>"));
   end Close;


   function Export (Buffer : Sx.Atom_Buffers.Atom_Buffer)
     return Sx.Atom_Refs.Immutable_Reference
   is
      use type Sx.Offset;








|








77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

   begin
      Element.Buffer.Append (Sx.To_Atom (Text));
   end Append;


   overriding procedure Close (Element : in out Spoiler_Span) is
   begin
      Element.Buffer.Append (Spoiler_Filters.End_HTML);
   end Close;


   function Export (Buffer : Sx.Atom_Buffers.Atom_Buffer)
     return Sx.Atom_Refs.Immutable_Reference
   is
      use type Sx.Offset;
︙︙
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117

   begin
      Element.Destination.Soft_Reset;
      Element.Destination.Append (Element.Source.Data);
   end Open;

   overriding procedure Open (Element : in out Spoiler_Span) is
   begin
      Element.Buffer.Append (Sx.To_Atom ("<span class=""spoiler"">"));
   end Open;



   -----------------
   -- Worker Tasks --
   -----------------








|








105
106
107
108
109
110
111
112
113
114
115
116
117
118
119

   begin
      Element.Destination.Soft_Reset;
      Element.Destination.Append (Element.Source.Data);
   end Open;

   overriding procedure Open (Element : in out Spoiler_Span) is
   begin
      Element.Buffer.Append (Spoiler_Filters.Begin_HTML);
   end Open;



   -----------------
   -- Worker Tasks --
   -----------------
︙︙
Added src/lithium-spoiler_filters.adb. 








































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

------------------------------------------------------------------------------
-- Copyright (c) 2017-2019, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Lithium.Spoiler_Filters is
   use type Ada.Streams.Stream_Element;

   function Next
     (Data : in Ada.Streams.Stream_Element_Array;
      Start : in Ada.Streams.Stream_Element_Offset;
      Pattern : Ada.Streams.Stream_Element_Array)
     return Ada.Streams.Stream_Element_Offset;

   function Rot_13 (Source : Ada.Streams.Stream_Element_Array)
     return Ada.Streams.Stream_Element_Array;

   function Rot_13 (Source : Ada.Streams.Stream_Element)
     return Ada.Streams.Stream_Element
     is (case Source is
         when Character'Pos ('A') .. Character'Pos ('M')
            | Character'Pos ('a') .. Character'Pos ('m')
            => Source + 13,
         when Character'Pos ('N') .. Character'Pos ('Z')
            | Character'Pos ('n') .. Character'Pos ('z')
            => Source - 13,
         when others => Source);


   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   function Next
     (Data : in Ada.Streams.Stream_Element_Array;
      Start : in Ada.Streams.Stream_Element_Offset;
      Pattern : Ada.Streams.Stream_Element_Array)
     return Ada.Streams.Stream_Element_Offset
   is
      use type Ada.Streams.Stream_Element_Array;
      use type Ada.Streams.Stream_Element_Offset;
      Index : Ada.Streams.Stream_Element_Offset := Start;
   begin
      while Index + Pattern'Length - 1 in Data'Range loop
         if Data (Index .. Index + Pattern'Length - 1) = Pattern then
            return Index;
         end if;

         Index := Index + 1;
      end loop;

      return Start - 1;
   end Next;


   function Rot_13 (Source : Ada.Streams.Stream_Element_Array)
     return Ada.Streams.Stream_Element_Array is
   begin
      return Result : Ada.Streams.Stream_Element_Array
                        (Source'First .. Source'Last)
      do
         for I in Result'Range loop
            Result (I) := Rot_13 (Source (I));
         end loop;
      end return;
   end Rot_13;



   ----------------------
   -- Public Interface --
   ----------------------

   overriding procedure Apply
     (Object : in Spoiler_Filter;
      Output : in out Ada.Streams.Root_Stream_Type'Class;
      Data : in Ada.Streams.Stream_Element_Array)
   is
      pragma Unreferenced (Object);
      use type Ada.Streams.Stream_Element_Array;
      use type Ada.Streams.Stream_Element_Offset;

      Index : Ada.Streams.Stream_Element_Offset := Data'First;
      First, Last : Ada.Streams.Stream_Element_Offset;
   begin
      while Index in Data'Range loop
         First := Next (Data, Index, Begin_HTML);
         exit when First < Index;

         Last := Next (Data, First + Begin_HTML'Length, End_HTML);
         exit when Last < First;

         if First > Index then
            Output.Write (Data (Index .. First - 1));
         end if;

         Output.Write
           (Begin_Filtered
              & Rot_13 (Data (First + Begin_HTML'Length .. Last - 1))
              & End_Filtered);

         Index := Last + End_HTML'Length;
      end loop;

      if Index in Data'Range then
         Output.Write (Data (Index .. Data'Last));
      end if;
   end Apply;


   function Create
     (Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class)
     return Natools.Web.Filters.Filter'Class
   is
      pragma Unreferenced (Arguments);
   begin
      return Spoiler_Filter'(null record);
   end Create;

end Lithium.Spoiler_Filters;
Added src/lithium-spoiler_filters.ads. 




























































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93

------------------------------------------------------------------------------
-- Copyright (c) 2017-2019, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Lithium.Spoiler_Filters provides a filter to encode spoilers in rot13,   --
-- for situations where CSS might not apply (e.g. ATOM feeds).              --
------------------------------------------------------------------------------

with Ada.Streams;
with Natools.S_Expressions.Lockable;
with Natools.Web.Filters;

package Lithium.Spoiler_Filters is
   pragma Preelaborate;

   type Spoiler_Filter is new Natools.Web.Filters.Filter with private;

   overriding procedure Apply
     (Object : in Spoiler_Filter;
      Output : in out Ada.Streams.Root_Stream_Type'Class;
      Data : in Ada.Streams.Stream_Element_Array);

   function Create
     (Arguments : in out Natools.S_Expressions.Lockable.Descriptor'Class)
     return Natools.Web.Filters.Filter'Class;


   Begin_HTML : constant Natools.S_Expressions.Atom
     := (1 => Character'Pos ('<'),
         2 => Character'Pos ('s'),
         3 => Character'Pos ('p'),
         4 => Character'Pos ('a'),
         5 => Character'Pos ('n'),
         6 => Character'Pos (' '),
         7 => Character'Pos ('c'),
         8 => Character'Pos ('l'),
         9 => Character'Pos ('a'),
        10 => Character'Pos ('s'),
        11 => Character'Pos ('s'),
        12 => Character'Pos ('='),
        13 => Character'Pos ('"'),
        14 => Character'Pos ('s'),
        15 => Character'Pos ('p'),
        16 => Character'Pos ('o'),
        17 => Character'Pos ('i'),
        18 => Character'Pos ('l'),
        19 => Character'Pos ('e'),
        20 => Character'Pos ('r'),
        21 => Character'Pos ('"'),
        22 => Character'Pos ('>'));

   End_HTML : constant Natools.S_Expressions.Atom
     := (1 => Character'Pos ('<'),
         2 => Character'Pos ('/'),
         3 => Character'Pos ('s'),
         4 => Character'Pos ('p'),
         5 => Character'Pos ('a'),
         6 => Character'Pos ('n'),
         7 => Character'Pos ('>'));

   Begin_Filtered : constant Natools.S_Expressions.Atom
     := (1 => Character'Pos ('['),
         2 => Character'Pos ('S'),
         3 => Character'Pos ('P'),
         4 => Character'Pos ('O'),
         5 => Character'Pos ('I'),
         6 => Character'Pos ('L'),
         7 => Character'Pos ('E'),
         8 => Character'Pos ('R'),
         9 => Character'Pos (']'),
        10 => Character'Pos ('['));

   End_Filtered : constant Natools.S_Expressions.Atom
     := (1 => Character'Pos (']'));

private

   type Spoiler_Filter is new Natools.Web.Filters.Filter with null record;

end Lithium.Spoiler_Filters;