← Back to branch summary

~kosova/+junk/tuxfamily-twiki

« back to all changes in this revision

Viewing changes to foswiki/lib/Foswiki/Plugins/WysiwygPlugin/TML2HTML.pm

  • Committer: James Michael DuPont
  • Date: 2009-07-18 19:58:49 UTC
  • Revision ID: jamesmikedupont@gmail.com-20090718195849-vgbmaht2ys791uo2
added foswiki

Show diffs side-by-side

added added

removed removed

Lines of Context:
foswiki/lib/Foswiki/Plugins/WysiwygPlugin/TML2HTML.pm
 
1
# Copyright (C) 2005 ILOG http://www.ilog.fr
 
2
# and Foswiki Contributors. All Rights Reserved. Foswiki Contributors
 
3
# are listed in the AUTHORS file in the root of this distribution.
 
4
# NOTE: Please extend that file, not this notice.
 
5
#
 
6
# This program is free software; you can redistribute it and/or
 
7
# modify it under the terms of the GNU General Public License
 
8
# as published by the Free Software Foundation; either version 2
 
9
# of the License, or (at your option) any later version. For
 
10
# more details read LICENSE in the root of this distribution.
 
11
#
 
12
# This program is distributed in the hope that it will be useful,
 
13
# but WITHOUT ANY WARRANTY; without even the implied warranty of
 
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
15
#
 
16
# As per the GPL, removal of this notice is prohibited.
 
17
 
 
18
=pod
 
19
 
 
20
---+ package Foswiki::Plugins::WysiwygPlugin::TML2HTML
 
21
 
 
22
Convertor class for translating TML (Topic Meta Language) into
 
23
HTML
 
24
 
 
25
The convertor does _not_ use the Foswiki rendering, as that is a
 
26
lossy conversion, and would make symmetric translation back to TML
 
27
an impossibility.
 
28
 
 
29
The design goal was to support round-trip conversion from well-formed
 
30
TML to XHTML1.0 and back to identical TML. Notes that some deprecated
 
31
TML syntax is not supported.
 
32
 
 
33
=cut
 
34
 
 
35
package Foswiki::Plugins::WysiwygPlugin::TML2HTML;
 
36
 
 
37
use CGI qw( -any );
 
38
 
 
39
use Foswiki;
 
40
use Foswiki::Plugins::WysiwygPlugin::Constants;
 
41
 
 
42
use strict;
 
43
 
 
44
my $TT0 = chr(0);
 
45
my $TT1 = chr(1);
 
46
my $TT2 = chr(2);
 
47
 
 
48
# HTML elements that are palatable to editors. Other HTML tags will be
 
49
# rendered in 'protected' regions to prevent the WYSIWYG editor mussing
 
50
# them up. Note that A is specifically excluded from this list because it
 
51
# is common for href attributes to contain macros. Users should
 
52
# be encouraged to use square bracket formulations for links instead.
 
53
my @PALATABLE_TAGS = qw(
 
54
  ABBR ACRONYM ADDRESS B BDO BIG BLOCKQUOTE BR CAPTION CENTER CITE CODE COL
 
55
  COLGROUP DD DEL DFN DIR DIV DL DT EM FONT H1 H2 H3 H4 H5 H6 HR HTML I IMG INS
 
56
  ISINDEX KBD LABEL LEGEND LI OL P PRE Q S SAMP SMALL SPAN STRONG SUB SUP TABLE
 
57
  TBODY TD TFOOT TH THEAD TITLE TR TT U UL STICKY
 
58
);
 
59
 
 
60
my $PALATABLE_HTML = '(' . join( '|', @PALATABLE_TAGS ) . ')';
 
61
 
 
62
=pod
 
63
 
 
64
---++ ClassMethod new()
 
65
 
 
66
Construct a new TML to HTML convertor.
 
67
 
 
68
=cut
 
69
 
 
70
sub new {
 
71
    my $class = shift;
 
72
    my $this  = {};
 
73
    return bless( $this, $class );
 
74
}
 
75
 
 
76
=pod
 
77
 
 
78
---++ ObjectMethod convert( $tml, \%options ) -> $tml
 
79
 
 
80
Convert a block of TML text into HTML.
 
81
Options:
 
82
   * getViewUrl is a reference to a method:<br>
 
83
     getViewUrl($web,$topic) -> $url (where $topic may include an anchor)
 
84
   * markVars is true if we are to expand macros to spans.
 
85
     It should be false otherwise (macros will be left as text).
 
86
 
 
87
=cut
 
