Eine aufbereitete Darstellung der Quelle

 
     
 
 
Anforderungen  |   Konzepte  |   Entwurf  |   Entwicklung  |   Qualitätssicherung  |   Lebenszyklus  |   Steuerung
 
 
 
 

Benutzer

Quelle  enumgen.pl   Sprache: Shell

 

#!/usr/bin/perl -w

# GIMP - The GNU Image Manipulation Program
# Copyright (C) 1999-2003 Manish Singh <yosh@gimp.org>

# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUTFILE ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <https://www.gnu.org/licenses/>.

BEGIN {
    $srcdir   = $ENV{srcdir}   || '.';
    $destdir  = $ENV{destdir}   || '.';
    $builddir = $ENV{builddir} || '.';
    $topsrcdir = $ENV{topsrcdir} || '.';
}

use lib $srcdir;

use Text::Wrap qw(wrap $columns);
$columns = 77;

#BEGIN { require 'util.pl' }
require 'util.pl';

*write_file = \&Gimp::CodeGen::util::write_file;
*FILE_EXT   = \$Gimp::CodeGen::util::FILE_EXT;

my $header = <<'HEADER';
:# GIMP - The GNU Image Manipulation Program
:# Copyright (C) 1999-2003 Manish Singh <yosh@gimp.org>
:
:# This program is free software: you can redistribute it and/or modify
:# it under the terms of the GNU General Public License as published by
:# the Free Software Foundation; either version 3 of the License, or
:# (at your option) any later version.
:
:# This program is distributed in the hope that it will be useful,
:# but WITHOUTFILE ANY WARRANTY; without even the implied warranty of
:# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
:# GNU General Public License for more details.
:
:# You should have received a copy of the GNU General Public License
:# along with this program.  If not, see <https://www.gnu.org/licenses/>.
:
:# autogenerated by enumgen.pl
:
:package Gimp::CodeGen::enums;
:
:%enums = (
HEADER

my $external;
open my $EXTERNAL, "enums-external.pl";
{
    local $/;
    $external = <$EXTERNAL>;
}
close $EXTERNAL;

my $footer = <<'FOOTER';
:);
:
:foreach $e (values %enums) {
:    $e->{info} = "";
:    foreach (@{$e->{symbols}}) {
: $e->{info} .= "$_ ($e->{mapping}->{$_}), "
:    }
:    $e->{info} =~ s/, $//;
:}
:
:1;
FOOTER

my ($enumname, $contig, $symbols, @mapping, $before);

# Most of this enum parsing stuff was swiped from makeenums.pl in GTK+
sub parse_options {
    my $opts = shift;
    my @opts;

    for $opt (split /\s*,\s*/, $opts) {
 $opt =~ s/^\s*//;
 $opt =~ s/\s*$//;
 my ($key,$val) = $opt =~ /([-\w]+)(?:=(.+))?/;
 defined $val or $val = 1;
 push @opts, $key, $val;
    }
    @opts;
}

