#!/usr/bin/perl -w

# Copyright (c) 2000, 2002 Stephen Montgomery-Smith
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. Neither the name of Stephen Montgomery-Smith nor the names of his 
#    contributors may be used to endorse or promote products derived from 
#    this software without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE STEPHEN MONTGOMERY-SMITH AND CONTRIBUTORS 
# ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 
# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 
# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL STEPHEN MONTGOMERY-SMITH OR 
# CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 
# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 
# POSSIBILITY OF SUCH DAMAGE.

sub setatom {
  $atom = $atomlist[$atomcount];
  $previousatom = $atomlist[$atomcount-1];
  $nextatom = $atomlist[$atomcount+1];
  $atom =~ s/^\d+: // if defined $atom;
  $previousatom =~ s/^\d+: // if defined $previousatom;
  $nextatom =~ s/^\d+: // if defined $nextatom;
}

sub getatom {
  $atomcount++;
  setatom;
}

sub pushatom {
  $atomcount--;
  setatom;
}

sub fetchatoms {
  @atomlist = ();
  open(CONFIG,"config_getargs");
  while ($line = <CONFIG>) {
    if ($line !~ /^\#/) {
      while (1) {
        next if ($line =~ s/^\s+//);
        if ($line =~ s/^\"([^\"]*)\"//) {}
        elsif ($line =~ s/^([a-zA-Z\_][a-zA-Z\_0-9]*)//) {}
        elsif ($line =~ s/^(\%\d*[a-zA-Z])//) {}
        elsif ($line =~ s/^(\S)//) {}
        else { last }
        push(@atomlist,$1);
      }
    }
  }
  close(CONFIG);
  push(@atomlist,"end");
  $atomcount = 0;
  setatom;
}

sub enum_value {
  my $enum = '';
  getatom; $enum = $atom;
  getatom; die if $atom ne '=';
  getatom; $enum .= '=' . $atom;
  getatom;
  return $enum;
}

sub sub_title_item {
  my $item;
  if ($atom =~ /^[a-zA-Z0-9]/) {
    $item = "strcmp(ARG,\"$atom\")==0"
  }
  elsif ($atom eq '%d') {
    $item = "get_number(ARG,LOW,HIGH,&VAL)"
  }
  elsif ($atom eq '%64x') {
    $item = "get_64_hex(ARG,char_array_32)" 
  }
  elsif ($atom eq '%e') {
    getatom;
    die "'{' expected at beginning of enum list\n" if $atom ne '{';
    $item = "ENUM(ARG," . enum_value;
    while ($atom eq ';') {
      $item .= "," . enum_value;
    }
    die "'}' expected at end of enum list - got $atom\n" if $atom ne '}';
    $item .= ')';
  }
  getatom if defined($item);
  return $item;
}

sub title_item {
  my $title_item = sub_title_item;
  my $next_item;
  my $n = 1;
  die "syntax error in title\n" if !defined($title_item);
  $title_item =~ s/ARG/argv[i]/;
  while(defined($next_item = sub_title_item)) {
    $next_item =~ s/ARG/argv\[i+$n\]/;
    $title_item = "$title_item && $next_item";
    $n++;
  }
  return "(i+$n<=argc && $title_item && (inc=$n))";
}

sub substitute {
  @t=();
  foreach $t (split /\|\|/,$_[0]) {
    $t =~ s/LOW/$_[1]/;
    $t =~ s/HIGH/$_[2]/;
    $t =~ s/VAL/val$_[3]/;
    push(@t,$t);
  }
  return join '||',@t;
}

$n_max = 0;

sub process_item {
  my $title_item;
  $title_item = title_item;
  while ($atom eq '|') {
    getatom;
    $title_item .= " ||\n    " . title_item;
  }
  die "expected ':'\n" if $atom ne ':';

  my $execute = '';
  my %maskhash = ();
  my $n = 1;
  while ($atom =~ /^(\:|\,)$/) {
    getatom;
    my $type = $atom;
    last if $atom eq '{';
    getatom;
    my $field = $atom;
    getatom;
    my $mask = $atom;
    getatom;
    die "expected three fields\n" if !defined($atom);

#$execute .= "printf(\"executing for $type $field $mask\\n\");\n";
    $maskhash{$mask} = 1;

    if ($type =~ /^MASK\_(.*)$/) {
      $execute .= "if (argv[i][0] == '-') ctrls->$field &= ~$1;\n" .
                  "else                   ctrls->$field |= $1;\n";
    }
    elsif ($type eq 'USHORT') {
      $title_item = substitute($title_item,0,65535,$n);
      $execute .= "ctrls->$field = val$n;\n";
      $n++;
    }
    elsif ($type eq 'SHORT') {
      $title_item = substitute($title_item,-32767,32767,$n);
      $execute .= "ctrls->$field = val$n;\n";
      $n++;
    }
    elsif ($type eq 'UCHAR') {
      $title_item = substitute($title_item,0,255,$n);
      $execute .= "ctrls->$field = val$n;\n";
      $n++;
    }
    elsif ($type eq 'LOW_NIBBLE') {
      $title_item = substitute($title_item,0,255,$n);
      $execute .= "ctrls->$field &= 0xF0;\n" .
                  "ctrls->$field |= 0x0F & val$n;\n";
      $n++;
    }
    elsif ($type eq 'BIT32') {
      $title_item = substitute($title_item,0,255,$n);
      $execute .= "if (argv[i][0] == '-') ctrls->$field\[val$n>>3] &= ~(1<<(val$n&7));\n" .
                  "else                   ctrls->$field\[val$n>>3] |= (1<<(val$n&7));\n";
      $n++;
    }
    elsif ($type eq 'CHAR_ARRAY32') {
      $execute .= "memcpy(ctrls->$field,char_array_32,32);\n";
    }
    elsif ($type eq 'HIGH_NIBBLE_ENUM') {
      $title_item =~ s/ENUM\(([^\)]*)\)/1/;
      @enum_list = split ',',$1;
      $arg = shift(@enum_list);
      $first = 1;
      foreach $enum (@enum_list) {
        ($code,$value) = split '=',$enum;
        $execute .= (!$first?"else ":"") .
                    "if (strcmp($arg,\"$code\")==0) {\n" .
                    "  ctrls->$field &= 0x0F;\n" .
                    "  ctrls->$field |= $value;\n" .
                    "}\n";
        $first = 0;
      }
      $execute .= "else return 0;\n"; 
    }
    else {
      die "Unknown type $type";
    }

    if ($type eq 'BIT32' || $type =~ /^MASK\_/) {
      $temp = $title_item;
      $temp =~ s/strcmp\(([^\,]+)\,\"([^\"]+)\"\)/strcmp\($1,\"-$2\"\)/g;
      $title_item .= " ||\n    $temp";
    }
  }

  $n_max = $n-1 if $n-1>$n_max;

  foreach $i (@_) {
    $maskhash{$i} = 0;
  }
  $masklist = join '|',grep $maskhash{$_}==1, keys %maskhash;
  $execute .= "*mask |= $masklist;\n" if $masklist;

  $execute .= "i += inc;\n";

  my $inner;
  my $inner_count = 0;
  if ($atom eq '{') {
    getatom;
    $inner = process_item(keys %maskhash);
    $inner_count++ if $inner;
    while ($atom ne '}') {
      $t = process_item(keys %maskhash);
      if ($t) {
        $inner .= "else " . $t;
        $inner_count++;
      }
    }
  }
  else {
    die "expected ';' or '{' got $atom" if $atom ne ';';
  }
  if ($inner_count==1) {
    $execute .= $inner;
  }
  elsif ($inner_count>=2) {
    $inner .= "else break;\n";
    $inner =~ s/^/  /gm;
    $execute .= "while (1) {\n$inner}\n";
  }

  getatom;
  $execute =~ s/^/  /gm;
#$t=$title_item;
#$t =~ s/\n/\\n/sg;
#$t =~ s/\"/\\\"/g;
#$title_item = "(printf(\"checking $t i = %d (%s)\\n\",i,argv[i])||1) && ($title_item)";
  $execute = "if ($title_item) {\n$execute}\n";
  return $execute;
}


sub process_expire {
  my $title_item;
  $title_item = title_item;
  while ($atom eq '|') {
    getatom;
    $title_item .= " ||\n    " . title_item;
  }
  die "expected ':'\n" if $atom ne ':';

  my $type;

  my $execute = '';
  while ($atom =~ /^(\:|\,)$/) {
    getatom;
    $type = $atom;
    last if $atom eq '{';
    getatom;
    my $field = $atom;
    getatom;
    my $mask = $atom;
    getatom;
    die "expected three fields\n" if !defined($atom);

#$execute .= "printf(\"executing for $type $field $mask\\n\");\n";

    if ($type =~ /^MASK\_(.*)$/) {
      if ($field eq 'enabled_ctrls') {
        ($axmask,$axvalues) = ('axt_ctrls_mask','axt_ctrls_values');
      }
      elsif ($field eq 'ax_options') {
        ($axmask,$axvalues) = ('axt_opts_mask','axt_opts_values');
      }
      else {
        ($axmask,$axvalues) = ('','');
      }
      if ($axmask) {
        $execute .= "if (argv[i][0] == '-') {\n" .
                    "  ctrls->$axmask |= $1;\n" .
                    "  ctrls->$axvalues &= ~$1;\n" .
                    "}\n" .
                    "else if (argv[i][0] == '=') {\n" .
                    "  ctrls->$axmask &= ~$1;\n" .
                    "  ctrls->$axvalues &= ~$1;\n" .
                    "}\n" .
                    "else {\n" .
                    "  ctrls->$axmask |= $1;\n" .
                    "  ctrls->$axvalues |= $1;\n" .
                    "}\n";
        $temp1 = $title_item;
        $temp1 =~ s/strcmp\(([^\,]+)\,\"([^\"]+)\"\)/strcmp\($1,\"-$2\"\)/g;
        $temp2 = $title_item;
        $temp2 =~ s/strcmp\(([^\,]+)\,\"([^\"]+)\"\)/strcmp\($1,\"\=$2\"\)/g;
        $title_item .= " ||\n    $temp1 ||\n    $temp2";
      }
    }
  }

  $execute .= "i += inc;\n";

  my $inner;
  my $inner_count = 0;
  if ($atom eq '{') {
    getatom;
    $inner = process_expire();
    $inner_count++ if $inner;
    while ($atom ne '}') {
      $t = process_expire();
      if ($t) {
        $inner .= "else " . $t;
        $inner_count++;
      }
    }
  }
  else {
    die "expected ';' or '{'" if $atom ne ';';
  }
  if ($inner_count==1) {
    $execute .= $inner;
  }
  elsif ($inner_count>=2) {
    $inner .= "else break;\n";
    $inner =~ s/^/  /gm;
    $execute .= "while (1) {\n$inner}\n";
  }

  getatom;
  $execute =~ s/^/  /gm;
#$t=$title_item;
#$t =~ s/\n/\\n/sg;
#$t =~ s/\"/\\\"/g;
#$title_item = "(printf(\"checking $t i = %d (%s)\\n\",i,argv[i])||1) && ($title_item)";
  $execute = "if ($title_item) {\n$execute}\n";
  return $type =~ /^MASK\_/ ? $execute : "";
}





############ main

fetchatoms;
$output .= process_item;
while ($atom ne 'end') {
  $output .= "else " . process_item;
}
$output .= "else return 0;";
$output =~ s/^/    /gm;
$vallist = join(', ', map "val$_",(1..$n_max));

fetchatoms;
$output_expire = process_expire;
while ($atom ne 'end') {
  $t = process_expire;
  $output_expire .= "else " . $t if $t;
}
$output_expire .= "else if ((i+1<=argc && get_number(argv[i],0,65535,&val1) && (inc=1))) {\n" .
                  "  ctrls->ax_timeout = val1;\n" .
                  "  i += inc;\n" .
                  "}\n" .
                  "else return 0;";
$output_expire =~ s/^/    /gm;

open(GETC,">getargs.c");
open(COPY,"COPYRIGHT");
$copy = join '',<COPY>;
print GETC <<EOM
/*
$copy
*/

#include "xkbset.h"

Bool get_arguments(int argc, char *argv[], XkbControlsPtr ctrls, unsigned int *mask)
{
  char char_array_32[32];
  int inc, i = 1;
  int $vallist;

  *mask = 0;
  while (i<argc) {
$output
  }
  return 1;
}

Bool get_expire_arguments(int argc, char *argv[], XkbControlsPtr ctrls, unsigned int *mask)
{
  int inc, i = 2;
  int val1;

  *mask = XkbAccessXTimeoutMask;
  while (i<argc) {
$output_expire
  }
  return 1;
}
EOM