88
 
 
89
sub convert {
 
90
    my ( $this, $content, $options ) = @_;
 
91
 
 
92
    $this->{opts} = $options;
 
93
 
 
94
    return '' unless $content;
 
95
 
 
96
    $content =~ s/[$TT0$TT1$TT2]/?/go;
 
97
 
 
98
    # Render TML constructs to tagged HTML
 
99
    $content = $this->_getRenderedVersion($content);
 
100
 
 
101
    # Substitute back in protected elements
 
102
    $content = $this->_dropBack($content);
 
103
 
 
104
    # DEBUG
 
105
    #print STDERR "TML2HTML = '$content'\n";
 
106
 
 
107
    # This should really use a template, but what the heck...
 
108
    return $content;
 
109
}
 
110
 
 
111
sub _liftOut {
 
112
    my ( $this, $text, $type, $encoding ) = @_;
 
113
    $text = $this->_unLift($text);
 
114
    my $n = scalar( @{ $this->{refs} } );
 
115
    push(
 
116
        @{ $this->{refs} },
 
117
        {
 
118
            type     => $type,
 
119
            encoding => $encoding || 'span',
 
120
            text     => $text
 
121
        }
 
122
    );
 
123
    return $TT1 . $n . $TT2;
 
124
}
 
125
 
 
126
sub _unLift {
 
127
    my ( $this, $text ) = @_;
 
128
 
 
129
    # Restore everything that was lifted out
 
130
    while ( $text =~ s#$TT1([0-9]+)$TT2#$this->{refs}->[$1]->{text}#g ) {
 
131
    }
 
132
    return $text;
 
133
}
 
134
 
 
135
sub _dropBack {
 
136
    my ( $this, $text ) = @_;
 
137
 
 
138
    # Restore everything that was lifted out
 
139
    while ( $text =~ s#$TT1([0-9]+)$TT2#$this->_dropIn($1)#ge ) {
 
140
    }
 
141
    return $text;
 
142
}
 
143
 
 
144
sub _dropIn {
 
145
    my ( $this, $n ) = @_;
 
146
    my $thing = $this->{refs}->[$n];
 
147
    return $thing->{text} if $thing->{encoding} eq 'NONE';
 
148
    my $method = 'CGI::' . $thing->{encoding};
 
149
    my $text   = $thing->{text};
 
150
    $text = _protectVerbatimChars($text)
 
151
      if $thing->{type} =~ /^(PROTECTED|STICKY|VERBATIM)$/;
 
152
    no strict 'refs';
 
153
    return &$method( { class => 'WYSIWYG_' . $thing->{type} }, $text );
 
154
    use strict 'refs';
 
155
}
 
156
 
 
157
# Parse and convert macros. If we are not using span markers
 
158
# for macros, we have to change the percent signs into entities
 
159
# to prevent internal tags being expanded by Foswiki during rendering.
 
160
# It's assumed that the editor will have the common sense to convert
 
161
# them back to characters when editing.
 
162
sub _processTags {
 
163
    my ( $this, $text ) = @_;
 
164
 
 
165
    return '' unless defined($text);
 
166
 
 
167
    my @queue = split( /(\n?%)/s, $text );
 
168
    my @stack;
 
169
    my $stackTop = '';
 
170
 
 
171
    while ( scalar(@queue) ) {
 
172
        my $token = shift(@queue);
 
173
        if ( $token =~ /^\n?%$/s ) {
 
174
            if ( $token eq '%' && $stackTop =~ /}$/ ) {
 
175
                while ( scalar(@stack)
 
176
                    && $stackTop !~ /^\n?%([A-Z0-9_:]+){.*}$/os )
 
177
                {
 
178
                    $stackTop = pop(@stack) . $stackTop;
 
179
                }
 
180
            }
 
181
            if (   $token eq '%'
 
182
                && $stackTop =~ m/^(\n?)%([A-Z0-9_:]+)({.*})?$/os )
 
183
            {
 
184
                my $nl = $1;
 
185
                my $tag = $2 . ( $3 || '' );
 
186
                $tag = "$nl%$tag%";
 
187
 
 
188
              # The commented out lines disable PROTECTED for %SIMPLE% vars. See
 
189
              # Bugs: Item4828 for the sort of problem this would help to avert.
 
190
              #                if ($tag =~ /^\n?%\w+{.*}%/) {
 
191
                $stackTop =
 
192
                  pop(@stack) . $nl . $this->_liftOut( $tag, 'PROTECTED' );
 
193
 
 
194
                #                } else {
 
195
                #                    $stackTop = pop( @stack ).$tag;
 
196
                #                }
 
197
            }
 
198
            else {
 
199
                push( @stack, $stackTop );
 
200
                $stackTop = $token;    # push a new context
 
201
            }
 
202
        }
 
203
        else {
 
204
            $stackTop .= $token;
 
205
        }
 
206
    }
 
