python.perl

python s60 1.4.5版本的源代码

sub add_index_entry{
    # add an entry to the index structures; ignore the return value
    my($str,$ahref) = @_;
    $str = gen_index_id($str, '');
    $index{$str} .= $ahref;
    write_idxfile($ahref, $str);
}

sub new_link_info{
    my $name = "l2h-" . ++$globals{'max_id'};
    my $aname = "<a name=\"$name\">";
    my $ahref = gen_link($CURRENT_FILE, $name);
    return ($name, $aname, $ahref);
}

$IndexMacroPattern = '';
sub define_indexing_macro{
    my $count = @_;
    my $i = 0;
    for (; $i < $count; ++$i) {
	my $name = @_[$i];
	my $cmd = "idx_cmd_$name";
	die "\nNo function $cmd() defined!\n"
	  if (!defined &$cmd);
	eval ("sub do_cmd_$name { return process_index_macros("
	      . "\@_[0], '$name'); }");
	if (length($IndexMacroPattern) == 0) {
	    $IndexMacroPattern = "$name";
	}
	else {
	    $IndexMacroPattern .= "|$name";
	}
    }
}

$DEBUG_INDEXING = 0;
sub process_index_macros{
    local($_) = @_;
    my $cmdname = @_[1];	# This is what triggered us in the first place;
				# we know it's real, so just process it.
    my($name,$aname,$ahref) = new_link_info();
    my $cmd = "idx_cmd_$cmdname";
    print "\nIndexing: \\$cmdname"
      if $DEBUG_INDEXING;
    &$cmd($ahref);		# modifies $_ and adds index entries
    while (/^[\s\n]*\\($IndexMacroPattern)</) {
	$cmdname = "$1";
	print " \\$cmdname"
	  if $DEBUG_INDEXING;
	$cmd = "idx_cmd_$cmdname";
	if (!defined &$cmd) {
	    last;
	}
	else {
	    s/^[\s\n]*\\$cmdname//;
	    &$cmd($ahref);
	}
    }
    if (/^[ \t\r\n]/) {
        $_ = substr($_, 1);
    }
    return "$aname$anchor_invisible_mark</a>" . $_;
}

define_indexing_macro('index');
sub idx_cmd_index{
    my $str = next_argument();
    add_index_entry("$str", @_[0]);
}

define_indexing_macro('kwindex');
sub idx_cmd_kwindex{
    my $str = next_argument();
    add_index_entry("<tt>$str</tt>!keyword", @_[0]);
    add_index_entry("keyword!<tt>$str</tt>", @_[0]);
}

define_indexing_macro('indexii');
sub idx_cmd_indexii{
    my $str1 = next_argument();
    my $str2 = next_argument();
    add_index_entry("$str1!$str2", @_[0]);
    add_index_entry("$str2!$str1", @_[0]);
}

define_indexing_macro('indexiii');
sub idx_cmd_indexiii{
    my $str1 = next_argument();
    my $str2 = next_argument();
    my $str3 = next_argument();
    add_index_entry("$str1!$str2 $str3", @_[0]);
    add_index_entry("$str2!$str3, $str1", @_[0]);
    add_index_entry("$str3!$str1 $str2", @_[0]);
}

define_indexing_macro('indexiv');
sub idx_cmd_indexiv{
    my $str1 = next_argument();
    my $str2 = next_argument();
    my $str3 = next_argument();
    my $str4 = next_argument();
    add_index_entry("$str1!$str2 $str3 $str4", @_[0]);
    add_index_entry("$str2!$str3 $str4, $str1", @_[0]);
    add_index_entry("$str3!$str4, $str1 $str2", @_[0]);
    add_index_entry("$str4!$$str1 $str2 $str3", @_[0]);
}

define_indexing_macro('ttindex');
sub idx_cmd_ttindex{
    my $str = next_argument();
    my $entry = $str . get_indexsubitem();
    add_index_entry($entry, @_[0]);
}

sub my_typed_index_helper{
    my($word,$ahref) = @_;
    my $str = next_argument();
    add_index_entry("$str $word", $ahref);
    add_index_entry("$word!$str", $ahref);
}

define_indexing_macro('stindex', 'opindex', 'exindex', 'obindex');
sub idx_cmd_stindex{ my_typed_index_helper('statement', @_[0]); }
sub idx_cmd_opindex{ my_typed_index_helper('operator', @_[0]); }
sub idx_cmd_exindex{ my_typed_index_helper('exception', @_[0]); }
sub idx_cmd_obindex{ my_typed_index_helper('object', @_[0]); }

