setext

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

    my ( $field, $variable, $flen, $floc, $front, $back, $v_name, $v_value );
    my @variable_list = ();

    #------------------------------------------
    # Mark all the escaped character sequences.
    #------------------------------------------
    while( /$needEscaping/o )
    {
        $subChar = ord( $1 );
        s/$needEscaping/$escMrk$subChar$escMrk/o;
    }

    #-----------------------------------------------------
    # Collect any field typotags found for later expansion.
    #-----------------------------------------------------
    while( /$field_tt/o )
    {
        $field = $1;
        $field =~ /$field_content/ && ( $variable = $1 );
        
        if( $variable =~ /$variable_def/ ) {
        
            $v_name = $1;
            
            #----------------------------------------------
            # When fields 2 and 3 contain identical strings
            # then a valid field has been encountered.
            #----------------------------------------------
            if( $2 eq $3 ) {
                $v_value = $4;
            }
            else
            {
                #-----------------------------------
                # This is NOT a variable definition.
                # Have to recover original string.
                #-----------------------------------
                $v_name  = "_A_${v_name}_Z_"; #internal name
                $v_value = $variable;
            }
            
            #----------------------------------------
            # Is this only a reference to a variable?
            #----------------------------------------
            if ( ! defined $v_value ) { 
                #------------------------------------------------
                # Only put definitions in the list when it is not
                # part of a comment. (comments are not emitted)
                #------------------------------------------------
                push @variable_list, $v_name unless /$suppress_tt/o;
            }
            else {
                #------------------------------------------------
                # setting the variable ( |>varName = value<| )
                # (here $v_value is the value assignment portion)
                #------------------------------------------------
                if( /$suppress_tt/o ) {
                    $variables{ $v_name } = 
                       preserve_html( $v_value, $cond_text_region );
                } else {
                    push @variable_list, $variable;
                }
            }
        }
        
        #--------------------------------------
        # Remove field and replace with marker.
        #--------------------------------------
        $flen  = length( $field );
        $floc  = index( $_, $field );
        $front = substr( $_, 0, $floc );
        $back  = substr( $_, $floc+$flen );
        $_ = $front . $vm . $back; 
    }

    #----------------------------
    # Fill in any variables found
    #----------------------------
    foreach $element ( @variable_list ) 
    {
        if( exists $variables{ $element } ) {
            $value = $variables{ $element }
        } else {
            $value = "|>$element<|";
            print STDERR "$pgm: Undefined variable '$element' used in $setext_file.\n" unless $noWarn;
        }
        s/$vm/$value/;
    }
    
    $_ = preserve_html( $_, $cond_text_region );

    return $_;
}

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

sub preserve_html
{
    my $text             = shift;
    my $cond_text_region = shift;

    #--------------------------------------------------------
    # When in a conditional text region that only applies to
    # HTML translation, change the angle brackets to internal
    # definitions that will be fixed later. This should allow
    # for a mixture of setext and HTML language together.
    #--------------------------------------------------------
    if ( $cond_text_region eq "html" )
    {
        $text =~ s/</${lt}/go;
        $text =~ s/>/${gt}/go;
        $text =~ s/\&/${amp}/go;
    }
    
    return $text;
}

#===================================================================
# Import setext data from given data stream and pay attention to
# conditional text considerations, as described below.
#
#   ^.. ? name   Conditional text when 'name' is defined.
#   ^.. ! name   Conditional text when 'name' is NOT defined.
#
#   ^.. ? name~
#         Multiple line conditional text when 'name' is defined.
#         (without suppress-tt, will always appear in translated
#         document going through non-conditional setext conversion)
#   ^.. ~ name
#
#   ^.. ! name~
#         Multiple line conditional text when 'name' is NOT defined.
#         (without suppress-tt, will always appear in translated
#         document going through non-conditional setext conversion)
#   ^.. ~ name
#
# This procedure also extracts and applies variable definitions
# to the text to be emitted.
#===================================================================

sub get_setext
{
    my $stream = shift;
    my $cond_text_definitions = shift;
    my $data = shift;

    my $conditional_text_marker = '^\.\. ([\?!~])\s*(\S+)\s?(.*)$';
    my $lineNbr = 0;
    my $i = 0;
    my $element = "";
    my ($tense,$def_nm,$text,$multi_line,$crnt_def);
    my @cond_text_stack = ();

    while( $_ = <$stream> )
    {
        $lineNbr++;
        
        if( /$conditional_text_marker/o )
        {
            $tense      = $1;  # positive, negative, or end-of conditional text
            $def_nm     = $2;
            $text       = $3;
            
            $multi_line = $def_nm =~ s/~//o;
            
            #---------------------------------------------
            # Reach end of multiple line conditional text?
            #---------------------------------------------
            if( $tense eq "~" )
            {
                $crnt_def = substr( pop @cond_text_stack, 1 );
                
                if( $crnt_def ne $def_nm )
                {
                    print STDERR "Incorrectly nested conditinal text sections near line $lineNbr.\n";
                    print STDERR "Expected end of '$crnt_def', but saw end of '$def_nm'\n";
                    exit 1;
                }
            }
            else
            {
                #-----------------------------------------
                # Entering multiple line conditional text?
                #-----------------------------------------
                if( $multi_line ) {
                    push @cond_text_stack, "$tense$def_nm";
                }
    
                #------------------------------------------
                # This will also catch any non-space 
                # text found on multiple line conditionals.
                #------------------------------------------
                if( $text =~ /\S/o )
                {
                    $$data[$i++] = extract_fields( "$text\n", $def_nm ) 
                       if ($tense eq "?") and is_member( $def_nm, $cond_text_definitions );
                    $$data[$i++] = extract_fields( "$text\n", $def_nm ) 
                       if ($tense eq "!") and not is_member( $def_nm, $cond_text_definitions );
                }
            }
        }
        elsif( scalar( @cond_text_stack ) == 0 )
        {
            $$data[$i++] = extract_fields( $_, "" );
        }
        else
        {
            #--------------------------------------------------------------------
            # The top element of the conditional text stack is the current
            # conditional text area. See if it exists in the definitions list.
            # When present, we want this line of text, depending on 'tense'.
            #--------------------------------------------------------------------
            $element = $cond_text_stack[-1];
            $tense   = substr( $element, 0, 1 );
            $def_nm  = substr( $element, 1 );
                
            if( $tense eq "?") 
            {
                if( is_member( $def_nm, $cond_text_definitions ) ) {
                    s/$suppress_tt //o; 
                    $$data[$i++] = extract_fields( $_, $def_nm );
                }
            }
            elsif( ! is_member( $def_nm, $cond_text_definitions ) )
            {
                s/$suppress_tt //o;
                $$data[$i++] = extract_fields( $_, $def_nm );
            }
        }
    }
}

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

