Upgrade to Pod-Simple-3.06
[p5sagit/p5-mst-13.2.git] / lib / Pod / Simple / BlackBox.pm
1
2 package Pod::Simple::BlackBox;
3 #
4 # "What's in the box?"  "Pain."
5 #
6 ###########################################################################
7 #
8 # This is where all the scary things happen: parsing lines into
9 #  paragraphs; and then into directives, verbatims, and then also
10 #  turning formatting sequences into treelets.
11 #
12 # Are you really sure you want to read this code?
13 #
14 #-----------------------------------------------------------------------------
15 #
16 # The basic work of this module Pod::Simple::BlackBox is doing the dirty work
17 # of parsing Pod into treelets (generally one per non-verbatim paragraph), and
18 # to call the proper callbacks on the treelets.
19 #
20 # Every node in a treelet is a ['name', {attrhash}, ...children...]
21
22 use integer; # vroom!
23 use strict;
24 use Carp ();
25 BEGIN {
26   require Pod::Simple;
27   *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG
28 }
29
30 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
31
32 sub parse_line { shift->parse_lines(@_) } # alias
33
34 # - - -  Turn back now!  Run away!  - - -
35
36 sub parse_lines {             # Usage: $parser->parse_lines(@lines)
37   # an undef means end-of-stream
38   my $self = shift;
39
40   my $code_handler = $self->{'code_handler'};
41   my $cut_handler  = $self->{'cut_handler'};
42   $self->{'line_count'} ||= 0;
43  
44   my $scratch;
45
46   DEBUG > 4 and 
47    print "# Parsing starting at line ", $self->{'line_count'}, ".\n";
48
49   DEBUG > 5 and
50    print "#  About to parse lines: ",
51      join(' ', map defined($_) ? "[$_]" : "EOF", @_), "\n";
52
53   my $paras = ($self->{'paras'} ||= []);
54    # paragraph buffer.  Because we need to defer processing of =over
55    # directives and verbatim paragraphs.  We call _ponder_paragraph_buffer
56    # to process this.
57   
58   $self->{'pod_para_count'} ||= 0;
59
60   my $line;
61   foreach my $source_line (@_) {
62     if( $self->{'source_dead'} ) {
63       DEBUG > 4 and print "# Source is dead.\n";
64       last;
65     }
66
67     unless( defined $source_line ) {
68       DEBUG > 4 and print "# Undef-line seen.\n";
69
70       push @$paras, ['~end', {'start_line' => $self->{'line_count'}}];
71       push @$paras, $paras->[-1], $paras->[-1];
72        # So that it definitely fills the buffer.
73       $self->{'source_dead'} = 1;
74       $self->_ponder_paragraph_buffer;
75       next;
76     }
77
78
79     if( $self->{'line_count'}++ ) {
80       ($line = $source_line) =~ tr/\n\r//d;
81        # If we don't have two vars, we'll end up with that there
82        # tr/// modding the (potentially read-only) original source line!
83     
84     } else {
85       DEBUG > 2 and print "First line: [$source_line]\n";
86
87       if( ($line = $source_line) =~ s/^\xEF\xBB\xBF//s ) {
88         DEBUG and print "UTF-8 BOM seen.  Faking a '=encode utf8'.\n";
89         $self->_handle_encoding_line( "=encode utf8" );
90         $line =~ tr/\n\r//d;
91         
92       } elsif( $line =~ s/^\xFE\xFF//s ) {
93         DEBUG and print "Big-endian UTF-16 BOM seen.  Aborting parsing.\n";
94         $self->scream(
95           $self->{'line_count'},
96           "UTF16-BE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet."
97         );
98         splice @_;
99         push @_, undef;
100         next;
101
102         # TODO: implement somehow?
103
104       } elsif( $line =~ s/^\xFF\xFE//s ) {
105         DEBUG and print "Little-endian UTF-16 BOM seen.  Aborting parsing.\n";
106         $self->scream(
107           $self->{'line_count'},
108           "UTF16-LE Byte Encoding Mark found; but Pod::Simple v$Pod::Simple::VERSION doesn't implement UTF16 yet."
109         );
110         splice @_;
111         push @_, undef;
112         next;
113
114         # TODO: implement somehow?
115         
116       } else {
117         DEBUG > 2 and print "First line is BOM-less.\n";
118         ($line = $source_line) =~ tr/\n\r//d;
119       }
120     }
121
122
123     DEBUG > 5 and print "# Parsing line: [$line]\n";
124
125     if(!$self->{'in_pod'}) {
126       if($line =~ m/^=([a-zA-Z]+)/s) {
127         if($1 eq 'cut') {
128           $self->scream(
129             $self->{'line_count'},
130             "=cut found outside a pod block.  Skipping to next block."
131           );
132           
133           ## Before there were errata sections in the world, it was
134           ## least-pessimal to abort processing the file.  But now we can
135           ## just barrel on thru (but still not start a pod block).
136           #splice @_;
137           #push @_, undef;
138           
139           next;
140         } else {
141           $self->{'in_pod'} = $self->{'start_of_pod_block'}
142                             = $self->{'last_was_blank'}     = 1;
143           # And fall thru to the pod-mode block further down
144         }
145       } else {
146         DEBUG > 5 and print "# It's a code-line.\n";
147         $code_handler->(map $_, $line, $self->{'line_count'}, $self)
148          if $code_handler;
149         # Note: this may cause code to be processed out of order relative
150         #  to pods, but in order relative to cuts.
151         
152         # Note also that we haven't yet applied the transcoding to $line
153         #  by time we call $code_handler!
154
155         if( $line =~ m/^#\s*line\s+(\d+)\s*(?:\s"([^"]+)")?\s*$/ ) {
156           # That RE is from perlsyn, section "Plain Old Comments (Not!)",
157           #$fname = $2 if defined $2;
158           #DEBUG > 1 and defined $2 and print "# Setting fname to \"$fname\"\n";
159           DEBUG > 1 and print "# Setting nextline to $1\n";
160           $self->{'line_count'} = $1 - 1;
161         }
162         
163         next;
164       }
165     }
166     
167     # . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
168     # Else we're in pod mode:
169
170     # Apply any necessary transcoding:
171     $self->{'_transcoder'} && $self->{'_transcoder'}->($line);
172
173     # HERE WE CATCH =encoding EARLY!
174     if( $line =~ m/^=encoding\s+\S+\s*$/s ) {
175       $line = $self->_handle_encoding_line( $line );
176     }
177
178     if($line =~ m/^=cut/s) {
179       # here ends the pod block, and therefore the previous pod para
180       DEBUG > 1 and print "Noting =cut at line ${$self}{'line_count'}\n";
181       $self->{'in_pod'} = 0;
182       # ++$self->{'pod_para_count'};
183       $self->_ponder_paragraph_buffer();
184        # by now it's safe to consider the previous paragraph as done.
185       $cut_handler->(map $_, $line, $self->{'line_count'}, $self)
186        if $cut_handler;
187
188       # TODO: add to docs: Note: this may cause cuts to be processed out
189       #  of order relative to pods, but in order relative to code.
190       
191     } elsif($line =~ m/^\s*$/s) {  # it's a blank line
192       if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') {
193         DEBUG > 1 and print "Saving blank line at line ${$self}{'line_count'}\n";
194         push @{$paras->[-1]}, $line;
195       }  # otherwise it's not interesting
196       
197       if(!$self->{'start_of_pod_block'} and !$self->{'last_was_blank'}) {
198         DEBUG > 1 and print "Noting para ends with blank line at ${$self}{'line_count'}\n"; 
199       }
200       
201       $self->{'last_was_blank'} = 1;
202       
203     } elsif($self->{'last_was_blank'}) {  # A non-blank line starting a new para...
204       
205       if($line =~ m/^(=[a-zA-Z][a-zA-Z0-9]*)(?:\s+|$)(.*)/s) {
206         # THIS IS THE ONE PLACE WHERE WE CONSTRUCT NEW DIRECTIVE OBJECTS
207         my $new = [$1, {'start_line' => $self->{'line_count'}}, $2];
208          # Note that in "=head1 foo", the WS is lost.
209          # Example: ['=head1', {'start_line' => 123}, ' foo']
210         
211         ++$self->{'pod_para_count'};
212         
213         $self->_ponder_paragraph_buffer();
214          # by now it's safe to consider the previous paragraph as done.
215                 
216         push @$paras, $new; # the new incipient paragraph
217         DEBUG > 1 and print "Starting new ${$paras}[-1][0] para at line ${$self}{'line_count'}\n";
218         
219       } elsif($line =~ m/^\s/s) {
220
221         if(!$self->{'start_of_pod_block'} and @$paras and $paras->[-1][0] eq '~Verbatim') {
222           DEBUG > 1 and print "Resuming verbatim para at line ${$self}{'line_count'}\n";
223           push @{$paras->[-1]}, $line;
224         } else {
225           ++$self->{'pod_para_count'};
226           $self->_ponder_paragraph_buffer();
227            # by now it's safe to consider the previous paragraph as done.
228           DEBUG > 1 and print "Starting verbatim para at line ${$self}{'line_count'}\n";
229           push @$paras, ['~Verbatim', {'start_line' => $self->{'line_count'}}, $line];
230         }
231       } else {
232         ++$self->{'pod_para_count'};
233         $self->_ponder_paragraph_buffer();
234          # by now it's safe to consider the previous paragraph as done.
235         push @$paras, ['~Para',  {'start_line' => $self->{'line_count'}}, $line];
236         DEBUG > 1 and print "Starting plain para at line ${$self}{'line_count'}\n";
237       }
238       $self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0;
239
240     } else {
241       # It's a non-blank line /continuing/ the current para
242       if(@$paras) {
243         DEBUG > 2 and print "Line ${$self}{'line_count'} continues current paragraph\n";
244         push @{$paras->[-1]}, $line;
245       } else {
246         # Unexpected case!
247         die "Continuing a paragraph but \@\$paras is empty?";
248       }
249       $self->{'last_was_blank'} = $self->{'start_of_pod_block'} = 0;
250     }
251     
252   } # ends the big while loop
253
254   DEBUG > 1 and print(pretty(@$paras), "\n");
255   return $self;
256 }
257
258 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
259
260 sub _handle_encoding_line {
261   my($self, $line) = @_;
262   
263   # The point of this routine is to set $self->{'_transcoder'} as indicated.
264
265   return $line unless $line =~ m/^=encoding\s+(\S+)\s*$/s;
266   DEBUG > 1 and print "Found an encoding line \"=encoding $1\"\n";
267
268   my $e    = $1;
269   my $orig = $e;
270   push @{ $self->{'encoding_command_reqs'} }, "=encoding $orig";
271
272   my $enc_error;
273
274   # Cf.   perldoc Encode   and   perldoc Encode::Supported
275
276   require Pod::Simple::Transcode;
277
278   if( $self->{'encoding'} ) {
279     my $norm_current = $self->{'encoding'};
280     my $norm_e = $e;
281     foreach my $that ($norm_current, $norm_e) {
282       $that =  lc($that);
283       $that =~ s/[-_]//g;
284     }
285     if($norm_current eq $norm_e) {
286       DEBUG > 1 and print "The '=encoding $orig' line is ",
287        "redundant.  ($norm_current eq $norm_e).  Ignoring.\n";
288       $enc_error = '';
289        # But that doesn't necessarily mean that the earlier one went okay
290     } else {
291       $enc_error = "Encoding is already set to " . $self->{'encoding'};
292       DEBUG > 1 and print $enc_error;
293     }
294   } elsif (
295     # OK, let's turn on the encoding
296     do {
297       DEBUG > 1 and print " Setting encoding to $e\n";
298       $self->{'encoding'} = $e;
299       1;
300     }
301     and $e eq 'HACKRAW'
302   ) {
303     DEBUG and print " Putting in HACKRAW (no-op) encoding mode.\n";
304
305   } elsif( Pod::Simple::Transcode::->encoding_is_available($e) ) {
306
307     die($enc_error = "WHAT? _transcoder is already set?!")
308      if $self->{'_transcoder'};   # should never happen
309     require Pod::Simple::Transcode;
310     $self->{'_transcoder'} = Pod::Simple::Transcode::->make_transcoder($e);
311     eval {
312       my @x = ('', "abc", "123");
313       $self->{'_transcoder'}->(@x);
314     };
315     $@ && die( $enc_error =
316       "Really unexpected error setting up encoding $e: $@\nAborting"
317     );
318
319   } else {
320     my @supported = Pod::Simple::Transcode::->all_encodings;
321
322     # Note unsupported, and complain
323     DEBUG and print " Encoding [$e] is unsupported.",
324       "\nSupporteds: @supported\n";
325     my $suggestion = '';
326
327     # Look for a near match:
328     my $norm = lc($e);
329     $norm =~ tr[-_][]d;
330     my $n;
331     foreach my $enc (@supported) {
332       $n = lc($enc);
333       $n =~ tr[-_][]d;
334       next unless $n eq $norm;
335       $suggestion = "  (Maybe \"$e\" should be \"$enc\"?)";
336       last;
337     }
338     my $encmodver = Pod::Simple::Transcode::->encmodver;
339     $enc_error = join '' =>
340       "This document probably does not appear as it should, because its ",
341       "\"=encoding $e\" line calls for an unsupported encoding.",
342       $suggestion, "  [$encmodver\'s supported encodings are: @supported]"
343     ;
344
345     $self->scream( $self->{'line_count'}, $enc_error );
346   }
347   push @{ $self->{'encoding_command_statuses'} }, $enc_error;
348
349   return '=encoding ALREADYDONE';
350 }
351
352 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
353
354 sub _handle_encoding_second_level {
355   # By time this is called, the encoding (if well formed) will already
356   #  have been acted one.
357   my($self, $para) = @_;
358   my @x = @$para;
359   my $content = join ' ', splice @x, 2;
360   $content =~ s/^\s+//s;
361   $content =~ s/\s+$//s;
362
363   DEBUG > 2 and print "Ogling encoding directive: =encoding $content\n";
364   
365   if($content eq 'ALREADYDONE') {
366     # It's already been handled.  Check for errors.
367     if(! $self->{'encoding_command_statuses'} ) {
368       DEBUG > 2 and print " CRAZY ERROR: It wasn't really handled?!\n";
369     } elsif( $self->{'encoding_command_statuses'}[-1] ) {
370       $self->whine( $para->[1]{'start_line'},
371         sprintf "Couldn't do %s: %s",
372           $self->{'encoding_command_reqs'  }[-1],
373           $self->{'encoding_command_statuses'}[-1],
374       );
375     } else {
376       DEBUG > 2 and print " (Yup, it was successfully handled already.)\n";
377     }
378     
379   } else {
380     # Otherwise it's a syntax error
381     $self->whine( $para->[1]{'start_line'},
382       "Invalid =encoding syntax: $content"
383     );
384   }
385   
386   return;
387 }
388
389 #~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`~`
390
391 {
392 my $m = -321;   # magic line number
393
394 sub _gen_errata {
395   my $self = $_[0];
396   # Return 0 or more fake-o paragraphs explaining the accumulated
397   #  errors on this document.
398
399   return() unless $self->{'errata'} and keys %{$self->{'errata'}};
400
401   my @out;
402   
403   foreach my $line (sort {$a <=> $b} keys %{$self->{'errata'}}) {
404     push @out,
405       ['=item', {'start_line' => $m}, "Around line $line:"],
406       map( ['~Para', {'start_line' => $m, '~cooked' => 1},
407         #['~Top', {'start_line' => $m},
408         $_
409         #]
410         ],
411         @{$self->{'errata'}{$line}}
412       )
413     ;
414   }
415   
416   # TODO: report of unknown entities? unrenderable characters?
417
418   unshift @out,
419     ['=head1', {'start_line' => $m, 'errata' => 1}, 'POD ERRORS'],
420     ['~Para', {'start_line' => $m, '~cooked' => 1, 'errata' => 1},
421      "Hey! ",
422      ['B', {},
423       'The above document had some coding errors, which are explained below:'
424      ]
425     ],
426     ['=over',  {'start_line' => $m, 'errata' => 1}, ''],
427   ;
428
429   push @out, 
430     ['=back',  {'start_line' => $m, 'errata' => 1}, ''],
431   ;
432
433   DEBUG and print "\n<<\n", pretty(\@out), "\n>>\n\n";
434
435   return @out;
436 }
437
438 }
439
440 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
441
442 ##############################################################################
443 ##
444 ##  stop reading now stop reading now stop reading now stop reading now stop
445 ##
446 ##                         HERE IT BECOMES REALLY SCARY
447 ##
448 ##  stop reading now stop reading now stop reading now stop reading now stop
449 ##
450 ##############################################################################
451
452 sub _ponder_paragraph_buffer {
453
454   # Para-token types as found in the buffer.
455   #   ~Verbatim, ~Para, ~end, =head1..4, =for, =begin, =end,
456   #   =over, =back, =item
457   #   and the null =pod (to be complained about if over one line)
458   #
459   # "~data" paragraphs are something we generate at this level, depending on
460   # a currently open =over region
461
462   # Events fired:  Begin and end for:
463   #                   directivename (like head1 .. head4), item, extend,
464   #                   for (from =begin...=end, =for),
465   #                   over-bullet, over-number, over-text, over-block,
466   #                   item-bullet, item-number, item-text,
467   #                   Document,
468   #                   Data, Para, Verbatim
469   #                   B, C, longdirname (TODO -- wha?), etc. for all directives
470   # 
471
472   my $self = $_[0];
473   my $paras;
474   return unless @{$paras = $self->{'paras'}};
475   my $curr_open = ($self->{'curr_open'} ||= []);
476
477   my $scratch;
478
479   DEBUG > 10 and print "# Paragraph buffer: <<", pretty($paras), ">>\n";
480
481   # We have something in our buffer.  So apparently the document has started.
482   unless($self->{'doc_has_started'}) {
483     $self->{'doc_has_started'} = 1;
484     
485     my $starting_contentless;
486     $starting_contentless =
487      (
488        !@$curr_open  
489        and @$paras and ! grep $_->[0] ne '~end', @$paras
490         # i.e., if the paras is all ~ends
491      )
492     ;
493     DEBUG and print "# Starting ", 
494       $starting_contentless ? 'contentless' : 'contentful',
495       " document\n"
496     ;
497     
498     $self->_handle_element_start(
499       ($scratch = 'Document'),
500       {
501         'start_line' => $paras->[0][1]{'start_line'},
502         $starting_contentless ? ( 'contentless' => 1 ) : (),
503       },
504     );
505   }
506
507   my($para, $para_type);
508   while(@$paras) {
509     last if @$paras == 1 and
510       ( $paras->[0][0] eq '=over' or $paras->[0][0] eq '~Verbatim'
511         or $paras->[0][0] eq '=item' )
512     ;
513     # Those're the three kinds of paragraphs that require lookahead.
514     #   Actually, an "=item Foo" inside an <over type=text> region
515     #   and any =item inside an <over type=block> region (rare)
516     #   don't require any lookahead, but all others (bullets
517     #   and numbers) do.
518
519 # TODO: winge about many kinds of directives in non-resolving =for regions?
520 # TODO: many?  like what?  =head1 etc?
521
522     $para = shift @$paras;
523     $para_type = $para->[0];
524
525     DEBUG > 1 and print "Pondering a $para_type paragraph, given the stack: (",
526       $self->_dump_curr_open(), ")\n";
527     
528     if($para_type eq '=for') {
529       next if $self->_ponder_for($para,$curr_open,$paras);
530
531     } elsif($para_type eq '=begin') {
532       next if $self->_ponder_begin($para,$curr_open,$paras);
533
534     } elsif($para_type eq '=end') {
535       next if $self->_ponder_end($para,$curr_open,$paras);
536
537     } elsif($para_type eq '~end') { # The virtual end-document signal
538       next if $self->_ponder_doc_end($para,$curr_open,$paras);
539     }
540
541
542     # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
543     #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
544     if(grep $_->[1]{'~ignore'}, @$curr_open) {
545       DEBUG > 1 and
546        print "Skipping $para_type paragraph because in ignore mode.\n";
547       next;
548     }
549     #~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
550     # ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
551
552     if($para_type eq '=pod') {
553       $self->_ponder_pod($para,$curr_open,$paras);
554
555     } elsif($para_type eq '=over') {
556       next if $self->_ponder_over($para,$curr_open,$paras);
557
558     } elsif($para_type eq '=back') {
559       next if $self->_ponder_back($para,$curr_open,$paras);
560
561     } else {
562
563       # All non-magical codes!!!
564       
565       # Here we start using $para_type for our own twisted purposes, to
566       #  mean how it should get treated, not as what the element name
567       #  should be.
568
569       DEBUG > 1 and print "Pondering non-magical $para_type\n";
570
571       my $i;
572
573       # Enforce some =headN discipline
574       if($para_type =~ m/^=head\d$/s
575          and ! $self->{'accept_heads_anywhere'}
576          and @$curr_open
577          and $curr_open->[-1][0] eq '=over'
578       ) {
579         DEBUG > 2 and print "'=$para_type' inside an '=over'!\n";
580         $self->whine(
581           $para->[1]{'start_line'},
582           "You forgot a '=back' before '$para_type'"
583         );
584         unshift @$paras, ['=back', {}, ''], $para;   # close the =over
585         next;
586       }
587
588
589       if($para_type eq '=item') {
590
591         my $over;
592         unless(@$curr_open and ($over = $curr_open->[-1])->[0] eq '=over') {
593           $self->whine(
594             $para->[1]{'start_line'},
595             "'=item' outside of any '=over'"
596           );
597           unshift @$paras,
598             ['=over', {'start_line' => $para->[1]{'start_line'}}, ''],
599             $para
600           ;
601           next;
602         }
603         
604         
605         my $over_type = $over->[1]{'~type'};
606         
607         if(!$over_type) {
608           # Shouldn't happen1
609           die "Typeless over in stack, starting at line "
610            . $over->[1]{'start_line'};
611
612         } elsif($over_type eq 'block') {
613           unless($curr_open->[-1][1]{'~bitched_about'}) {
614             $curr_open->[-1][1]{'~bitched_about'} = 1;
615             $self->whine(
616               $curr_open->[-1][1]{'start_line'},
617               "You can't have =items (as at line "
618               . $para->[1]{'start_line'}
619               . ") unless the first thing after the =over is an =item"
620             );
621           }
622           # Just turn it into a paragraph and reconsider it
623           $para->[0] = '~Para';
624           unshift @$paras, $para;
625           next;
626
627         } elsif($over_type eq 'text') {
628           my $item_type = $self->_get_item_type($para);
629             # That kills the content of the item if it's a number or bullet.
630           DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
631           
632           if($item_type eq 'text') {
633             # Nothing special needs doing for 'text'
634           } elsif($item_type eq 'number' or $item_type eq 'bullet') {
635             die "Unknown item type $item_type"
636              unless $item_type eq 'number' or $item_type eq 'bullet';
637             # Undo our clobbering:
638             push @$para, $para->[1]{'~orig_content'};
639             delete $para->[1]{'number'};
640              # Only a PROPER item-number element is allowed
641              #  to have a number attribute.
642           } else {
643             die "Unhandled item type $item_type"; # should never happen
644           }
645           
646           # =item-text thingies don't need any assimilation, it seems.
647
648         } elsif($over_type eq 'number') {
649           my $item_type = $self->_get_item_type($para);
650             # That kills the content of the item if it's a number or bullet.
651           DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
652           
653           my $expected_value = ++ $curr_open->[-1][1]{'~counter'};
654           
655           if($item_type eq 'bullet') {
656             # Hm, it's not numeric.  Correct for this.
657             $para->[1]{'number'} = $expected_value;
658             $self->whine(
659               $para->[1]{'start_line'},
660               "Expected '=item $expected_value'"
661             );
662             push @$para, $para->[1]{'~orig_content'};
663               # restore the bullet, blocking the assimilation of next para
664
665           } elsif($item_type eq 'text') {
666             # Hm, it's not numeric.  Correct for this.
667             $para->[1]{'number'} = $expected_value;
668             $self->whine(
669               $para->[1]{'start_line'},
670               "Expected '=item $expected_value'"
671             );
672             # Text content will still be there and will block next ~Para
673
674           } elsif($item_type ne 'number') {
675             die "Unknown item type $item_type"; # should never happen
676
677           } elsif($expected_value == $para->[1]{'number'}) {
678             DEBUG > 1 and print " Numeric item has the expected value of $expected_value\n";
679             
680           } else {
681             DEBUG > 1 and print " Numeric item has ", $para->[1]{'number'},
682              " instead of the expected value of $expected_value\n";
683             $self->whine(
684               $para->[1]{'start_line'},
685               "You have '=item " . $para->[1]{'number'} .
686               "' instead of the expected '=item $expected_value'"
687             );
688             $para->[1]{'number'} = $expected_value;  # correcting!!
689           }
690             
691           if(@$para == 2) {
692             # For the cases where we /didn't/ push to @$para
693             if($paras->[0][0] eq '~Para') {
694               DEBUG and print "Assimilating following ~Para content into $over_type item\n";
695               push @$para, splice @{shift @$paras},2;
696             } else {
697               DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
698               push @$para, '';  # Just so it's not contentless
699             }
700           }
701
702
703         } elsif($over_type eq 'bullet') {
704           my $item_type = $self->_get_item_type($para);
705             # That kills the content of the item if it's a number or bullet.
706           DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
707           
708           if($item_type eq 'bullet') {
709             # as expected!
710
711             if( $para->[1]{'~_freaky_para_hack'} ) {
712               DEBUG and print "Accomodating '=item * Foo' tolerance hack.\n";
713               push @$para, delete $para->[1]{'~_freaky_para_hack'};
714             }
715
716           } elsif($item_type eq 'number') {
717             $self->whine(
718               $para->[1]{'start_line'},
719               "Expected '=item *'"
720             );
721             push @$para, $para->[1]{'~orig_content'};
722              # and block assimilation of the next paragraph
723             delete $para->[1]{'number'};
724              # Only a PROPER item-number element is allowed
725              #  to have a number attribute.
726           } elsif($item_type eq 'text') {
727             $self->whine(
728               $para->[1]{'start_line'},
729               "Expected '=item *'"
730             );
731              # But doesn't need processing.  But it'll block assimilation
732              #  of the next para.
733           } else {
734             die "Unhandled item type $item_type"; # should never happen
735           }
736
737           if(@$para == 2) {
738             # For the cases where we /didn't/ push to @$para
739             if($paras->[0][0] eq '~Para') {
740               DEBUG and print "Assimilating following ~Para content into $over_type item\n";
741               push @$para, splice @{shift @$paras},2;
742             } else {
743               DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
744               push @$para, '';  # Just so it's not contentless
745             }
746           }
747
748         } else {
749           die "Unhandled =over type \"$over_type\"?";
750           # Shouldn't happen!
751         }
752
753         $para_type = 'Plain';
754         $para->[0] .= '-' . $over_type;
755         # Whew.  Now fall thru and process it.
756
757
758       } elsif($para_type eq '=extend') {
759         # Well, might as well implement it here.
760         $self->_ponder_extend($para);
761         next;  # and skip
762       } elsif($para_type eq '=encoding') {
763         # Not actually acted on here, but we catch errors here.
764         $self->_handle_encoding_second_level($para);
765
766         next;  # and skip
767       } elsif($para_type eq '~Verbatim') {
768         $para->[0] = 'Verbatim';
769         $para_type = '?Verbatim';
770       } elsif($para_type eq '~Para') {
771         $para->[0] = 'Para';
772         $para_type = '?Plain';
773       } elsif($para_type eq 'Data') {
774         $para->[0] = 'Data';
775         $para_type = '?Data';
776       } elsif( $para_type =~ s/^=//s
777         and defined( $para_type = $self->{'accept_directives'}{$para_type} )
778       ) {
779         DEBUG > 1 and print " Pondering known directive ${$para}[0] as $para_type\n";
780       } else {
781         # An unknown directive!
782         DEBUG > 1 and printf "Unhandled directive %s (Handled: %s)\n",
783          $para->[0], join(' ', sort keys %{$self->{'accept_directives'}} )
784         ;
785         $self->whine(
786           $para->[1]{'start_line'},
787           "Unknown directive: $para->[0]"
788         );
789
790         # And maybe treat it as text instead of just letting it go?
791         next;
792       }
793
794       if($para_type =~ s/^\?//s) {
795         if(! @$curr_open) {  # usual case
796           DEBUG and print "Treating $para_type paragraph as such because stack is empty.\n";
797         } else {
798           my @fors = grep $_->[0] eq '=for', @$curr_open;
799           DEBUG > 1 and print "Containing fors: ",
800             join(',', map $_->[1]{'target'}, @fors), "\n";
801           
802           if(! @fors) {
803             DEBUG and print "Treating $para_type paragraph as such because stack has no =for's\n";
804             
805           #} elsif(grep $_->[1]{'~resolve'}, @fors) {
806           #} elsif(not grep !$_->[1]{'~resolve'}, @fors) {
807           } elsif( $fors[-1][1]{'~resolve'} ) {
808             # Look to the immediately containing for
809           
810             if($para_type eq 'Data') {
811               DEBUG and print "Treating Data paragraph as Plain/Verbatim because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
812               $para->[0] = 'Para';
813               $para_type = 'Plain';
814             } else {
815               DEBUG and print "Treating $para_type paragraph as such because the containing =for ($fors[-1][1]{'target'}) is a resolver\n";
816             }
817           } else {
818             DEBUG and print "Treating $para_type paragraph as Data because the containing =for ($fors[-1][1]{'target'}) is a non-resolver\n";
819             $para->[0] = $para_type = 'Data';
820           }
821         }
822       }
823
824       #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
825       if($para_type eq 'Plain') {
826         $self->_ponder_Plain($para);
827       } elsif($para_type eq 'Verbatim') {
828         $self->_ponder_Verbatim($para);        
829       } elsif($para_type eq 'Data') {
830         $self->_ponder_Data($para);
831       } else {
832         die "\$para type is $para_type -- how did that happen?";
833         # Shouldn't happen.
834       }
835
836       #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
837       $para->[0] =~ s/^[~=]//s;
838
839       DEBUG and print "\n", pretty($para), "\n";
840
841       # traverse the treelet (which might well be just one string scalar)
842       $self->{'content_seen'} ||= 1;
843       $self->_traverse_treelet_bit(@$para);
844     }
845   }
846   
847   return;
848 }
849
850 ###########################################################################
851 # The sub-ponderers...
852
853
854
855 sub _ponder_for {
856   my ($self,$para,$curr_open,$paras) = @_;
857
858   # Fake it out as a begin/end
859   my $target;
860
861   if(grep $_->[1]{'~ignore'}, @$curr_open) {
862     DEBUG > 1 and print "Ignoring ignorable =for\n";
863     return 1;
864   }
865
866   for(my $i = 2; $i < @$para; ++$i) {
867     if($para->[$i] =~ s/^\s*(\S+)\s*//s) {
868       $target = $1;
869       last;
870     }
871   }
872   unless(defined $target) {
873     $self->whine(
874       $para->[1]{'start_line'},
875       "=for without a target?"
876     );
877     return 1;
878   }
879   DEBUG > 1 and
880    print "Faking out a =for $target as a =begin $target / =end $target\n";
881   
882   $para->[0] = 'Data';
883   
884   unshift @$paras,
885     ['=begin',
886       {'start_line' => $para->[1]{'start_line'}, '~really' => '=for'},
887       $target,
888     ],
889     $para,
890     ['=end',
891       {'start_line' => $para->[1]{'start_line'}, '~really' => '=for'},
892       $target,
893     ],
894   ;
895   
896   return 1;
897 }
898
899 sub _ponder_begin {
900   my ($self,$para,$curr_open,$paras) = @_;
901   my $content = join ' ', splice @$para, 2;
902   $content =~ s/^\s+//s;
903   $content =~ s/\s+$//s;
904   unless(length($content)) {
905     $self->whine(
906       $para->[1]{'start_line'},
907       "=begin without a target?"
908     );
909     DEBUG and print "Ignoring targetless =begin\n";
910     return 1;
911   }
912   
913   my ($target, $title) = $content =~ m/^(\S+)\s*(.*)$/;
914   $para->[1]{'title'} = $title if ($title);
915   $para->[1]{'target'} = $target;  # without any ':'
916   $content = $target; # strip off the title
917
918   $content =~ s/^:!/!:/s;
919   my $neg;  # whether this is a negation-match
920   $neg = 1        if $content =~ s/^!//s;
921   my $to_resolve;  # whether to process formatting codes
922   $to_resolve = 1 if $content =~ s/^://s;
923   
924   my $dont_ignore; # whether this target matches us
925   
926   foreach my $target_name (
927     split(',', $content, -1),
928     $neg ? () : '*'
929   ) {
930     DEBUG > 2 and
931      print " Considering whether =begin $content matches $target_name\n";
932     next unless $self->{'accept_targets'}{$target_name};
933     
934     DEBUG > 2 and
935      print "  It DOES match the acceptable target $target_name!\n";
936     $to_resolve = 1
937       if $self->{'accept_targets'}{$target_name} eq 'force_resolve';
938     $dont_ignore = 1;
939     $para->[1]{'target_matching'} = $target_name;
940     last; # stop looking at other target names
941   }
942
943   if($neg) {
944     if( $dont_ignore ) {
945       $dont_ignore = '';
946       delete $para->[1]{'target_matching'};
947       DEBUG > 2 and print " But the leading ! means that this is a NON-match!\n";
948     } else {
949       $dont_ignore = 1;
950       $para->[1]{'target_matching'} = '!';
951       DEBUG > 2 and print " But the leading ! means that this IS a match!\n";
952     }
953   }
954
955   $para->[0] = '=for';  # Just what we happen to call these, internally
956   $para->[1]{'~really'} ||= '=begin';
957   $para->[1]{'~ignore'}   = (! $dont_ignore) || 0;
958   $para->[1]{'~resolve'}  = $to_resolve || 0;
959
960   DEBUG > 1 and print " Making note to ", $dont_ignore ? 'not ' : '',
961     "ignore contents of this region\n";
962   DEBUG > 1 and $dont_ignore and print " Making note to treat contents as ",
963     ($to_resolve ? 'verbatim/plain' : 'data'), " paragraphs\n";
964   DEBUG > 1 and print " (Stack now: ", $self->_dump_curr_open(), ")\n";
965
966   push @$curr_open, $para;
967   if(!$dont_ignore or scalar grep $_->[1]{'~ignore'}, @$curr_open) {
968     DEBUG > 1 and print "Ignoring ignorable =begin\n";
969   } else {
970     $self->{'content_seen'} ||= 1;
971     $self->_handle_element_start((my $scratch='for'), $para->[1]);
972   }
973
974   return 1;
975 }
976
977 sub _ponder_end {
978   my ($self,$para,$curr_open,$paras) = @_;
979   my $content = join ' ', splice @$para, 2;
980   $content =~ s/^\s+//s;
981   $content =~ s/\s+$//s;
982   DEBUG and print "Ogling '=end $content' directive\n";
983   
984   unless(length($content)) {
985     $self->whine(
986       $para->[1]{'start_line'},
987       "'=end' without a target?" . (
988         ( @$curr_open and $curr_open->[-1][0] eq '=for' )
989         ? ( " (Should be \"=end " . $curr_open->[-1][1]{'target'} . '")' )
990         : ''
991       )
992     );
993     DEBUG and print "Ignoring targetless =end\n";
994     return 1;
995   }
996   
997   unless($content =~ m/^\S+$/) {  # i.e., unless it's one word
998     $self->whine(
999       $para->[1]{'start_line'},
1000       "'=end $content' is invalid.  (Stack: "
1001       . $self->_dump_curr_open() . ')'
1002     );
1003     DEBUG and print "Ignoring mistargetted =end $content\n";
1004     return 1;
1005   }
1006   
1007   unless(@$curr_open and $curr_open->[-1][0] eq '=for') {
1008     $self->whine(
1009       $para->[1]{'start_line'},
1010       "=end $content without matching =begin.  (Stack: "
1011       . $self->_dump_curr_open() . ')'
1012     );
1013     DEBUG and print "Ignoring mistargetted =end $content\n";
1014     return 1;
1015   }
1016   
1017   unless($content eq $curr_open->[-1][1]{'target'}) {
1018     $self->whine(
1019       $para->[1]{'start_line'},
1020       "=end $content doesn't match =begin " 
1021       . $curr_open->[-1][1]{'target'}
1022       . ".  (Stack: "
1023       . $self->_dump_curr_open() . ')'
1024     );
1025     DEBUG and print "Ignoring mistargetted =end $content at line $para->[1]{'start_line'}\n";
1026     return 1;
1027   }
1028
1029   # Else it's okay to close...
1030   if(grep $_->[1]{'~ignore'}, @$curr_open) {
1031     DEBUG > 1 and print "Not firing any event for this =end $content because in an ignored region\n";
1032     # And that may be because of this to-be-closed =for region, or some
1033     #  other one, but it doesn't matter.
1034   } else {
1035     $curr_open->[-1][1]{'start_line'} = $para->[1]{'start_line'};
1036       # what's that for?
1037     
1038     $self->{'content_seen'} ||= 1;
1039     $self->_handle_element_end( my $scratch = 'for' );
1040   }
1041   DEBUG > 1 and print "Popping $curr_open->[-1][0] $curr_open->[-1][1]{'target'} because of =end $content\n";
1042   pop @$curr_open;
1043
1044   return 1;
1045
1046
1047 sub _ponder_doc_end {
1048   my ($self,$para,$curr_open,$paras) = @_;
1049   if(@$curr_open) { # Deal with things left open
1050     DEBUG and print "Stack is nonempty at end-document: (",
1051       $self->_dump_curr_open(), ")\n";
1052       
1053     DEBUG > 9 and print "Stack: ", pretty($curr_open), "\n";
1054     unshift @$paras, $self->_closers_for_all_curr_open;
1055     # Make sure there is exactly one ~end in the parastack, at the end:
1056     @$paras = grep $_->[0] ne '~end', @$paras;
1057     push @$paras, $para, $para;
1058      # We need two -- once for the next cycle where we
1059      #  generate errata, and then another to be at the end
1060      #  when that loop back around to process the errata.
1061     return 1;
1062     
1063   } else {
1064     DEBUG and print "Okay, stack is empty now.\n";
1065   }
1066   
1067   # Try generating errata section, if applicable
1068   unless($self->{'~tried_gen_errata'}) {
1069     $self->{'~tried_gen_errata'} = 1;
1070     my @extras = $self->_gen_errata();
1071     if(@extras) {
1072       unshift @$paras, @extras;
1073       DEBUG and print "Generated errata... relooping...\n";
1074       return 1;  # I.e., loop around again to process these fake-o paragraphs
1075     }
1076   }
1077   
1078   splice @$paras; # Well, that's that for this paragraph buffer.
1079   DEBUG and print "Throwing end-document event.\n";
1080
1081   $self->_handle_element_end( my $scratch = 'Document' );
1082   return 1; # Hasta la byebye
1083 }
1084
1085 sub _ponder_pod {
1086   my ($self,$para,$curr_open,$paras) = @_;
1087   $self->whine(
1088     $para->[1]{'start_line'},
1089     "=pod directives shouldn't be over one line long!  Ignoring all "
1090      . (@$para - 2) . " lines of content"
1091   ) if @$para > 3;
1092   # Content is always ignored.
1093   return;
1094 }
1095
1096 sub _ponder_over {
1097   my ($self,$para,$curr_open,$paras) = @_;
1098   return 1 unless @$paras;
1099   my $list_type;
1100
1101   if($paras->[0][0] eq '=item') { # most common case
1102     $list_type = $self->_get_initial_item_type($paras->[0]);
1103
1104   } elsif($paras->[0][0] eq '=back') {
1105     # Ignore empty lists.  TODO: make this an option?
1106     shift @$paras;
1107     return 1;
1108     
1109   } elsif($paras->[0][0] eq '~end') {
1110     $self->whine(
1111       $para->[1]{'start_line'},
1112       "=over is the last thing in the document?!"
1113     );
1114     return 1; # But feh, ignore it.
1115   } else {
1116     $list_type = 'block';
1117   }
1118   $para->[1]{'~type'} = $list_type;
1119   push @$curr_open, $para;
1120    # yes, we reuse the paragraph as a stack item
1121   
1122   my $content = join ' ', splice @$para, 2;
1123   my $overness;
1124   if($content =~ m/^\s*$/s) {
1125     $para->[1]{'indent'} = 4;
1126   } elsif($content =~ m/^\s*((?:\d*\.)?\d+)\s*$/s) {
1127     no integer;
1128     $para->[1]{'indent'} = $1;
1129     if($1 == 0) {
1130       $self->whine(
1131         $para->[1]{'start_line'},
1132         "Can't have a 0 in =over $content"
1133       );
1134       $para->[1]{'indent'} = 4;
1135     }
1136   } else {
1137     $self->whine(
1138       $para->[1]{'start_line'},
1139       "=over should be: '=over' or '=over positive_number'"
1140     );
1141     $para->[1]{'indent'} = 4;
1142   }
1143   DEBUG > 1 and print "=over found of type $list_type\n";
1144   
1145   $self->{'content_seen'} ||= 1;
1146   $self->_handle_element_start((my $scratch = 'over-' . $list_type), $para->[1]);
1147
1148   return;
1149 }
1150       
1151 sub _ponder_back {
1152   my ($self,$para,$curr_open,$paras) = @_;
1153   # TODO: fire off </item-number> or </item-bullet> or </item-text> ??
1154
1155   my $content = join ' ', splice @$para, 2;
1156   if($content =~ m/\S/) {
1157     $self->whine(
1158       $para->[1]{'start_line'},
1159       "=back doesn't take any parameters, but you said =back $content"
1160     );
1161   }
1162
1163   if(@$curr_open and $curr_open->[-1][0] eq '=over') {
1164     DEBUG > 1 and print "=back happily closes matching =over\n";
1165     # Expected case: we're closing the most recently opened thing
1166     #my $over = pop @$curr_open;
1167     $self->{'content_seen'} ||= 1;
1168     $self->_handle_element_end( my $scratch =
1169       'over-' . ( (pop @$curr_open)->[1]{'~type'} )
1170     );
1171   } else {
1172     DEBUG > 1 and print "=back found without a matching =over.  Stack: (",
1173         join(', ', map $_->[0], @$curr_open), ").\n";
1174     $self->whine(
1175       $para->[1]{'start_line'},
1176       '=back without =over'
1177     );
1178     return 1; # and ignore it
1179   }
1180 }
1181
1182 sub _ponder_item {
1183   my ($self,$para,$curr_open,$paras) = @_;
1184   my $over;
1185   unless(@$curr_open and ($over = $curr_open->[-1])->[0] eq '=over') {
1186     $self->whine(
1187       $para->[1]{'start_line'},
1188       "'=item' outside of any '=over'"
1189     );
1190     unshift @$paras,
1191       ['=over', {'start_line' => $para->[1]{'start_line'}}, ''],
1192       $para
1193     ;
1194     return 1;
1195   }
1196   
1197   
1198   my $over_type = $over->[1]{'~type'};
1199   
1200   if(!$over_type) {
1201     # Shouldn't happen1
1202     die "Typeless over in stack, starting at line "
1203      . $over->[1]{'start_line'};
1204
1205   } elsif($over_type eq 'block') {
1206     unless($curr_open->[-1][1]{'~bitched_about'}) {
1207       $curr_open->[-1][1]{'~bitched_about'} = 1;
1208       $self->whine(
1209         $curr_open->[-1][1]{'start_line'},
1210         "You can't have =items (as at line "
1211         . $para->[1]{'start_line'}
1212         . ") unless the first thing after the =over is an =item"
1213       );
1214     }
1215     # Just turn it into a paragraph and reconsider it
1216     $para->[0] = '~Para';
1217     unshift @$paras, $para;
1218     return 1;
1219
1220   } elsif($over_type eq 'text') {
1221     my $item_type = $self->_get_item_type($para);
1222       # That kills the content of the item if it's a number or bullet.
1223     DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
1224     
1225     if($item_type eq 'text') {
1226       # Nothing special needs doing for 'text'
1227     } elsif($item_type eq 'number' or $item_type eq 'bullet') {
1228       die "Unknown item type $item_type"
1229        unless $item_type eq 'number' or $item_type eq 'bullet';
1230       # Undo our clobbering:
1231       push @$para, $para->[1]{'~orig_content'};
1232       delete $para->[1]{'number'};
1233        # Only a PROPER item-number element is allowed
1234        #  to have a number attribute.
1235     } else {
1236       die "Unhandled item type $item_type"; # should never happen
1237     }
1238     
1239     # =item-text thingies don't need any assimilation, it seems.
1240
1241   } elsif($over_type eq 'number') {
1242     my $item_type = $self->_get_item_type($para);
1243       # That kills the content of the item if it's a number or bullet.
1244     DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
1245     
1246     my $expected_value = ++ $curr_open->[-1][1]{'~counter'};
1247     
1248     if($item_type eq 'bullet') {
1249       # Hm, it's not numeric.  Correct for this.
1250       $para->[1]{'number'} = $expected_value;
1251       $self->whine(
1252         $para->[1]{'start_line'},
1253         "Expected '=item $expected_value'"
1254       );
1255       push @$para, $para->[1]{'~orig_content'};
1256         # restore the bullet, blocking the assimilation of next para
1257
1258     } elsif($item_type eq 'text') {
1259       # Hm, it's not numeric.  Correct for this.
1260       $para->[1]{'number'} = $expected_value;
1261       $self->whine(
1262         $para->[1]{'start_line'},
1263         "Expected '=item $expected_value'"
1264       );
1265       # Text content will still be there and will block next ~Para
1266
1267     } elsif($item_type ne 'number') {
1268       die "Unknown item type $item_type"; # should never happen
1269
1270     } elsif($expected_value == $para->[1]{'number'}) {
1271       DEBUG > 1 and print " Numeric item has the expected value of $expected_value\n";
1272       
1273     } else {
1274       DEBUG > 1 and print " Numeric item has ", $para->[1]{'number'},
1275        " instead of the expected value of $expected_value\n";
1276       $self->whine(
1277         $para->[1]{'start_line'},
1278         "You have '=item " . $para->[1]{'number'} .
1279         "' instead of the expected '=item $expected_value'"
1280       );
1281       $para->[1]{'number'} = $expected_value;  # correcting!!
1282     }
1283       
1284     if(@$para == 2) {
1285       # For the cases where we /didn't/ push to @$para
1286       if($paras->[0][0] eq '~Para') {
1287         DEBUG and print "Assimilating following ~Para content into $over_type item\n";
1288         push @$para, splice @{shift @$paras},2;
1289       } else {
1290         DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
1291         push @$para, '';  # Just so it's not contentless
1292       }
1293     }
1294
1295
1296   } elsif($over_type eq 'bullet') {
1297     my $item_type = $self->_get_item_type($para);
1298       # That kills the content of the item if it's a number or bullet.
1299     DEBUG and print " Item is of type ", $para->[0], " under $over_type\n";
1300     
1301     if($item_type eq 'bullet') {
1302       # as expected!
1303
1304       if( $para->[1]{'~_freaky_para_hack'} ) {
1305         DEBUG and print "Accomodating '=item * Foo' tolerance hack.\n";
1306         push @$para, delete $para->[1]{'~_freaky_para_hack'};
1307       }
1308
1309     } elsif($item_type eq 'number') {
1310       $self->whine(
1311         $para->[1]{'start_line'},
1312         "Expected '=item *'"
1313       );
1314       push @$para, $para->[1]{'~orig_content'};
1315        # and block assimilation of the next paragraph
1316       delete $para->[1]{'number'};
1317        # Only a PROPER item-number element is allowed
1318        #  to have a number attribute.
1319     } elsif($item_type eq 'text') {
1320       $self->whine(
1321         $para->[1]{'start_line'},
1322         "Expected '=item *'"
1323       );
1324        # But doesn't need processing.  But it'll block assimilation
1325        #  of the next para.
1326     } else {
1327       die "Unhandled item type $item_type"; # should never happen
1328     }
1329
1330     if(@$para == 2) {
1331       # For the cases where we /didn't/ push to @$para
1332       if($paras->[0][0] eq '~Para') {
1333         DEBUG and print "Assimilating following ~Para content into $over_type item\n";
1334         push @$para, splice @{shift @$paras},2;
1335       } else {
1336         DEBUG and print "Can't assimilate following ", $paras->[0][0], "\n";
1337         push @$para, '';  # Just so it's not contentless
1338       }
1339     }
1340
1341   } else {
1342     die "Unhandled =over type \"$over_type\"?";
1343     # Shouldn't happen!
1344   }
1345   $para->[0] .= '-' . $over_type;
1346
1347   return;
1348 }
1349
1350 sub _ponder_Plain {
1351   my ($self,$para) = @_;
1352   DEBUG and print " giving plain treatment...\n";
1353   unless( @$para == 2 or ( @$para == 3 and $para->[2] eq '' )
1354     or $para->[1]{'~cooked'}
1355   ) {
1356     push @$para,
1357     @{$self->_make_treelet(
1358       join("\n", splice(@$para, 2)),
1359       $para->[1]{'start_line'}
1360     )};
1361   }
1362   # Empty paragraphs don't need a treelet for any reason I can see.
1363   # And precooked paragraphs already have a treelet.
1364   return;
1365 }
1366
1367 sub _ponder_Verbatim {
1368   my ($self,$para) = @_;
1369   DEBUG and print " giving verbatim treatment...\n";
1370
1371   $para->[1]{'xml:space'} = 'preserve';
1372   for(my $i = 2; $i < @$para; $i++) {
1373     foreach my $line ($para->[$i]) { # just for aliasing
1374       while( $line =~
1375         # Sort of adapted from Text::Tabs -- yes, it's hardwired in that
1376         # tabs are at every EIGHTH column.  For portability, it has to be
1377         # one setting everywhere, and 8th wins.
1378         s/^([^\t]*)(\t+)/$1.(" " x ((length($2)<<3)-(length($1)&7)))/e
1379       ) {}
1380
1381       # TODO: whinge about (or otherwise treat) unindented or overlong lines
1382
1383     }
1384   }
1385   
1386   # Now the VerbatimFormatted hoodoo...
1387   if( $self->{'accept_codes'} and
1388       $self->{'accept_codes'}{'VerbatimFormatted'}
1389   ) {
1390     while(@$para > 3 and $para->[-1] !~ m/\S/) { pop @$para }
1391      # Kill any number of terminal newlines
1392     $self->_verbatim_format($para);
1393   } elsif ($self->{'codes_in_verbatim'}) {
1394     push @$para,
1395     @{$self->_make_treelet(
1396       join("\n", splice(@$para, 2)),
1397       $para->[1]{'start_line'}, $para->[1]{'xml:space'}
1398     )};
1399     $para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines
1400   } else {
1401     push @$para, join "\n", splice(@$para, 2) if @$para > 3;
1402     $para->[-1] =~ s/\n+$//s; # Kill any number of terminal newlines
1403   }
1404   return;
1405 }
1406
1407 sub _ponder_Data {
1408   my ($self,$para) = @_;
1409   DEBUG and print " giving data treatment...\n";
1410   $para->[1]{'xml:space'} = 'preserve';
1411   push @$para, join "\n", splice(@$para, 2) if @$para > 3;
1412   return;
1413 }
1414
1415
1416
1417
1418 ###########################################################################
1419
1420 sub _traverse_treelet_bit {  # for use only by the routine above
1421   my($self, $name) = splice @_,0,2;
1422
1423   my $scratch;
1424   $self->_handle_element_start(($scratch=$name), shift @_);
1425   
1426   foreach my $x (@_) {
1427     if(ref($x)) {
1428       &_traverse_treelet_bit($self, @$x);
1429     } else {
1430       $self->_handle_text($x);
1431     }
1432   }
1433   
1434   $self->_handle_element_end($scratch=$name);
1435   return;
1436 }
1437
1438 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1439
1440 sub _closers_for_all_curr_open {
1441   my $self = $_[0];
1442   my @closers;
1443   foreach my $still_open (@{  $self->{'curr_open'} || return  }) {
1444     my @copy = @$still_open;
1445     $copy[1] = {%{ $copy[1] }};
1446     #$copy[1]{'start_line'} = -1;
1447     if($copy[0] eq '=for') {
1448       $copy[0] = '=end';
1449     } elsif($copy[0] eq '=over') {
1450       $copy[0] = '=back';
1451     } else {
1452       die "I don't know how to auto-close an open $copy[0] region";
1453     }
1454
1455     unless( @copy > 2 ) {
1456       push @copy, $copy[1]{'target'};
1457       $copy[-1] = '' unless defined $copy[-1];
1458        # since =over's don't have targets
1459     }
1460     
1461     DEBUG and print "Queuing up fake-o event: ", pretty(\@copy), "\n";
1462     unshift @closers, \@copy;
1463   }
1464   return @closers;
1465 }
1466
1467 #--------------------------------------------------------------------------
1468
1469 sub _verbatim_format {
1470   my($it, $p) = @_;
1471   
1472   my $formatting;
1473
1474   for(my $i = 2; $i < @$p; $i++) { # work backwards over the lines
1475     DEBUG and print "_verbatim_format appends a newline to $i: $p->[$i]\n";
1476     $p->[$i] .= "\n";
1477      # Unlike with simple Verbatim blocks, we don't end up just doing
1478      # a join("\n", ...) on the contents, so we have to append a
1479      # newline to ever line, and then nix the last one later.
1480   }
1481
1482   if( DEBUG > 4 ) {
1483     print "<<\n";
1484     for(my $i = $#$p; $i >= 2; $i--) { # work backwards over the lines
1485       print "_verbatim_format $i: $p->[$i]";
1486     }
1487     print ">>\n";
1488   }
1489
1490   for(my $i = $#$p; $i > 2; $i--) {
1491     # work backwards over the lines, except the first (#2)
1492     
1493     #next unless $p->[$i]   =~ m{^#:([ \^\/\%]*)\n?$}s
1494     #        and $p->[$i-1] !~ m{^#:[ \^\/\%]*\n?$}s;
1495      # look at a formatty line preceding a nonformatty one
1496     DEBUG > 5 and print "Scrutinizing line $i: $$p[$i]\n";
1497     if($p->[$i]   =~ m{^#:([ \^\/\%]*)\n?$}s) {
1498       DEBUG > 5 and print "  It's a formatty line.  ",
1499        "Peeking at previous line ", $i-1, ": $$p[$i-1]: \n";
1500       
1501       if( $p->[$i-1] =~ m{^#:[ \^\/\%]*\n?$}s ) {
1502         DEBUG > 5 and print "  Previous line is formatty!  Skipping this one.\n";
1503         next;
1504       } else {
1505         DEBUG > 5 and print "  Previous line is non-formatty!  Yay!\n";
1506       }
1507     } else {
1508       DEBUG > 5 and print "  It's not a formatty line.  Ignoring\n";
1509       next;
1510     }
1511
1512     # A formatty line has to have #: in the first two columns, and uses
1513     # "^" to mean bold, "/" to mean underline, and "%" to mean bold italic.
1514     # Example:
1515     #   What do you want?  i like pie. [or whatever]
1516     # #:^^^^^^^^^^^^^^^^^              /////////////         
1517     
1518
1519     DEBUG > 4 and print "_verbatim_format considers:\n<$p->[$i-1]>\n<$p->[$i]>\n";
1520     
1521     $formatting = '  ' . $1;
1522     $formatting =~ s/\s+$//s; # nix trailing whitespace
1523     unless(length $formatting and $p->[$i-1] =~ m/\S/) { # no-op
1524       splice @$p,$i,1; # remove this line
1525       $i--; # don't consider next line
1526       next;
1527     }
1528
1529     if( length($formatting) >= length($p->[$i-1]) ) {
1530       $formatting = substr($formatting, 0, length($p->[$i-1]) - 1) . ' ';
1531     } else {
1532       $formatting .= ' ' x (length($p->[$i-1]) - length($formatting));
1533     }
1534     # Make $formatting and the previous line be exactly the same length,
1535     # with $formatting having a " " as the last character.
1536  
1537     DEBUG > 4 and print "Formatting <$formatting>    on <", $p->[$i-1], ">\n";
1538
1539
1540     my @new_line;
1541     while( $formatting =~ m{\G(( +)|(\^+)|(\/+)|(\%+))}g ) {
1542       #print "Format matches $1\n";
1543
1544       if($2) {
1545         #print "SKIPPING <$2>\n";
1546         push @new_line,
1547           substr($p->[$i-1], pos($formatting)-length($1), length($1));
1548       } else {
1549         #print "SNARING $+\n";
1550         push @new_line, [
1551           (
1552             $3 ? 'VerbatimB'  :
1553             $4 ? 'VerbatimI'  :
1554             $5 ? 'VerbatimBI' : die("Should never get called")
1555           ), {},
1556           substr($p->[$i-1], pos($formatting)-length($1), length($1))
1557         ];
1558         #print "Formatting <$new_line[-1][-1]> as $new_line[-1][0]\n";
1559       }
1560     }
1561     my @nixed =    
1562       splice @$p, $i-1, 2, @new_line; # replace myself and the next line
1563     DEBUG > 10 and print "Nixed count: ", scalar(@nixed), "\n";
1564     
1565     DEBUG > 6 and print "New version of the above line is these tokens (",
1566       scalar(@new_line), "):",
1567       map( ref($_)?"<@$_> ":"<$_>", @new_line ), "\n";
1568     $i--; # So the next line we scrutinize is the line before the one
1569           #  that we just went and formatted
1570   }
1571
1572   $p->[0] = 'VerbatimFormatted';
1573
1574   # Collapse adjacent text nodes, just for kicks.
1575   for( my $i = 2; $i > $#$p; $i++ ) { # work forwards over the tokens except for the last
1576     if( !ref($p->[$i]) and !ref($p->[$i + 1]) ) {
1577       DEBUG > 5 and print "_verbatim_format merges {$p->[$i]} and {$p->[$i+1]}\n";
1578       $p->[$i] .= splice @$p, $i+1, 1; # merge
1579       --$i;  # and back up
1580     }
1581   }
1582
1583   # Now look for the last text token, and remove the terminal newline
1584   for( my $i = $#$p; $i >= 2; $i-- ) {
1585     # work backwards over the tokens, even the first
1586     if( !ref($p->[$i]) ) {
1587       if($p->[$i] =~ s/\n$//s) {
1588         DEBUG > 5 and print "_verbatim_format killed the terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]}\n";
1589       } else {
1590         DEBUG > 5 and print
1591          "No terminal newline on #$i: {$p->[$i]}, after {$p->[$i-1]} !?\n";
1592       }
1593       last; # we only want the next one
1594     }
1595   }
1596
1597   return;
1598 }
1599
1600
1601 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1602
1603
1604 sub _treelet_from_formatting_codes {
1605   # Given a paragraph, returns a treelet.  Full of scary tokenizing code.
1606   #  Like [ '~Top', {'start_line' => $start_line},
1607   #            "I like ",
1608   #            [ 'B', {}, "pie" ],
1609   #            "!"
1610   #       ]
1611   
1612   my($self, $para, $start_line, $preserve_space) = @_;
1613   
1614   my $treelet = ['~Top', {'start_line' => $start_line},];
1615   
1616   unless ($preserve_space || $self->{'preserve_whitespace'}) {
1617     $para =~ s/\.  /\.\xA0 /g if $self->{'fullstop_space_harden'};
1618   
1619     $para =~ s/\s+/ /g; # collapse and trim all whitespace first.
1620     $para =~ s/ $//;
1621     $para =~ s/^ //;
1622   }
1623   
1624   # Only apparent problem the above code is that N<<  >> turns into
1625   # N<< >>.  But then, word wrapping does that too!  So don't do that!
1626   
1627   my @stack;
1628   my @lineage = ($treelet);
1629
1630   DEBUG > 4 and print "Paragraph:\n$para\n\n";
1631  
1632   # Here begins our frightening tokenizer RE.  The following regex matches
1633   # text in four main parts:
1634   #
1635   #  * Start-codes.  The first alternative matches C< or C<<, the latter
1636   #    followed by some whitespace.  $1 will hold the entire start code
1637   #    (including any space following a multiple-angle-bracket delimiter),
1638   #    and $2 will hold only the additional brackets past the first in a
1639   #    multiple-bracket delimiter.  length($2) + 1 will be the number of
1640   #    closing brackets we have to find.
1641   #
1642   #  * Closing brackets.  Match some amount of whitespace followed by
1643   #    multiple close brackets.  The logic to see if this closes anything
1644   #    is down below.  Note that in order to parse C<<  >> correctly, we
1645   #    have to use look-behind (?<=\s\s), since the match of the starting
1646   #    code will have consumed the whitespace.
1647   #
1648   #  * A single closing bracket, to close a simple code like C<>.
1649   #
1650   #  * Something that isn't a start or end code.  We have to be careful
1651   #    about accepting whitespace, since perlpodspec says that any whitespace
1652   #    before a multiple-bracket closing delimiter should be ignored.
1653   #
1654   while($para =~
1655     m/\G
1656       (?:
1657         # Match starting codes, including the whitespace following a
1658         # multiple-delimiter start code.  $1 gets the whole start code and
1659         # $2 gets all but one of the <s in the multiple-bracket case.
1660         ([A-Z]<(?:(<+)\s+)?)
1661         |
1662         # Match multiple-bracket end codes.  $3 gets the whitespace that
1663         # should be discarded before an end bracket but kept in other cases
1664         # and $4 gets the end brackets themselves.
1665         (\s+|(?<=\s\s))(>{2,})
1666         |
1667         (\s?>)          # $5: simple end-codes
1668         |
1669         (               # $6: stuff containing no start-codes or end-codes
1670           (?:
1671             [^A-Z\s>]
1672             |
1673             (?:
1674               [A-Z](?!<)
1675             )
1676             |
1677             # whitespace is ok, but we don't want to eat the whitespace before
1678             # a multiple-bracket end code.
1679             # NOTE: we may still have problems with e.g. S<<    >>
1680             (?:
1681               \s(?!\s*>{2,})
1682             )
1683           )+
1684         )
1685       )
1686     /xgo
1687   ) {
1688     DEBUG > 4 and print "\nParagraphic tokenstack = (@stack)\n";
1689     if(defined $1) {
1690       if(defined $2) {
1691         DEBUG > 3 and print "Found complex start-text code \"$1\"\n";
1692         push @stack, length($2) + 1; 
1693           # length of the necessary complex end-code string
1694       } else {
1695         DEBUG > 3 and print "Found simple start-text code \"$1\"\n";
1696         push @stack, 0;  # signal that we're looking for simple
1697       }
1698       push @lineage, [ substr($1,0,1), {}, ];  # new node object
1699       push @{ $lineage[-2] }, $lineage[-1];
1700       
1701     } elsif(defined $4) {
1702       DEBUG > 3 and print "Found apparent complex end-text code \"$3$4\"\n";
1703       # This is where it gets messy...
1704       if(! @stack) {
1705         # We saw " >>>>" but needed nothing.  This is ALL just stuff then.
1706         DEBUG > 4 and print " But it's really just stuff.\n";
1707         push @{ $lineage[-1] }, $3, $4;
1708         next;
1709       } elsif(!$stack[-1]) {
1710         # We saw " >>>>" but needed only ">".  Back pos up.
1711         DEBUG > 4 and print " And that's more than we needed to close simple.\n";
1712         push @{ $lineage[-1] }, $3; # That was a for-real space, too.
1713         pos($para) = pos($para) - length($4) + 1;
1714       } elsif($stack[-1] == length($4)) {
1715         # We found " >>>>", and it was exactly what we needed.  Commonest case.
1716         DEBUG > 4 and print " And that's exactly what we needed to close complex.\n";
1717       } elsif($stack[-1] < length($4)) {
1718         # We saw " >>>>" but needed only " >>".  Back pos up.
1719         DEBUG > 4 and print " And that's more than we needed to close complex.\n";
1720         pos($para) = pos($para) - length($4) + $stack[-1];
1721       } else {
1722         # We saw " >>>>" but needed " >>>>>>".  So this is all just stuff!
1723         DEBUG > 4 and print " But it's really just stuff, because we needed more.\n";
1724         push @{ $lineage[-1] }, $3, $4;
1725         next;
1726       }
1727       #print "\nHOOBOY ", scalar(@{$lineage[-1]}), "!!!\n";
1728
1729       push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] };
1730       # Keep the element from being childless
1731       
1732       pop @stack;
1733       pop @lineage;
1734       
1735     } elsif(defined $5) {
1736       DEBUG > 3 and print "Found apparent simple end-text code \"$4\"\n";
1737
1738       if(@stack and ! $stack[-1]) {
1739         # We're indeed expecting a simple end-code
1740         DEBUG > 4 and print " It's indeed an end-code.\n";
1741
1742         if(length($5) == 2) { # There was a space there: " >"
1743           push @{ $lineage[-1] }, ' ';
1744         } elsif( 2 == @{ $lineage[-1] } ) { # Closing a childless element
1745           push @{ $lineage[-1] }, ''; # keep it from being really childless
1746         }
1747
1748         pop @stack;
1749         pop @lineage;
1750       } else {
1751         DEBUG > 4 and print " It's just stuff.\n";
1752         push @{ $lineage[-1] }, $5;
1753       }
1754
1755     } elsif(defined $6) {
1756       DEBUG > 3 and print "Found stuff \"$6\"\n";
1757       push @{ $lineage[-1] }, $6;
1758       
1759     } else {
1760       # should never ever ever ever happen
1761       DEBUG and print "AYYAYAAAAA at line ", __LINE__, "\n";
1762       die "SPORK 512512!";
1763     }
1764   }
1765
1766   if(@stack) { # Uhoh, some sequences weren't closed.
1767     my $x= "...";
1768     while(@stack) {
1769       push @{ $lineage[-1] }, '' if 2 == @{ $lineage[-1] };
1770       # Hmmmmm!
1771
1772       my $code         = (pop @lineage)->[0];
1773       my $ender_length =  pop @stack;
1774       if($ender_length) {
1775         --$ender_length;
1776         $x = $code . ("<" x $ender_length) . " $x " . (">" x $ender_length);
1777       } else {
1778         $x = $code . "<$x>";
1779       }
1780     }
1781     DEBUG > 1 and print "Unterminated $x sequence\n";
1782     $self->whine($start_line,
1783       "Unterminated $x sequence",
1784     );
1785   }
1786   
1787   return $treelet;
1788 }
1789
1790 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1791
1792 sub text_content_of_treelet {  # method: $parser->text_content_of_treelet($lol)
1793   return stringify_lol($_[1]);
1794 }
1795
1796 sub stringify_lol {  # function: stringify_lol($lol)
1797   my $string_form = '';
1798   _stringify_lol( $_[0] => \$string_form );
1799   return $string_form;
1800 }
1801
1802 sub _stringify_lol {  # the real recursor
1803   my($lol, $to) = @_;
1804   use UNIVERSAL ();
1805   for(my $i = 2; $i < @$lol; ++$i) {
1806     if( ref($lol->[$i] || '') and UNIVERSAL::isa($lol->[$i], 'ARRAY') ) {
1807       _stringify_lol( $lol->[$i], $to);  # recurse!
1808     } else {
1809       $$to .= $lol->[$i];
1810     }
1811   }
1812   return;
1813 }
1814
1815 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1816
1817 sub _dump_curr_open { # return a string representation of the stack
1818   my $curr_open = $_[0]{'curr_open'};
1819
1820   return '[empty]' unless @$curr_open;
1821   return join '; ',
1822     map {;
1823            ($_->[0] eq '=for')
1824              ? ( ($_->[1]{'~really'} || '=over')
1825                . ' ' . $_->[1]{'target'})
1826              : $_->[0]
1827         }
1828     @$curr_open
1829   ;
1830 }
1831
1832 ###########################################################################
1833 my %pretty_form = (
1834   "\a" => '\a', # ding!
1835   "\b" => '\b', # BS
1836   "\e" => '\e', # ESC
1837   "\f" => '\f', # FF
1838   "\t" => '\t', # tab
1839   "\cm" => '\cm',
1840   "\cj" => '\cj',
1841   "\n" => '\n', # probably overrides one of either \cm or \cj
1842   '"' => '\"',
1843   '\\' => '\\\\',
1844   '$' => '\\$',
1845   '@' => '\\@',
1846   '%' => '\\%',
1847   '#' => '\\#',
1848 );
1849
1850 sub pretty { # adopted from Class::Classless
1851   # Not the most brilliant routine, but passable.
1852   # Don't give it a cyclic data structure!
1853   my @stuff = @_; # copy
1854   my $x;
1855   my $out =
1856     # join ",\n" .
1857     join ", ",
1858     map {;
1859     if(!defined($_)) {
1860       "undef";
1861     } elsif(ref($_) eq 'ARRAY' or ref($_) eq 'Pod::Simple::LinkSection') {
1862       $x = "[ " . pretty(@$_) . " ]" ;
1863       $x;
1864     } elsif(ref($_) eq 'SCALAR') {
1865       $x = "\\" . pretty($$_) ;
1866       $x;
1867     } elsif(ref($_) eq 'HASH') {
1868       my $hr = $_;
1869       $x = "{" . join(", ",
1870         map(pretty($_) . '=>' . pretty($hr->{$_}),
1871             sort keys %$hr ) ) . "}" ;
1872       $x;
1873     } elsif(!length($_)) { q{''} # empty string
1874     } elsif(
1875       $_ eq '0' # very common case
1876       or(
1877          m/^-?(?:[123456789]\d*|0)(?:\.\d+)?$/s
1878          and $_ ne '-0' # the strange case that that RE lets thru
1879       )
1880     ) { $_;
1881     } else {
1882       if( chr(65) eq 'A' ) {
1883         s<([^\x20\x21\x23\x27-\x3F\x41-\x5B\x5D-\x7E])>
1884          #<$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg;
1885          <$pretty_form{$1} || '\\x{'.sprintf("%x", ord($1)).'}'>eg;
1886       } else {
1887         # We're in some crazy non-ASCII world!
1888         s<([^abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])>
1889          #<$pretty_form{$1} || '\\x'.(unpack("H2",$1))>eg;
1890          <$pretty_form{$1} || '\\x{'.sprintf("%x", ord($1)).'}'>eg;
1891       }
1892       qq{"$_"};
1893     }
1894   } @stuff;
1895   # $out =~ s/\n */ /g if length($out) < 75;
1896   return $out;
1897 }
1898
1899 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1900
1901 # A rather unsubtle method of blowing away all the state information
1902 # from a parser object so it can be reused. Provided as a utility for
1903 # backward compatibilty in Pod::Man, etc. but not recommended for
1904 # general use.
1905
1906 sub reinit {
1907   my $self = shift;
1908   foreach (qw(source_dead source_filename doc_has_started
1909 start_of_pod_block content_seen last_was_blank paras curr_open
1910 line_count pod_para_count in_pod ~tried_gen_errata errata errors_seen
1911 Title)) {
1912
1913     delete $self->{$_};
1914   }
1915 }
1916
1917 #@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
1918 1;
1919