define_indexing_macro('bifuncindex');
sub idx_cmd_bifuncindex{
    my $str = next_argument();
    add_index_entry("<tt class=\"function\">$str()</tt> (built-in function)",
                    @_[0]);
}


sub make_mod_index_entry{
    my($str,$define) = @_;
    my($name,$aname,$ahref) = new_link_info();
    # equivalent of add_index_entry() using $define instead of ''
    $ahref =~ s/\#[-_a-zA-Z0-9]*\"/\"/
      if ($define eq 'DEF');
    $str = gen_index_id($str, $define);
    $index{$str} .= $ahref;
    write_idxfile($ahref, $str);

    if ($define eq 'DEF') {
	# add to the module index
        $str =~ /(<tt.*<\/tt>)/;
        my $nstr = $1;
	$Modules{$nstr} .= $ahref;
    }
    return "$aname$anchor_invisible_mark2</a>";
}


$THIS_MODULE = '';
$THIS_CLASS = '';

sub define_module{
    my($word,$name) = @_;
    my $section_tag = join('', @curr_sec_id);
    if ($word ne "built-in" && $word ne "extension"
	&& $word ne "standard" && $word ne "") {
	write_warnings("Bad module type '$word'"
		       . " for \\declaremodule (module $name)");
	$word = "";
    }
    $word = "$word " if $word;
    $THIS_MODULE = "$name";
    $INDEX_SUBITEM = "(in module $name)";
    print "[$name]";
    return make_mod_index_entry(
        "<tt class=\"module\">$name</tt> (${word}module)", 'DEF');
}

sub my_module_index_helper{
    local($word, $_) = @_;
    my $name = next_argument();
    return define_module($word, $name) . $_;
}

sub do_cmd_modindex{ return my_module_index_helper('', @_); }
sub do_cmd_bimodindex{ return my_module_index_helper('built-in', @_); }
sub do_cmd_exmodindex{ return my_module_index_helper('extension', @_); }
sub do_cmd_stmodindex{ return my_module_index_helper('standard', @_); }

sub ref_module_index_helper{
    my($word, $ahref) = @_;
    my $str = next_argument();
    $word = "$word " if $word;
    $str = "<tt class=\"module\">$str</tt> (${word}module)";
    # can't use add_index_entry() since the 2nd arg to gen_index_id() is used;
    # just inline it all here
    $str = gen_index_id($str, 'REF');
    $index{$str} .= $ahref;
    write_idxfile($ahref, $str);
}

# these should be adjusted a bit....
define_indexing_macro('refmodindex', 'refbimodindex',
		      'refexmodindex', 'refstmodindex');
sub idx_cmd_refmodindex{ return ref_module_index_helper('', @_); }
sub idx_cmd_refbimodindex{ return ref_module_index_helper('built-in', @_); }
sub idx_cmd_refexmodindex{ return ref_module_index_helper('extension', @_); }
sub idx_cmd_refstmodindex{ return ref_module_index_helper('standard', @_); }

sub do_cmd_nodename{ return do_cmd_label(@_); }

sub init_myformat{
    $anchor_invisible_mark = '&nbsp;';
    $anchor_invisible_mark2 = '';
    $anchor_mark = '';
    $icons{'anchor_mark'} = '';
}
init_myformat();

# Create an index entry, but include the string in the target anchor
# instead of the dummy filler.
#
sub make_str_index_entry{
    my($str) = @_;
    my($name,$aname,$ahref) = new_link_info();
    add_index_entry($str, $ahref);
    return "$aname$str</a>";
}


%TokenToTargetMapping = ();
%DefinedGrammars = ();
%BackpatchGrammarFiles = ();

sub do_cmd_token{
    local($_) = @_;
    my $token = next_argument();
    my $target = $TokenToTargetMapping{"$CURRENT_GRAMMAR:$token"};
    if ($token eq $CURRENT_TOKEN || $CURRENT_GRAMMAR eq '*') {
        # recursive definition or display-only productionlist
        return "$token";
    }
    if ($target eq '') {
        $target = "<pyGrammarToken><$CURRENT_GRAMMAR><$token>";
        if (! $BackpatchGrammarFiles{"$CURRENT_FILE"}) {
            print "Adding '$CURRENT_FILE' to back-patch list.\n";
        }
        $BackpatchGrammarFiles{"$CURRENT_FILE"} = 1;
    }
    return "<a href=\"$target\">$token</a>" . $_;
}

sub do_cmd_grammartoken{
    return do_cmd_token(@_);
}