sub extract_menu_init
{
    %MenuNames    = ();
    @helpMenu     = ();
    @menuStack    = \@helpMenu;
    $crntMenu     = \@helpMenu;
    @indentStack  = ( 0 );
    $menuLevel    = 0;
    $comment_ind  = "^\\.\\.";     # setext comment indicator ("..")
    $menu_element = "${comment_ind} Menu: ";
    $help_element = "${comment_ind} Help: ";
    $drop_marker  = "_(.)_";
    $separator    = "-";
    $help_code    = 9; # special hide-it code indicating not part of help menu
    $name_length  = 0; # determines padding alignment in HelpMenu data emission
    $crntIndent   = 0;
    $subMenuIndicator = "\377";
}

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

sub extract_menu_info
{
    my $thisData  = shift;
    my $dataIndex = 0;

    extract_menu_init();
    
    #----------------------------------------------------------------------
    # For each and every menu item found in the original data (*.etx) file.
    #----------------------------------------------------------------------
    while( $_ = get_menu_item( $thisData, \$dataIndex ) )
    {
        #----------------------------------------------------------------------
        # Here we want to extract the menu title, help name, optional hideIt
        # numerical indicator, and optional menu association name.
        #
        # Expecting:  MenuTitle # HelpName [[,]HideItIndicator] [# Association]
        #----------------------------------------------------------------------
        if( /^([^#]+)#\s*(\w*)(\s*,\s*)?(\d+)?(\s*#\s*)?(\w+)?/o )
        {
            $menuTitle = $1;
            $helpName  = $2;
            $hideItInd = ($4 eq "") ? "0" : $4;
            $assocName = ($6 eq "") ? $helpName : $6;
            $helpName  =~ s/$trim_spaces/$2/;
            $assocName =~ s/$trim_spaces/$2/;

            #------------------------------------------------
            # Determine to which menu this menu item belongs
            # using leading whitespace indentation.
            # Extract menu character mneumonic.
            #------------------------------------------------
            $menuTitle =~ /^(\s*)/ && ($nextMenu = length($1)-$crntIndent);
            $menuTitle =~ s/$trim_spaces/$2/o;

            $mneumonic = (/$drop_marker/) ? $1 : substr( $menuTitle, 0, 1 );

            #--------------------------------------------------
            # Identation greater than previous menu element
            # indicates that this element is part of a submenu.
            #--------------------------------------------------
            if( $nextMenu > 0 )
            {
                @$crntMenu[ $end ] .= $subMenuIndicator; # mark previous element
                ($menu = $previousTitle) =~ s/ /_/g;
                @$menu = ();
                push @menuStack, \@$menu;
                push @indentStack, $nextMenu;
                $menuLevel++;
            }
            #--------------------------------------
            # Indentation less than previous menu 
            # element indicates leaving a submenu.
            #--------------------------------------
            elsif( $nextMenu < 0 )
            {
                $indentLevel = $indentStack[$menuLevel] + $nextMenu;
                do {
                    pop @menuStack;
                    pop @indentStack;
                    $menuLevel--;

                } while( $indentLevel < $indentStack[$menuLevel] );
            }

            $crntIndent += $nextMenu;
            $crntMenu    = $menuStack[ $#menuStack ];
            $end = scalar( @$crntMenu );
            @$crntMenu[ $end ] = "$mneumonic,$menuTitle,$helpName,$hideItInd";
            $thisTitle = $menuTitle;
            $thisTitle =~ s/$drop_marker/$1/;
            $thisTitle =~ s/ /_/go;
            $MenuNames{ $thisTitle } = "$menuLevel$assocName";
            $previousTitle     = $menuTitle;

            #---------------------------------
            # update data for padding purposes
            #---------------------------------
            if( $mneumonic ne $separator and $name_length < length( $helpName ) )
            {
                $name_length = length( $helpName );
            }
        }
    }
}

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

sub get_menu_item
{
    my $setext = shift;
    my $line   = shift;

    #-------------------------------------------
    # Search each and every data line for either
    # a '# Menu: ' line or a '# Help: ' line and
    # return remainder of the line.
    #-------------------------------------------
    while( $$line < scalar( @$setext ) )
    {
        $_ = $$setext[ $$line++ ];
        return $_               if s/$menu_element//o;
        return "$_, $help_code" if s/$help_element//o;
    }
    
    return "";
}

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

sub check_target_reference
{
    local($_) = @_;
    my $index;
    my $target = "";
    
    if( /$target_tt/ ){
        $target = $4;
    }
    #-----------------------------------
    # Are all titles automatically being
    # made into hypertext references?
    #-----------------------------------