setext

来自「nedit 是一款linux下的开发源码的功能强大的编辑器」· 代码 · 共 1,890 行 · 第 1/5 页

    elsif( $make_title_href ) { 
        /$title_tt/ && ( $target = $2 );
        $target =~ s/$trim_spaces/$2/o;
        $target =~ s/ /_/go;
    }

    if( $target ) {
        print CONVERT "<A NAME=\"$target\"></A>\n";
        
        # only one target-tt reference of this kind allowed per file.
        ($index = is_member( $target, \@nm_ref )) 
            && do{ splice( @nm_ref, $index-1, 1 ); };
    }
}

#-------------------------------------------------------------------------------

sub is_member
{
    $item      = shift;
    $this_list = shift;
    my $index  = 1;
    
    foreach $member ( @$this_list )
    {
        if( $item eq $member )
        {
            return $index;
        }
        $index++;
    }
    
    return 0;
}

#-------------------------------------------------------------------------------

sub replace_underlines
{
    my $pattern = shift;
    s#$pattern#($text = $1) =~ s,_, ,go; $text; #eg;
}

#-------------------------------------------------------------------------------

sub reclaim_escapes
{
    #-----------------------------------------
    # Put back any escaped characters in text.
    #-----------------------------------------
    while( /$escapedFound/ )
    {
        $subChar = chr( $1 );
        s/$escapedFound/$escape_tt$subChar/;
    }
}

#-------------------------------------------------------------------------------

sub recover_extractions
{
    my $element;

    #------------------------------------
    # Replace escaped characters in text.
    #------------------------------------
    while( /$escapedFound/ )
    {
        $subChar = chr( $1 );
        s/$escapedFound/$subChar/;
    }

    foreach $element ( @untouchable )   { s/$um/$element/; }
    @untouchable = ();
}

#-------------------------------------------------------------------------------

sub emit_paragraph
{
    my $paragraph = shift;
    my $line = $left_margin;
    
    @words = split ' ', $paragraph;

    #-------------------------------------------------------------
    # Flow words onto a line up until the right margin is reached.
    #-------------------------------------------------------------
    foreach $word ( @words )
    {
        if( length( $line ) + length( $word ) + 1 <= $right_margin )
        {
            $line = "$line$word ";
        }
        else
        {
            print CONVERT "$line\n";
            $line = "$left_margin$word ";
        }
    }
    
    #--------------------
    # emit any remainder.
    #--------------------
    print CONVERT "$line\n" if( length( $line ) > length( $left_margin ) );
}

#-------------------------------------------------------------------------------

# This routine is used to override program defaults for HTML settings.
# Two variables are expected to be defined; $htmlHeader and $htmlFooter

sub getHtmlAttributes
{
    my $attrFile = shift;
    
    if( $attrFile )
    {
        unless( $return = do $attrFile )
        {
            warn "Could not parse $attrFile: $@" if $@;
            warn "Could not do $attrFile: $!" unless defined $return;
            warn "Could not run $attrFile" unless $return;
            exit 1;
        }
    }
}

#-------------------------------------------------------------------------------
#                setext to text conversion call-back routines.
#                         ( in alphabetical order )
#-------------------------------------------------------------------------------

sub text_bold_tt      { s/$bold_tt/$1$2/g }

#-------------------------------------------------------------------------------

sub text_bullet_tt
{
    #   don't do anything if this is no bulleted line.
    if (/$bullet_tt/)
    {
        #   remove lead-in from paragraph and put the rest in an array
        my $paragraph = $_;
        $paragraph =~ s/$bullet_tt/$1/;
        @words = split ' ', $paragraph;
        $paragraph = "";
        
        #   start with text mode bullet character
        my $line = '    * ';
        foreach $word (@words)
        {
            if (length($line) + length($word) + 1 <= $right_margin)
            {
                #   put every word in a line if there's still room
                $line = "$line$word ";
            } else
            {
                #   append line to paragraph if full and start a new line
                $paragraph = "$paragraph$line\n";
                $line = "      $word ";
            }
        }
        #   get last line
        $paragraph = "$paragraph$line";

        #   remove trailing white space
        $paragraph =~ s/\s$//;
        $_ = $paragraph;
    }
}

#-------------------------------------------------------------------------------

sub text_emit_line
{
    if( /$passthru_tt/ )
    {
        s/$passthru_tt//o;  # remove typotag and pass line out as is.
        reclaim_escapes();
        print CONVERT "$_\n";
    }
    else
    {
        #-----------------------------
        # Handling nested lists first.
        #-----------------------------
        if( $list_level )
        {
            my $pad = " " x ($list_level * $listIndent);
            my $bullet = ($atListStart) ? "$bullet_list[$list_level] " : "  ";
            s/^\s*/  $pad$bullet/;
            $atListStart = 0;
        }
        elsif( $crnt_state ne $FMT && $text_unfolded_line ne "" )
        {
            emit_paragraph( &text_finishing($text_unfolded_line) );
            $text_unfolded_line = "";
        }

        #-------------------------------------------
        # This keeps extra newlines from popping out
        # when a list has been terminated.
        #-------------------------------------------
        unless( $terminatedList )
        {
            print CONVERT &text_finishing( $_ ), "\n" unless $_ eq $indentingMode;
        }
        else
        {
            $terminatedList = 0;
        }
    }
}