207
 
 
208
    # Run out of input. Gather up everything in the stack.
 
209
    while ( scalar(@stack) ) {
 
210
        $stackTop = pop(@stack) . $stackTop;
 
211
    }
 
212
 
 
213
    return $stackTop;
 
214
}
 
215
 
 
216
sub _expandURL {
 
217
    my ( $this, $url ) = @_;
 
218
 
 
219
    return $url unless ( $this->{opts}->{expandVarsInURL} );
 
220
    return $this->{opts}->{expandVarsInURL}->( $url, $this->{opts} );
 
221
}
 
222
 
 
223
# Lifted straight out of DevelopBranch Render.pm
 
224
sub _getRenderedVersion {
 
225
    my ( $this, $text, $refs ) = @_;
 
226
 
 
227
    return '' unless $text;    # nothing to do
 
228
 
 
229
    @{ $this->{LIST} } = ();
 
230
    $this->{refs} = [];
 
231
 
 
232
    # Initial cleanup
 
233
    $text =~ s/\r//g;
 
234
    $text =~ s/^\n*//s;
 
235
    $text =~ s/\n*$//s;
 
236
 
 
237
    $this->{removed} = {};     # Map of placeholders to tag parameters and text
 
238
 
 
239
    # Do sticky first; it can't be ignored
 
240
    $text = $this->_takeOutBlocks( $text, 'sticky' );
 
241
 
 
242
    $text = $this->_takeOutBlocks( $text, 'verbatim' );
 
243
 
 
244
    $text = $this->_takeOutBlocks( $text, 'literal' );
 
245
 
 
246
    $text = $this->_takeOutSets($text);
 
247
 
 
248
    $text =~ s/\\\n/ /g;
 
249
    $text =~ s/\t/   /g;
 
250
 
 
251
    # Remove PRE to prevent TML interpretation of text inside it
 
252
    $text = $this->_takeOutBlocks( $text, 'pre' );
 
253
 
 
254
    # Protect comments
 
255
    $text =~ s/(<!--.*?-->)/$this->_liftOut($1, 'PROTECTED')/ges;
 
256
 
 
257
    # Handle inline IMG tags specially
 
258
    $text =~ s/(<img [^>]*>)/$this->_takeOutIMGTag($1)/gei;
 
259
    $text =~ s/<\/img>//gi;
 
260
 
 
261
    # Handle colour tags specially (hack, hack, hackity-HACK!)
 
262
    my $colourMatch = join( '|', grep( /^[A-Z]/, keys %WC::KNOWN_COLOUR ) );
 
263
    while ( $text =~
 
264
        s#%($colourMatch)%(.*?)%ENDCOLOR%#<font color="\L$1\E">$2</font>#og )
 
265
    {
 
266
    }
 
267
 
 
268
    # Convert Foswiki tags to spans outside protected text
 
269
    $text = $this->_processTags($text);
 
270
 
 
271
    # protect some HTML tags.
 
272
    $text =~ s/(<\/?(?!(?i:$PALATABLE_HTML)\b)[A-Z]+(\s[^>]*)?>)/
 
273
      $this->_liftOut($1, 'PROTECTED')/gei;
 
274
 
 
275
    $text =~ s/\\\n//gs;    # Join lines ending in '\'
 
276
 
 
277
    # Blockquoted email (indented with '> ')
 
278
    # Could be used to provide different colours for different numbers of '>'
 
279
    $text =~
 
280
      s/^>(.*?)$/'&gt;'.CGI::cite( { class => 'TMLcite' }, $1 ).CGI::br()/gem;
 
281
 
 
282
    # locate isolated < and > and translate to entities
 
283
    # Protect isolated <!-- and -->
 
284
    $text =~ s/<!--/{$TT0!--/g;
 
285
    $text =~ s/-->/--}$TT0/g;
 
286
 
 
287
    # SMELL: this next fragment is a frightful hack, to handle the
 
288
    # case where simple HTML tags (i.e. without values) are embedded
 
289
    # in the values provided to other tags. The only way to do this
 
290
    # correctly (i.e. handle HTML tags with values as well) is to
 
291
    # parse the HTML (bleagh!)
 
292
    $text =~ s/<(\/[A-Za-z]+)>/{$TT0$1}$TT0/g;
 
293
    $text =~ s/<([A-Za-z]+(\s+\/)?)>/{$TT0$1}$TT0/g;
 
294
    $text =~ s/<(\S.*?)>/{$TT0$1}$TT0/g;
 
295
 
 
296
    # entitify lone < and >, praying that we haven't screwed up :-(
 
297
    $text =~ s/</&lt\;/g;
 
298
    $text =~ s/>/&gt\;/g;
 
299
    $text =~ s/{$TT0/</go;
 
300
    $text =~ s/}$TT0/>/go;
 
301
 
 
302
    # standard URI
 
303
    $text =~
 
304
s/((^|(?<=[-*\s(]))$Foswiki::regex{linkProtocolPattern}:[^\s<>"]+[^\s*.,!?;:)<])/$this->_liftOut($1, 'LINK')/geo;
 
305
 
 
306
    # other entities
 
307
    $text =~ s/&([$Foswiki::regex{mixedAlphaNum}]+;)/$TT0$1/g;    # "&abc;"
 
308
    $text =~ s/&(#[0-9]+;)/$TT0$1/g;                              # "&#123;"
 
309
         #$text =~ s/&/&amp;/g;             # escape standalone "&"
 
310
    $text =~ s/$TT0(#[0-9]+;)/&$1/go;
 
311
    $text =~ s/$TT0([$Foswiki::regex{mixedAlphaNum}]+;)/&$1/go;
 
312
 
 
313
    # Horizontal rule
 
314
    my $hr = CGI::hr( { class => 'TMLhr' } );
 
315
    $text =~ s/^---+$/$hr/gm;
 
316
 
 
317
    # Now we really _do_ need a line loop, to process TML
 
318
    # line-oriented stuff.
 
319
    my $inList      = 0;         # True when within a list type
 
320
    my $inTable     = 0;         # True when within a table type
 
321
    my $inParagraph = 1;         # True when within a P
 
322
    my @result      = ('<p>');
 
323
 
 
324
    foreach my $line ( split( /\n/, $text ) ) {
 
325
 
 
326
        # Table: | cell | cell |
 
327
        # allow trailing white space after the last |
 
328
        if ( $line =~ m/^(\s*\|.*\|\s*)$/ ) {
 
329
            push( @result, '</p>' ) if $inParagraph;
 
330
            $inParagraph = 0;
 
331
            $this->_addListItem( \@result, '', '', '' ) if $inList;
 
332
            $inList = 0;
 
333
            unless ($inTable) {
 
334
                push(
 
335
                    @result,
 
336
                    CGI::start_table(
 
337
                        { border => 1, cellpadding => 0, cellspacing => 1 }
 
338
                    )
 
339
                );
 
340
            }
 
341
            push( @result, _emitTR($1) );
 
342
            $inTable = 1;
 
343
            next;
 
344
        }
 
345
 
 
346
        if ($inTable) {
 
347
            push( @result, CGI::end_table() );
 
348
            $inTable = 0;
 
349
        }
 
350
 
 
351
        if ( $line =~ /$Foswiki::regex{headerPatternDa}/o ) {
 
352
 
 
353
            # Running head
 
354
            $this->_addListItem( \@result, '', '', '' ) if $inList;
 
355
            $inList = 0;
 
356
            push( @result, '</p>' ) if $inParagraph;
 
357
            $inParagraph = 0;
 
358
            my ( $indicator, $heading ) = ( $1, $2 );
 
359
            my $class = 'TML';
 
360
            if ( $heading =~ s/$Foswiki::regex{headerPatternNoTOC}//o ) {
 
361
                $class .= ' notoc';
 
362
            }
 
363
            if ( $indicator =~ /#/ ) {
 
364
                $class .= ' numbered';
 
365
            }
 
366
            my $attrs = { class => $class };
 
367
            my $fn = 'CGI::h' . length($indicator);
 
368
            no strict 'refs';
 
369
            $line = &$fn( $attrs, " $heading " );
 
370
            use strict 'refs';
 
371
 
 
372
        }
 
373
        elsif ( $line =~ /^\s*$/ ) {
 
374
 
 
375
            # Blank line
 
376
            push( @result, '</p>' ) if $inParagraph;
 
377
            $inParagraph = 0;
 
378
            $line        = '<p>';
 
379
            $this->_addListItem( \@result, '', '', '' ) if $inList;
 
380
            $inList      = 0;
 
381
            $inParagraph = 1;
 
382
 
 
383
        }
 
384
        elsif ( $line =~
 
385
            s/^((\t|   )+)\$\s(([^:]+|:[^\s]+)+?):\s/<dt> $3 <\/dt><dd> /o )
 
386
        {
 
387
 
 
388
            # Definition list
 
389
            push( @result, '</p>' ) if $inParagraph;
 
390
            $inParagraph = 0;
 
391
            $this->_addListItem( \@result, 'dl', 'dd', $1, '' );
 
392
            $inList = 1;
 
393
 
 
394
        }
 
395
        elsif ( $line =~ s/^((\t|   )+)(\S+?):\s/<dt> $3<\/dt><dd> /o ) {
 
396
 
 
397
            # Definition list
 
398
            push( @result, '</p>' ) if $inParagraph;
 
399
            $inParagraph = 0;
 
400
            $this->_addListItem( \@result, 'dl', 'dd', $1, '' );
 
401
            $inList = 1;
 
402
 
 
403
        }
 
404
        elsif ( $line =~ s/^((\t|   )+)\*(\s|$)/<li> /o ) {
 
405
 
 
406
            # Unnumbered list
 
407
            push( @result, '</p>' ) if $inParagraph;
 
408
            $inParagraph = 0;
 
409
            $this->_addListItem( \@result, 'ul', 'li', $1, '' );
 
410
            $inList = 1;
 
411
 
 
412
        }
 
413
        elsif ( $line =~ m/^((\t|   )+)([1AaIi]\.|\d+\.?) ?/ ) {
 
414
 
 
415
            # Numbered list
 
416
            push( @result, '</p>' ) if $inParagraph;
 
417
            $inParagraph = 0;
 
418
            my $ot = $3;
 
419
            $ot =~ s/^(.).*/$1/;
 
420
            if ( $ot !~ /^\d$/ ) {
 
421
                $ot = ' type="' . $ot . '"';
 
422
            }
 
423
            else {
 
424
                $ot = '';
 
425
            }
 
426
            $line =~ s/^((\t|   )+)([1AaIi]\.|\d+\.?) ?/<li$ot> /;
 
427
            $this->_addListItem( \@result, 'ol', 'li', $1, $ot );
 
428
            $inList = 1;
 
429
 
 
430
        }
 
431
        elsif ( $inList && $line =~ /^[ \t]/ ) {
 
432
 
 
433
            # Extend text of previous list item by dropping through
 
434
 
 
435
        }
 
436
        else {
 
437
 
 
438
            # Other line
 
439
            $this->_addListItem( \@result, '', '', '' ) if $inList;
 
440
            $inList = 0;
 
441
        }
 
442
 
 
443
        push( @result, $line );
 
444
    }
 
445
 
 
446
    if ($inTable) {
 
447
        push( @result, '</table>' );
 
448
    }
 
449
    elsif ($inList) {
 
450
        $this->_addListItem( \@result, '', '', '' );
 
451
    }
 
452
    elsif ($inParagraph) {
 
453
        push( @result, '</p>' );
 
454
    }
 
455
 
 
456
    $text = join( "\n", @result );
 
457
 
 
458
    # Trim any extra Ps from the top and bottom.
 
459
    $text =~ s#^(\s*<p>\s*</p>)+##s;
 
460
    $text =~ s#(<p>\s*</p>\s*)+$##s;
 
461
 
 
462
    $text =~ s(${WC::STARTWW}==([^\s]+?|[^\s].*?[^\s])==$WC::ENDWW)
 
463
      (CGI::b(CGI::span({class => 'WYSIWYG_TT'}, $1)))gem;
 
464
    $text =~ s(${WC::STARTWW}__([^\s]+?|[^\s].*?[^\s])__$WC::ENDWW)
 
465
      (CGI::b(CGI::i($1)))gem;
 
466
    $text =~ s(${WC::STARTWW}\*([^\s]+?|[^\s].*?[^\s])\*$WC::ENDWW)
 
467
      (CGI::b($1))gem;
 
468
 
 
469
    $text =~ s(${WC::STARTWW}\_([^\s]+?|[^\s].*?[^\s])\_$WC::ENDWW)
 
470
      (CGI::i($1))gem;
 
471
    $text =~ s(${WC::STARTWW}\=([^\s]+?|[^\s].*?[^\s])\=$WC::ENDWW)
 
472
      (CGI::span({class => 'WYSIWYG_TT'}, $1))gem;
 
473
 
 
474
    # Handle [[][]] and [[]] links
 
475
 
 
476
    # We _not_ support [[http://link text]] syntax
 
477
 
 
478
    # [[][]]
 
479
    $text =~ s/(\[\[[^\]]*\](\[[^\]]*\])?\])/$this->_liftOut($1, 'LINK')/ge;
 
480
 
 
481
    $text =~
 
482
s/$WC::STARTWW(($Foswiki::regex{webNameRegex}\.)?$Foswiki::regex{wikiWordRegex}($Foswiki::regex{anchorRegex})?)/$this->_liftOut($1, 'LINK')/geom;
 
483
 
 
484
    while ( my ( $placeholder, $val ) = each %{ $this->{removed} } ) {
 
485
        if ( $placeholder =~ /^verbatim/i ) {
 
486
            _addClass( $val->{params}->{class}, 'TMLverbatim' );
 
487
        }
 
488
        elsif ( $placeholder =~ /^literal/i ) {
 
489
            _addClass( $val->{params}->{class}, 'WYSIWYG_LITERAL' );
 
490
        }
 
491
        elsif ( $placeholder =~ /^sticky/i ) {
 
492
            _addClass( $val->{params}->{class}, 'WYSIWYG_STICKY' );
 
493
        }
 
494
    }
 
495
 
 
496
    $this->_putBackBlocks( $text, 'pre' );
 
497
 
 
498
    $this->_putBackBlocks( $text, 'literal', 'div' );
 
499
 
 
500
    # replace verbatim with pre in the final output, with encoded entities
 
501
    $this->_putBackBlocks( $text, 'verbatim', 'pre', \&_protectVerbatimChars );
 
502
 
 
503
    $this->_putBackBlocks( $text, 'sticky', 'div', \&_protectVerbatimChars );
 
504
 
 
505
    $text =~ s/(<nop>)/$this->_liftOut($1, 'PROTECTED')/ge;
 
506
 
 
507
    return $text;
 
508
}
 
509
 
 
510
sub _addClass {
 
511
    if ( $_[0] ) {
 
512
        $_[0] = join( ' ', ( split( /\s+/, $_[0] ), $_[1] ) );
 
513
    }
 
514
    else {
 
515
        $_[0] = $_[1];
 
516
    }
 
517
}
 
518
 
 
519
# Encode special chars in verbatim as entities to prevent misinterpretation
 
520
sub _protectVerbatimChars {
 
521
    my $text = shift;
 
522
    $text =~ s/([\000-\011\013-\037<&>'"])/'&#'.ord($1).';'/ges;
 
523
    $text =~ s/ /&nbsp;/g;
 
524
    $text =~ s/\n/<br \/>/gs;
 
525
    return $text;
 
526
}
 
527
 
 
528
sub _takeOutIMGTag {
 
529
    my ( $this, $text ) = @_;
 
530
 
 
531
    # Expand selected macros in IMG tags so that images appear in the
 
532
    # editor as images
 
533
    $text =~
 
534
      s/(<img [^>]*\bsrc=)(["'])(.*?)\2/$1.$2.$this->_expandURL($3).$2/gie;
 
535
 
 
536
    # Take out mce_src - it just causes problems.
 
537
    $text =~ s/(<img [^>]*)\bmce_src=(["'])(.*?)\2/$1/gie;
 
538
    $text =~ s:([^/])>$:$1 />:;    # close the tag XHTML style
 
539
 
 
540
    return $this->_liftOut( $text, '', 'NONE' );
 
541
}
 
542
 
 
543
# Pull out Foswiki Set statements, to prevent unwanted munging
 
544
sub _takeOutSets {
 
545
    my $this = $_[0];
 
546
    my $setRegex =
 
547
qr/^((?:\t|   )+\*\s+(?:Set|Local)\s+(?:$Foswiki::regex{tagNameRegex})\s*=)(.*)$/o;
 
548
 
 
549
    my $lead;
 
550
    my $value;
 
551
    my @outtext;
 
552
    foreach ( split( /\r?\n/, $_[1] ) ) {
 
553
        if (m/$setRegex/s) {
 
554
            if ( defined $lead ) {
 
555
                push( @outtext,
 
556
                    $lead . $this->_liftOut( $value, 'PROTECTED' ) );
 
557
            }
 
558
            $lead = $1;
 
559
            $value = defined($2) ? $2 : '';
 
560
            next;
 
561
        }
 
562
 
 
563
        if ( defined $lead ) {
 
564
            if ( /^(   |\t)+ *[^\s]/ && !/$Foswiki::regex{bulletRegex}/o ) {
 
565
 
 
566
                # follow up line, extending value
 
567
                $value .= "\n" . $_;
 
568
                next;
 
569
            }
 
570
            push( @outtext, $lead . $this->_liftOut( $value, 'PROTECTED' ) );
 
571
            undef $lead;
 
572
        }
 
573
        push( @outtext, $_ );
 
574
    }
 
575
    if ( defined $lead ) {
 
576
        push( @outtext, $lead . $this->_liftOut( $value, 'PROTECTED' ) );
 
577
    }
 
578
    return join( "\n", @outtext );
 
579
}
 
580
 
 
581
sub _takeOutBlocks {
 
582
    my ( $this, $intext, $tag ) = @_;
 
583
    die unless $tag;
 
584
    return '' unless $intext;
 
585
    return $intext unless ( $intext =~ m/<$tag\b/ );
 
586
 
 
587
    my $open  = qr/<$tag\b[^>]*>/i;
 
588
    my $close = qr/<\/$tag>/i;
 
589
    my $out   = '';
 
590
    my $depth = 0;
 
591
    my $scoop;
 
592
    my $tagParams;
 
593
    my $n = 0;
 
594
 
 
595
    foreach my $chunk ( split /($open|$close)/, $intext ) {
 
596
        next unless defined($chunk);
 
597
        if ( $chunk =~ m/<$tag\b([^>]*)>/ ) {
 
598
            unless ( $depth++ ) {
 
599
                $tagParams = $1;
 
600
                $scoop     = '';
 
601
                next;
 
602
            }
 
603
        }
 
604
        elsif ( $depth && $chunk =~ m/$close/ ) {
 
605
            unless ( --$depth ) {
 
606
                my $placeholder = $tag . $n;
 
607
                $this->{removed}->{$placeholder} = {
 
608
                    params => _parseParams($tagParams),
 
609
                    text   => $scoop,
 
610
                };
 
611
                $chunk = $TT0 . $placeholder . $TT0;
 
612
                $n++;
 
613
            }
 
614
        }
 
615
        if ($depth) {
 
616
            $scoop .= $chunk;
 
617
        }
 
618
        else {
 
619
            $out .= $chunk;
 
620
        }
 
621
    }
 
622
 
 
623
    if ($depth) {
 
624
 
 
625
        # This would generate matching close tags
 
626
        # while ( $depth-- ) {
 
627
        #     $scoop .= "</$tag>\n";
 
628
        # }
 
629
        my $placeholder = $tag . $n;
 
630
        $this->{removed}->{$placeholder} = {
 
631
            params => _parseParams($tagParams),
 
632
            text   => $scoop,
 
633
        };
 
634
        $out .= $TT0 . $placeholder . $TT0;
 
635
    }
 
636
 
 
637
    # Filter spurious tags without matching open/close
 
638
    $out =~ s/$open/&lt;$tag$1&gt;/g;
 
639
    $out =~ s/$close/&lt;\/$tag&gt;/g;
 
640
    $out =~ s/<($tag\s+\/)>/&lt;$1&gt;/g;
 
641
 
 
642
    return $out;
 
643
}
 
644
 
 
645
sub _putBackBlocks {
 
646
    my ( $this, $text, $tag, $newtag, $callback ) = @_;
 
647
    $newtag ||= $tag;
 
648
    my $fn;
 
649
    while ( my ( $placeholder, $val ) = each %{ $this->{removed} } ) {
 
650
        if ( $placeholder =~ /^$tag\d+$/ ) {
 
651
            my $params = $val->{params};
 
652
            my $val    = $val->{text};
 
653
            $val = &$callback($val) if ( defined($callback) );
 
654
 
 
655
            # Use div instead of span if the block contains block HTML
 
656
            if ( $newtag eq 'span' && $val =~ m#</?($WC::ALWAYS_BLOCK_S)\b#io )
 
657
            {
 
658
                $fn = 'CGI::div';
 
659
            }
 
660
            else {
 
661
                $fn = 'CGI::' . $newtag;
 
662
            }
 
663
            no strict 'refs';
 
664
            $_[1] =~ s/$TT0$placeholder$TT0/&$fn($params, $val)/e;
 
665
            use strict 'refs';
 
666
            delete( $this->{removed}->{$placeholder} );
 
667
        }
 
668
    }
 
669
}
 
670
 
 
671
sub _parseParams {
 
672
    my $p      = shift;
 
673
    my $params = {};
 
674
    while ( $p =~ s/^\s*([$Foswiki::regex{mixedAlphaNum}]+)=(".*?"|'.*?')// ) {
 
675
        my $name = $1;
 
676
        my $val  = $2;
 
677
        $val =~ s/['"](.*)['"]/$1/;
 
678
        $params->{$name} = $val;
 
679
    }
 
680
    return $params;
 
681
}
 
682
 
 
683
# Lifted straight out of DevelopBranch Render.pm
 
684
sub _addListItem {
 
685
    my ( $this, $result, $theType, $theElement, $theIndent, $theOlType ) = @_;
 
686
 
 
687
    $theIndent =~ s/   /\t/g;
 
688
    my $depth = length($theIndent);
 
689
 
 
690
    my $size = scalar( @{ $this->{LIST} } );
 
691
    if ( $size < $depth ) {
 
692
        my $firstTime = 1;
 
693
        while ( $size < $depth ) {
 
694
            push(
 
695
                @{ $this->{LIST} },
 
696
                { type => $theType, element => $theElement }
 
697
            );
 
698
            push( @$result, "<$theElement>" ) unless ($firstTime);
 
699
            push( @$result, "<$theType>" );
 
700
            $firstTime = 0;
 
701
            $size++;
 
702
        }
 
703
    }
 
704
    else {
 
705
        while ( $size > $depth ) {
 
706
            my $tags = pop( @{ $this->{LIST} } );
 
707
            push( @$result, "</$tags->{element}>" );
 
708
            push( @$result, "</$tags->{type}>" );
 
709
            $size--;
 
710
        }
 
711
        if ($size) {
 
712
            push( @$result, "</$this->{LIST}->[$size-1]->{element}>" );
 
713
        }
 
714
    }
 
715
 
 
716
    if ($size) {
 
717
        my $oldt = $this->{LIST}->[ $size - 1 ];
 
718
        if ( $oldt->{type} ne $theType ) {
 
719
            push( @$result, "</$oldt->{type}>\n<$theType>" );
 
720
            pop( @{ $this->{LIST} } );
 
721
            push(
 
722
                @{ $this->{LIST} },
 
723
                { type => $theType, element => $theElement }
 
724
            );
 
725
        }
 
726
    }
 
727
}
 
728
 
 
729
sub _emitTR {
 
730
    my $row = shift;
 
731
 
 
732
    $row =~ s/\t/   /g;      # change tabs to space
 
733
    $row =~ s/^(\s*)\|//;    # Remove leading junk
 
734
    my $pre = $1;
 
735
 
 
736
    my @tr;
 
737
    while ( $row =~ s/^(.*?)\|// ) {
 
738
        my $cell = $1;
 
739
        my $attr = {};
 
740
 
 
741
        # make sure there's something there in empty cells. Otherwise
 
742
        # the editor may compress it to (visual) nothing.
 
743
        $cell =~ s/^\s+$/&nbsp;/g;
 
744
 
 
745
        my ( $left, $right ) = ( 0, 0 );
 
746
        if ( $cell =~ /^(\s*)(.*?)(\s*)$/ ) {
 
747
            $left  = length($1);
 
748
            $right = length($3);
 
749
            $cell  = $2;
 
750
        }
 
751
 
 
752
        if ( $left == 1 && $right < 2 ) {
 
753
 
 
754
            # Treat left=1 and right=0 like 1 and 1 - Item5220
 
755
        }
 
756
        elsif ( $left > $right ) {
 
757
            $attr->{class} = 'align-right';
 
758
            $attr->{style} = 'text-align: right';
 
759
        }
 
760
        elsif ( $left < $right ) {
 
761
            $attr->{class} = 'align-left';
 
762
            $attr->{style} = 'text-align: left';
 
763
        }
 
764
        elsif ( $left > 1 ) {
 
765
            $attr->{class} = 'align-center';
 
766
            $attr->{style} = 'text-align: center';
 
767
        }
 
768
 
 
769
        my $fn = "CGI::td";
 
770
        if ( $cell =~ s/^\*(.+)\*$/$1/ ) {
 
771
            $fn = "CGI::th";
 
772
        }
 
773
 
 
774
        $cell = ' '.$cell if $cell =~ /^(?:\*|==?|__?)[^\s]/;
 
775
        $cell = $cell.' ' if $cell =~ /[^\s](?:\*|==?|__?)$/;
 
776
 
 
777
        push( @tr, { fn => $fn, attr => $attr, text => $cell } ); 
 
778
    }
 
779
 
 
780
    # Work out colspans
 
781
    my $colspan = 0;
 
782
    my @row;
 
783
    for ( my $i = $#tr ; $i >= 0 ; $i-- ) {
 
784
        if ( $i && length( $tr[$i]->{text} ) == 0 ) {
 
785
            $colspan++;
 
786
            next;
 
787
        }
 
788
        elsif ($colspan) {
 
789
            $tr[$i]->{attr}->{colspan} = $colspan + 1;
 
790
            $colspan = 0;
 
791
        }
 
792
        unshift( @row, $tr[$i] );
 
793
    }
 
794
    no strict 'refs';
 
795
    return $pre
 
796
      . CGI::Tr(
 
797
        join( '', map { &{ $_->{fn} }( $_->{attr}, $_->{text} ) } @row ) );
 
798
    use strict 'refs';
 
799
}
 
800
 
 
801
1;