sub do_env_productionlist{
    local($_) = @_;
    my $lang = next_optional_argument();
    my $filename = "grammar-$lang.txt";
    if ($lang eq '') {
        $filename = 'grammar.txt';
    }
    local($CURRENT_GRAMMAR) = $lang;
    $DefinedGrammars{$lang} .= $_;
    return ("<dl><dd class=\"grammar\">\n"
            . "<div class=\"productions\">\n"
            . "<table cellpadding=\"2\">\n"
            . translate_commands(translate_environments($_))
            . "</table>\n"
            . "</div>\n"
            . (($lang eq '*')
               ? ''
               : ("<a class=\"grammar-footer\"\n"
                  . "  href=\"$filename\" type=\"text/plain\"\n"
                  . "  >Download entire grammar as text.</a>\n"))
            . "</dd></dl>");
}

sub do_cmd_production{
    local($_) = @_;
    my $token = next_argument();
    my $defn = next_argument();
    my $lang = $CURRENT_GRAMMAR;
    local($CURRENT_TOKEN) = $token;
    if ($lang eq '*') {
        return ("<tr valign=\"baseline\">\n"
                . "    <td><code>$token</code></td>\n"
                . "    <td>&nbsp;::=&nbsp;</td>\n"
                . "    <td><code>"
                . translate_commands($defn)
                . "</code></td></tr>"
                . $_);
    }
    my $target;
    if ($lang eq '') {
        $target = "$CURRENT_FILE\#tok-$token";
    }
    else {
        $target = "$CURRENT_FILE\#tok-$lang-$token";
    }
    $TokenToTargetMapping{"$CURRENT_GRAMMAR:$token"} = $target;
    return ("<tr valign=\"baseline\">\n"
            . "    <td><code><a name=\"tok-$token\">$token</a></code></td>\n"
            . "    <td>&nbsp;::=&nbsp;</td>\n"
            . "    <td><code>"
            . translate_commands($defn)
            . "</code></td></tr>"
            . $_);
}

sub do_cmd_productioncont{
    local($_) = @_;
    my $defn = next_argument();
    $defn =~ s/^( +)/'&nbsp;' x length $1/e;
    return ("<tr valign=\"baseline\">\n"
            . "    <td>&nbsp;</td>\n"
            . "    <td>&nbsp;</td>\n"
            . "    <td><code>"
            . translate_commands($defn)
            . "</code></td></tr>"
            . $_);
}

sub process_grammar_files{
    my $lang;
    my $filename;
    local($_);
    print "process_grammar_files()\n";
    foreach $lang (keys %DefinedGrammars) {
        $filename = "grammar-$lang.txt";
        if ($lang eq '*') {
            next;
        }
        if ($lang eq '') {
            $filename = 'grammar.txt';
        }
        open(GRAMMAR, ">$filename") || die "\n$!\n";
        print GRAMMAR strip_grammar_markup($DefinedGrammars{$lang});
        close(GRAMMAR);
        print "Wrote grammar file $filename\n";
    }
    my $PATTERN = '<pyGrammarToken><([^>]*)><([^>]*)>';
    foreach $filename (keys %BackpatchGrammarFiles) {
        print "\nBack-patching grammar links in $filename\n";
        my $buffer;
        open(GRAMMAR, "<$filename") || die "\n$!\n";
        # read all of the file into the buffer
        sysread(GRAMMAR, $buffer, 1024*1024);
        close(GRAMMAR);
        while ($buffer =~ /$PATTERN/) {
            my($lang, $token) = ($1, $2);
            my $target = $TokenToTargetMapping{"$lang:$token"};
            my $source = "<pyGrammarToken><$lang><$token>";
            $buffer =~ s/$source/$target/g;
        }
        open(GRAMMAR, ">$filename") || die "\n$!\n";
        print GRAMMAR $buffer;
        close(GRAMMAR);
    }
}

sub strip_grammar_markup{
    local($_) = @_;
    s/\\productioncont/              /g;
    s/\\production(<<\d+>>)(.+)\1/\n\2 ::= /g;
    s/\\token(<<\d+>>)(.+)\1/\2/g;
    s/\\e([^a-zA-Z])/\\\1/g;
    s/<<\d+>>//g;
    s/;SPMgt;/>/g;
    s/;SPMlt;/</g;
    s/;SPMquot;/\"/g;
    return $_;
}


$REFCOUNTS_LOADED = 0;