sub parse_entries {
    my $file = shift;
    my $file_name = shift;
    my $looking_for_name = 0;

    while (<$file>) {
 # Read lines until we have no open comments
 while (m@/\*([^*]|\*(?!/))*$@) {
     my $new;
     defined ($new = <$file>) || die "Unmatched comment in $ARGV";
     $_ .= $new;
 }
 # strip comments w/o options
 s@/\*(?!<)
     ([^*]+|\*(?!/))*
    \*/@@gx;
        
 s@\n@ @;
        
 next if m@^\s*$@;

 if ($looking_for_name) {
     if (/^\s*(\w+)/) {
  $enumname = $1;
  return 1;
     }
 }

 # Handle include files
 if (/^\#include\s*<([^>]*)>/ ) {
     my $file= "../$1";
     open NEWFILE, $file or die "Cannot open include file $file: $!\n";

     if (&parse_entries (\*NEWFILE, $NEWFILE)) {
  return 1;
     } else {
  next;
     }
 }

 if (/^\s*\}\s*(\w+)/) {
     $enumname = $1;
     return 1;
 }

 if (/^\s*\}/) {
     $looking_for_name = 1;
     next;
 }

 if (m@^\s*
       (\w+)\s*                   # name
       (?:=(                      # value
     (?:[^,/]|/(?!\*))*
    ))?,?\s*
       (?:/\*<                    # options 
  (([^*]|\*(?!/))*)
        >\s*\*/)?,?
       \s*$
             @x) {
            my ($name, $value, $options) = ($1, $2, $3);

     if (defined $options) {
  my %options = parse_options($options);
  next if defined $options{"pdb-skip"};
     }

     $symbols .= $name . ' ';

     # Figure out a default value (not really foolproof)
     $value = $before + 1 if !defined $value;
     $value =~ s/\s*$//s;
     $value =~ s/^\s*//s;

     push @mapping, $name, $value;

     my $test = $before + 1;

     # Warnings in our eval should be fatal so they set $@
     local $SIG{__WARN__} = sub { die $_[0] };

     # Try to get a numeric value
     eval "\$test = $value * 1;";

     # Assume noncontiguous if it's not a number
     $contig = 0 if $contig && ($@ || $test - 1 != $before);

     $before = $test;
 } elsif (m@^\s*\#@) {
     # ignore preprocessor directives
        } else {
            print STDERR "$0: $file_name:$.: Failed to parse `$_'\n";
        }
    }
    return 0;
}

my $code = "";
while (<>) {
    if (eof) {
        close (ARGV);           # reset line numbering
    }

    # read lines until we have no open comments
    while (m@/\*([^*]|\*(?!/))*$@) {
 my $new;
 defined ($new = <>) || die "Unmatched comment in $ARGV";
 $_ .= $new;
    }
    # strip comments w/o options
    s@/\*(?!<)
       ([^*]+|\*(?!/))*
       \*/@@gx;

    if (m@^\s*typedef\s+enum\s*
    ({)?\s*
    (?:/\*<
      (([^*]|\*(?!/))*)
     >\s*\*/)?
         @x) {
        if (defined $2) {
            my %options = parse_options($2);
     next if defined $options{"pdb-skip"};
 }     
 # Didn't have trailing '{' look on next lines
 if (!defined $1) {
     while (<>) {
  if (s/^\s*\{//) {
      last;
  }
     }
 }

 $symbols = ""; $contig = 1; $before = -1; @mapping = ();

 # Now parse the entries
 &parse_entries (\*ARGV, $ARGV);

 $symbols =~ s/\s*$//s;
 $symbols = wrap("\t\t\t  ", "\t\t\t  " , $symbols);
 $symbols =~ s/^\s*//s;

 my $mapping = ""; $pos = 1;
 foreach (@mapping) {
     $mapping .= $pos++ % 2 ? "$_ => " : "'$_',\n\t\t       ";
 }
 $mapping =~ s/,\n\s*$//s;

 $ARGV =~ s@($topsrcdir/)?(?:(?:..|app)/)*@@;

 $code .= <<ENTRY;
:    $enumname =>
: { contig => $contig,
:   header => '$ARGV',
:   symbols => [ qw($symbols) ],
:   mapping => { $mapping }
: },
ENTRY
    }
}

$code =~ s/,\n$/\n/s;

foreach ($header, $code, $footer) { s/^://mg }

$outfile = "$builddir/pdb/enums.pl$FILE_EXT";
open OUTFILE, "> $outfile";
print OUTFILE $header, $external, $code, $footer;
close OUTFILE;
&write_file($outfile, "$destdir/pdb");

Messung
CHZG
869910095

¤ Dauer der Verarbeitung: 0.5 Sekunden  ¤

*© Formatika GbR, Deutschland






Wurzel

Suchen

PVS Prover

Isabelle Prover


Cephes Mathematical Library

Vienna Development Method

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.






                                                                                                                                                                                                                                                                                                                                                                                                     


Neuigkeiten

     Aktuelles
     Motto des Tages

Open Source Software

     Quellcodebibliothek
     Eigene Quellcodes
     Fremde Quellcodes
     Suchen

Jenseits des Üblichen ....
    

Besucherstatistik

Besucherstatistik

Statistik
#Sources=1104838
#Domains=499075