moving from https://github.com/perberos/mate-desktop-environment

1 files changed, 220 insertions, 0 deletions

diff --git a/eel/makeenums.pl b/eel/makeenums.pl
new file mode 100755
index 00000000..50402ed2
--- /dev/null
+++ b/eel/makeenums.pl
@@ -0,0 +1,220 @@
+#!/usr/bin/perl -w
+
+# This script snarfs the enums from header files and writes them out into
+# a .defs file (mate.defs, for example). From there, the sister script
+# maketypes.awk converts the defs into a *typebuiltins.h, as well as
+# *typebuiltins_vals.c, *typebuiltins_ids.c and *typebuiltins_evals.c.
+
+# Information about the current enumeration
+
+my $flags;			# Is enumeration a bitmask
+my $seenbitshift;			# Have we seen bitshift operators?
+my $prefix;			# Prefix for this enumeration
+my $enumname;			# Name for this enumeration
+my $firstenum = 1;		# Is this the first enumeration in file?
+my @entries;			# [ $name, $val ] for each entry
+
+sub parse_options {
+    my $opts = shift;
+    my @opts;
+
+    for $opt (split /\s*,\s*/, $opts) {
+	my ($key,$val) = $opt =~ /\s*(\w+)(?:=(\S+))?/;
+	defined $val or $val = 1;
+	push @opts, $key, $val;
+    }
+    @opts;
+}
+sub parse_entries {
+    my $file = shift;
+
+    while (<$file>) {
+	# Read lines until we have no open comments
+	while (m@/\*
+	       ([^*]|\*(?!/))*$
+	       @x) {
+	    my $new;
+	    defined ($new = <$file>) || die "Unmatched comment";
+	    $_ .= $new;
+	}
+	# Now strip comments
+	s@/\*(?!<)
+	    ([^*]+|\*(?!/))*
+	   \*/@@gx;
+	
+	s@\n@ @;
+	
+	next if m@^\s*$@;
+
+	# Handle include files
+	if (/^\#include\s*<([^>]*)>/ ) {
+            my $file= "../$1";
+	    open NEWFILE, $file or die "Cannot open include file $file: $!\n";
+	    
+	    if (parse_entries (\*NEWFILE)) {
+		return 1;
+	    } else {
+		next;
+	    }
+	}
+	
+	if (/^\s*\}\s*(\w+)/) {
+	    $enumname = $1;
+	    return 1;
+	}
+
+	if (m@^\s*
+              (\w+)\s*		         # name
+              (?:=(                      # value
+                   (?:[^,/]|/(?!\*))*
+                  ))?,?\s*
+              (?:/\*<		         # options 
+                (([^*]|\*(?!/))*)
+               >\*/)?
+              \s*$
+             @x) {
+	    my ($name, $value, $options) = ($1,$2,$3);
+
+	    if (!defined $flags && defined $value && $value =~ /<</) {
+		$seenbitshift = 1;
+	    }
+	    if (defined $options) {
+		my %options = parse_options($options);
+		if (!defined $options{skip}) {
+		    push @entries, [ $name, $options{nick} ];
+		}
+	    } else {
+		push @entries, [ $name ];
+	    }
+	} else {
+	    print STDERR "Can't understand: $_\n";
+	}
+    }
+    return 0;
+}
+
+
+my $gen_arrays = 0;
+my $gen_defs = 0;
+
+# Parse arguments
+
+if (@ARGV) {
+    if ($ARGV[0] eq "arrays") {
+	shift @ARGV;
+	$gen_arrays = 1;
+    } elsif ($ARGV[0] eq "defs") {
+	shift @ARGV;
+	$gen_defs = 1;
+    } else {
+	$gen_defs = 1;
+    }
+    
+}
+
+if ($gen_defs) {
+    print ";; generated by makeenums.pl  ; -*- scheme -*-\n\n";
+} else {
+    print "/* Generated by makeenums.pl */\n\n";
+}
+
+ENUMERATION:
+while (<>) {
+    if (eof) {
+	close (ARGV);		# reset line numbering
+	$firstenum = 1;		# Flag to print filename at next enum
+    }
+
+    if (m@^\s*typedef\s+enum\s*
+           ({)?\s*
+           (?:/\*<
+             (([^*]|\*(?!/))*)
+            >\*/)?
+         @x) {
+	if (defined $2) {
+	    my %options = parse_options($2);
+	    $prefix = $options{prefix};
+	    $flags = $options{flags};
+	} else {
+	    $prefix = undef;
+	    $flags = undef;
+	}
+	# Didn't have trailing '{' look on next lines
+	if (!defined $1) {
+	    while (<>) {
+		if (s/^\s*\{//) {
+		    last;
+		}
+	    }
+	}
+
+	$seenbitshift = 0;
+	@entries = ();
+
+	# Now parse the entries
+	parse_entries (\*ARGV);
+
+	# figure out if this was a flags or enums enumeration
+
+	if (!defined $flags) {
+	    $flags = $seenbitshift;
+	}
+
+	# Autogenerate a prefix
+
+	if (!defined $prefix) {
+	    for (@entries) {
+		my $name = $_->[0];
+		if (defined $prefix) {
+		    my $tmp = ~ ($name ^ $prefix);
+		    ($tmp) = $tmp =~ /(^\xff*)/;
+		    $prefix = $prefix & $tmp;
+		} else {
+		    $prefix = $name;
+		}
+	    }
+	    # Trim so that it ends in an underscore
+	    $prefix =~ s/_[^_]*$/_/;
+	}
+	
+	for $entry (@entries) {
+	    my ($name,$nick) = @{$entry};
+            if (!defined $nick) {
+ 	        ($nick = $name) =~ s/^$prefix//;
+	        $nick =~ tr/_/-/;
+	        $nick = lc($nick);
+	        @{$entry} = ($name, $nick);
+            }
+	}
+
+	# Spit out the output
+
+	if ($gen_defs) {
+	    if ($firstenum) {
+		print qq(\n; enumerations from "$ARGV"\n);
+		$firstenum = 0;
+	    }
+	    
+	    print "\n(define-".($flags ? "flags" : "enum")." $enumname";
+
+	    for (@entries) {
+		my ($name,$nick) = @{$_};
+		print "\n   ($nick $name)";
+	    }
+	    print ")\n";
+
+	} else {
+	    ($valuename = $enumname) =~ s/([A-Z][a-z])/_$1/g;
+	    $valuename =~ s/([a-z])([A-Z])/$1_$2/g;
+	    $valuename = lc($valuename);
+
+	    print "static const GEnumValue $ {valuename}_values[] = {\n";
+	    for (@entries) {
+		my ($name,$nick) = @{$_};
+		print qq(  { $name, "$name", "$nick" },\n);
+	    }
+	    print "  { 0, NULL, NULL }\n";
+	    print "};\n";
+	}
+    }
+}