#!/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];
}

sub getatom {
  $atomcount++;
  setatom;
}

sub pushatom {
  $atomcount--;
  setatom;
}

sub fetchatoms {
  @atomlist = ();
  open(CONFIG,"config_getargs");
  while ($line = <CONFIG>) {
    if ($line =~ /^\#/) {
      push(@atomlist,$line);
    } else {
      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;
  getatom;
  return $enum;
}

sub sub_title_item {
  my $item;
  if ($atom =~ /^[a-zA-Z0-9]/) {
    $item = $atom;
  }
  elsif ($atom eq '%d') {
    $item = "<VAL>"
  }
  elsif ($atom eq '%64x') {
    $item = "<VAL>" 
  }
  elsif ($atom eq '%e') {
    getatom;
    die "'{' expected at beginning of enum list\n" if $atom ne '{';
    $item = enum_value;
    while ($atom eq ';') {
      $item .= "|" . enum_value;
    }
    $item = "{$item}";
    die "'}' expected at end of enum list - got $atom\n" if $atom ne '}';
  }
  getatom if defined($item);
  return $item;
}

sub title_item {
  my $title_item = sub_title_item;
  my $next_item;
  die "syntax error in title - atom is $atom" if !defined($title_item);
  while(defined($next_item = sub_title_item)) {
    $title_item = "$title_item $next_item";
  }
  return $title_item;
}

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

sub process_item {
  my $comment="";
  while ($atom =~ /^\#/) {
    $comment .= "#$1\n" if $atom =~ /^\#C\s*(.*)/;
    getatom;
  }
  my $title_item;
  $title_item = title_item;
  while ($atom eq '|') {
    getatom;
    $title_item .= "|" . title_item;
  }
  die "expected ':'\n" if $atom ne ':';

  my $minus = 0;
  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";

    if ($type !~ /^MASK\_(.*)$/) {
      $title_item = substitute($title_item,$field);
    }
    $minus = 1 if $type eq 'BIT32' || $type =~ /^MASK\_/;
  }

  $t = $title_item;
  while ($t=~s/\{[^\}]*\}//) {}
  $title_item = "{$title_item}" if $t =~/\|/;
  $title_item = "[-]$title_item" if $minus;

  my $inner;
  my $inner_count = 0;
  if ($atom eq '{') {
    getatom;
    $inner = process_item();
    $inner_count++ if $inner;
    while ($atom ne '}') {
      $t = process_item();
      if ($t) {
        $inner .= "|" . $t;
        $inner_count++;
      }
    }
  }
  else {
    die "expected ';' or '{'\n" if $atom ne ';';
  }
  if ($inner_count==1) {
    $execute = " [$inner]";
  }
  elsif ($inner_count>=2) {
    $execute = " [$inner]...";
  }
  else {
    $execute = "";
  }
  getatom;
#$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)";
  $comment = "\n$comment\n" if $comment;
  $execute = "$comment$title_item$execute";
  return $execute;
}


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

  my $minus = 0;
  my $execute = '';
  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";

    $minus = 1 if $type =~ /^MASK\_(.*)$/;
  }

  $t = $title_item;
  while ($t=~s/\{[^\}]*\}//) {}
  $title_item = "{$title_item}" if $t =~/\|/;
  $title_item = "[-|=]$title_item" if $minus;

  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 .= "|" . $t;
        $inner_count++;
      }
    }
  }
  else {
    die "expected ';' or '{'\n" if $atom ne ';';
  }
  if ($inner_count==1) {
    $execute = " [$inner]";
  }
  elsif ($inner_count>=2) {
    $execute = " [$inner]...";
  }
  else {
    $execute = "";
  }
  getatom;
#$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 = "$title_item$execute";
  return $minus ? $execute : "";
}





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

fetchatoms;
$output .= process_item;
while ($atom ne 'end') {
  $output .= "\n" . process_item;
}

fetchatoms;
$output_expire = "<ax_timeout>\n" . process_expire;
while ($atom ne 'end') {
  $t = process_expire;
  $output_expire .= "\n" . $t if $t;
}
my @output = ();
foreach $line(split "\n",$output) {
  if ($line =~ /\#(.*)/) {
    push(@output,$1);
  } else {
    while (length($line) > 70) {
      for($i=69;substr($line,$i,1) !~ /\|| /;$i--) {}
      push(@output,"    " . substr($line,0,$i+1));
      $line = "  " . substr($line,$i+1);
    }
    push(@output,"    " . $line);
  }
}
$output = join "\n",@output;
@output = ();
foreach $line(split "\n",$output_expire) {
  while (length($line) > 70) {
    for($i=69;substr($line,$i,1) !~ /\|| / ||
              substr($line,$i-1,3) =~ /\-\|\=/;$i--) {}
    push(@output,"    " . substr($line,0,$i+1));
    $line = "  " . substr($line,$i+1);
  }
  push(@output,"    " . $line);
}
$output_expire = join "\n",@output;

$usage = <<EOM;
Usage: To set or unset various options:

  xkbset <options>

where <options> may be all or any of (the '-' switches the feature off, 
otherwise it is switched on):
$output



To set the AccessX expire controls:

  xkbset exp <options>

where <options> may be all or any of (<ax_timeout> is the timeout (in
seconds) after which no user activity on X will cause the expiry; '-'
indicates the feature will be switched off, '=' incicates the feature
will be left unchanged, otherwise it will be switched on):

$output_expire

To see the current values of the controls:

  xkbset q

To see the current values of what controls will expire:

  xkbset q exp

To have these values written as a command line:

  xkbset w [exp]

To print this help message

  xkbset [h]

EOM

$usage =~ s/^(.*)$/  printf\(\"$1\\n\"\);/mg;

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

#include "xkbset.h"

void print_usage()
{
$usage
}
EOM