sub load_refcounts{
    $REFCOUNTS_LOADED = 1;

    my $myname, $mydir, $myext;
    ($myname, $mydir, $myext) = fileparse(__FILE__, '\..*');
    chop $mydir;			# remove trailing '/'
    ($myname, $mydir, $myext) = fileparse($mydir, '\..*');
    chop $mydir;			# remove trailing '/'
    $mydir = getcwd() . "$dd$mydir"
      unless $mydir =~ s|^/|/|;
    local $_;
    my $filename = "$mydir${dd}api${dd}refcounts.dat";
    open(REFCOUNT_FILE, "<$filename") || die "\n$!\n";
    print "[loading API refcount data]";
    while (<REFCOUNT_FILE>) {
        if (/([a-zA-Z0-9_]+):PyObject\*:([a-zA-Z0-9_]*):(0|[-+]1|null):(.*)$/) {
            my($func, $param, $count, $comment) = ($1, $2, $3, $4);
            #print "\n$func($param) --> $count";
            $REFCOUNTS{"$func:$param"} = $count;
        }
    }
}

sub get_refcount{
    my ($func, $param) = @_;
    load_refcounts()
        unless $REFCOUNTS_LOADED;
    return $REFCOUNTS{"$func:$param"};
}


$TLSTART = '<span class="typelabel">';
$TLEND   = '</span>';

sub do_env_cfuncdesc{
    local($_) = @_;
    my $return_type = next_argument();
    my $function_name = next_argument();
    my $arg_list = next_argument();
    my $idx = make_str_index_entry(
        "<tt class=\"cfunction\">$function_name()</tt>" . get_indexsubitem());
    $idx =~ s/ \(.*\)//;
    $idx =~ s/\(\)//;		# ???? - why both of these?
    my $result_rc = get_refcount($function_name, '');
    my $rcinfo = '';
    if ($result_rc eq '+1') {
        $rcinfo = 'New reference';
    }
    elsif ($result_rc eq '0') {
        $rcinfo = 'Borrowed reference';
    }
    elsif ($result_rc eq 'null') {
        $rcinfo = 'Always <tt class="constant">NULL</tt>';
    }
    if ($rcinfo ne '') {
        $rcinfo = (  "\n<div class=\"refcount-info\">"
                   . "\n  <span class=\"label\">Return value:</span>"
                   . "\n  <span class=\"value\">$rcinfo.</span>"
                   . "\n</div>");
    }
    return "<dl><dt>$return_type <b>$idx</b>(<var>$arg_list</var>)\n<dd>"
           . $rcinfo
           . $_
           . '</dl>';
}

sub do_env_csimplemacrodesc{
    local($_) = @_;
    my $name = next_argument();
    my $idx = make_str_index_entry("<tt class=\"macro\">$name</tt>");
    return "<dl><dt><b>$idx</b>\n<dd>"
           . $_
           . '</dl>'
}

sub do_env_ctypedesc{
    local($_) = @_;
    my $index_name = next_optional_argument();
    my $type_name = next_argument();
    $index_name = $type_name
      unless $index_name;
    my($name,$aname,$ahref) = new_link_info();
    add_index_entry("<tt class=\"ctype\">$index_name</tt> (C type)", $ahref);
    return "<dl><dt><b><tt class=\"ctype\">$aname$type_name</a></tt></b>\n<dd>"
           . $_
           . '</dl>'
}

sub do_env_cvardesc{
    local($_) = @_;
    my $var_type = next_argument();
    my $var_name = next_argument();
    my $idx = make_str_index_entry("<tt class=\"cdata\">$var_name</tt>"
				   . get_indexsubitem());
    $idx =~ s/ \(.*\)//;
    return "<dl><dt>$var_type <b>$idx</b>\n"
           . '<dd>'
           . $_
           . '</dl>';
}

sub convert_args($){
    local($IN_DESC_HANDLER) = 1;
    local($_) = @_;
    return translate_commands($_);
}

sub do_env_funcdesc{
    local($_) = @_;
    my $function_name = next_argument();
    my $arg_list = convert_args(next_argument());
    my $idx = make_str_index_entry("<tt class=\"function\">$function_name()"
                                   . '</tt>'
				   . get_indexsubitem());
    $idx =~ s/ \(.*\)//;
    $idx =~ s/\(\)<\/tt>/<\/tt>/;
    return "<dl><dt><b>$idx</b>(<var>$arg_list</var>)\n<dd>" . $_ . '</dl>';
}

sub do_env_funcdescni{
    local($_) = @_;
    my $function_name = next_argument();
    my $arg_list = convert_args(next_argument());
    return "<dl><dt><b><tt class=\"function\">$function_name</tt></b>"