#-------------------------------------------------------------------------------

sub text_final { emit_paragraph( &text_finishing($text_unfolded_line) ) }

#-------------------------------------------------------------------------------

sub text_finishing
{
    local($_) = @_;
    recover_extractions();
    $_;
}

#-------------------------------------------------------------------------------

sub text_hot_tt
{
    if ( /$hot_tt/ ) {
	#---------------------------------------------------------
	# The heuristic to prevent Internet addresses from having
	# underlines removed, is to check for an '@' character.
	#---------------------------------------------------------
	if (($text = $1) !~ /\@/ ) {
	    $text =~ s/_/ /g;
	}
	s/$hot_tt/$text/;
    }
}

#-------------------------------------------------------------------------------

sub text_indent
{ 
    s/$indent_tt/$1/o && do {
        $text_unfolded_line = "$text_unfolded_line$_ ";
        $_ = $indentingMode;
    };
}

#-------------------------------------------------------------------------------

sub text_init         
{ 
    %state_change = ();
    $text_unfolded_line = ""; # to be used by text_indent & text_emit_line
    $left_margin   = "  ";    # for emit_paragraph
    $right_margin  = 79;      # for emit_paragraph
    $indentingMode = "?#.";   # hopefully unique string not normally found
    
    #----------------------------------------------------------------
    # Take all the titles, capitalize and remove title indicator.
    #----------------------------------------------------------------
    for ($i = 0; $i <= $#data; $i++) 
    {
        $_ = $data[$i];                 # $_ is default for searches

        (/$title_tt/ or /$subtitle_tt/) && do {
            $titleType = ( /$title_tt/ ) ? "=" : "-";
            $data[$i--] = "..";       # suppress title indicator ( --- or === )
            $data[$i]   =~ s/^\s*//o; # get rid of any leading space.
            $this_title = $data[$i];

            # Have to fix title if it also happens to be a target-tt.
            $this_title =~ /$target_tt/ && do { ($tmp = $4) =~ s,_, ,go; $this_title = $tmp };
            $data[$i] = "..$titleType \U$this_title";
        };
    }

    #----------------------------------------------------
    # NOTE: changing original subtitle-tt search pattern
    #       to match what was done above.
    #----------------------------------------------------
    $subtitle_tt = "^\\.\\.- (.*)";
    $title_tt    = "^\\.\\.= (.*)";
}

#-------------------------------------------------------------------------------

sub text_italic_tt    { s/$italic_tt/$1/g }

#-------------------------------------------------------------------------------

sub text_line_break
{
    my $fold = shift;
    emit_paragraph( &text_finishing($text_unfolded_line) );
    $text_unfolded_line = "";
    print CONVERT "\n" unless $fold++;
    return $fold;
}

#-------------------------------------------------------------------------------

sub text_line_tt      { }

#-------------------------------------------------------------------------------

sub text_list_tt
{
    if( /$list_tt/o )
    {
        if ( $1 eq '(' )
        {
            $list_level++;
            s/$list_tt\s*//;
            $atListStart = 1;
        }
        else
        {
            $list_level--;
            s/$list_tt//;
            $terminatedList = 1;
        }
    }
    
    #-----------------------------------------------------
    # An empty line terminates a multiple line list entry.
    #-----------------------------------------------------
    elsif( /$empty_line/o )
    {
        print CONVERT "\n";
        #text_line_break( 0 );
        $atListStart = 1 if $list_level;
    }
}

#-------------------------------------------------------------------------------

sub text_quote_tt     { }

#-------------------------------------------------------------------------------

sub text_section_tt
{
    my $hdr_level = shift;

    s/$section_tt//;
    print CONVERT "\n  \U$_\n" if $hdr_level <= 3;  # converted to uppercase
    print CONVERT "\n  $_\n" if $hdr_level > 3;     # left alone
}


#-------------------------------------------------------------------------------

sub text_target_tt 
{
    s#$target_tt#($text = $4) =~ s,_, ,go; " $text"; #eg;
}

#-------------------------------------------------------------------------------

sub text_title
{
    my $size;
    my $line = "";
    my $lc = substr( $_, 2, 1 );
    
    #-----------------------------------------------------------------
    # Incoming text looks like ..= <title text> or ..- <subtitle text>
    #-----------------------------------------------------------------
    to_state( $FMT ); 
    $_ = substr( $_, 4 );
    text_target_tt();