← Back to branch summary

~ubuntu-branches/ubuntu/utopic/kde-workspace/utopic-proposed

« back to all changes in this revision

Viewing changes to kdm/confproc.pl

  • Committer: Bazaar Package Importer
  • Author(s): Michał Zając
  • Date: 2011-07-09 08:31:15 UTC
  • Revision ID: james.westby@ubuntu.com-20110709083115-ohyxn6z93mily9fc
Tags: upstream-4.6.90
Import upstream version 4.6.90

Show diffs side-by-side

added added

removed removed

Lines of Context:
kdm/confproc.pl
 
1
#! /usr/bin/perl -w
 
2
#
 
3
# Copyright 2004-2005 Oswald Buddenhagen <ossi@kde.org>
 
4
#
 
5
# Permission to use, copy, modify, distribute, and sell this software and its
 
6
# documentation for any purpose is hereby granted without fee, provided that
 
7
# the above copyright notice appear in all copies and that both that
 
8
# copyright notice and this permission notice appear in supporting
 
9
# documentation.
 
10
#
 
11
# The above copyright notice and this permission notice shall be included
 
12
# in all copies or substantial portions of the Software.
 
13
#
 
14
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 
15
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 
16
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 
17
# IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 
18
# OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 
19
# ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 
20
# OTHER DEALINGS IN THE SOFTWARE.
 
21
#
 
22
# Except as contained in this notice, the name of a copyright holders shall
 
23
# not be used in advertising or otherwise to promote the sale, use or
 
24
# other dealings in this Software without prior written authorization
 
25
# from the copyright holders.
 
26
#
 
27
 
 
28
use strict;
 
29
use Cwd 'abs_path';
 
30
 
 
31
sub pegout($)
 
32
{
 
33
  print STDERR $_[0]."\n";
 
34
  exit 1;
 
35
}
 
36
 
 
37
sub relpath($$)
 
38
{
 
39
  my @src = split(/\//, abs_path(shift));
 
40
  my @dst = split(/\//, abs_path(shift));
 
41
  pop @dst;
 
42
  while (@src && @dst && $src[0] eq $dst[0]) {
 
43
    shift @src;
 
44
    shift @dst;
 
45
  }
 
46
  return "../"x@dst . join("/", @src);
 
47
}
 
48
 
 
49
sub getl()
 
50
{
 
51
  while (<INFILE>) {
 
52
    next if (/^#/);
 
53
    chop;
 
54
#    print "read: ".$_."\n";
 
55
    return;
 
56
  }
 
57
  $_ = "";
 
58
}
 
59
 
 
60
sub dedb($)
 
61
{
 
62
  my $t = shift;
 
63
  $t =~ s,</?(command|guilabel|quote|literal)>,\",g;
 
64
  $t =~ s,</?(acronym|envar|filename|option|systemitem( [^ >]+)?)>,,g;
 
65
  $t =~ s,<emphasis>([^<]+)</emphasis>,uc($1),ge;
 
66
  $t =~ s,&amp;,&,g;
 
67
  $t =~ s,&nbsp;, ,g;
 
68
  $t =~ s,&lt;,<,g;
 
69
  $t =~ s,&gt;,>,g;
 
70
  $t =~ s,&kdm;,KDM,g;
 
71
  $t =~ s,&XDMCP;,XDMCP,g;
 
72
  $t =~ s,&X-Server;,X-server,g;
 
73
  return $t;
 
74
}
 
75
 
 
76
sub mkvname($)
 
77
{
 
78
  my $v = shift;
 
79
  if ($v !~ /^[A-Z]{2}/) {
 
80
    $v = lcfirst $v;
 
81
  }
 
82
  return $v;
 
83
}
 
84
 
 
85
sub emit_conds($)
 
86
{
 
87
  my $ret = "";
 
88
  for my $c (keys %{$_[0]}) {
 
89
    my ($then, $else) = ("", "");
 
90
    for my $d (@{${$_[0]}{$c}}) {
 
91
      my $bas = "# define ".$d->[0];
 
92
      if ($d->[1] =~ /\n/) {
 
93
        $then .= $bas." \\\n".$d->[1]."\n";
 
94
      } else {
 
95
        $then .= $bas." ".$d->[1]."\n";
 
96
      }
 
97
      $else .= $bas."\n";
 
98
    }
 
99
    $ret .= "#if ".$c."\n".$then."#else\n".$else."#endif\n\n";
 
100
  }
 
101
  return $ret;
 
102
}
 
103
 
 
104
sub add_cond($$$$)
 
105
{
 
106
  if ($_[0]) {
 
107
    my $vn = uc($_[1]);
 
108
    for my $i (@{$_[2]}) {
 
109
      push @{${$_[3]}{$_[0]}}, [ $vn."_".$i->[1], $i->[0] ];
 
110
      $i->[0] = $vn."_".$i->[1];
 
111
    }
 
112
  }
 
113
}
 
114
 
 
115
my $do_doc = 0;
 
116
if ($ARGV[0] eq "--doc") {
 
117
 $do_doc = 1;
 
118
 shift @ARGV;
 
119
}
 
120
 
 
121
@ARGV != 2 && pegout("usage: $0 [--doc] <def-file> <out-file>");
 
122
 
 
123
open (INFILE, $ARGV[0]) || pegout("$0: cannot open definition file ".$ARGV[0]);
 
124
 
 
125
my %ex_conds = ();
 
126
my %ex_sects = ();  # $name -> $index
 
127
my @ex_config = ();  # ($name, $comment, $entries)
 
128
 
 
129
my $raw_out = "";
 
130
 
 
131
my %ov_enum_conds = ();
 
132
my $ov_enums = "";
 
133
my $ov_enum_defs = "";
 
134
 
 
135
my $ov_defaults = "";
 
136
 
 
137
my %arr_ov_vars = ();
 
138
my $ov_rd_sects = "";
 
139
my $ov_rd_ents = "";
 
140
 
 
141
my $ov_gen_sects = "";
 
142
my $ov_gen_ents = "";
 
143
my $max_prio = 0;
 
144
 
 
145
my %ov_sec_conds = ();
 
146
my %ov_ent_conds = ();
 
147
my $ov_sect_defs = "";
 
148
my $ov_sect_refs = "";
 
149
 
 
150
my %ov_glob_conds = ();
 
151
my $ov_globs = "";
 
152
my %ov_loc_conds = ();
 
153
my $ov_locs = "";
 
154
 
 
155
my %ov_glob_decl_conds = ();
 
156
my $ov_glob_decls = "";
 
157
my %ov_glob_defs = ();
 
158
my %ov_loc_def_conds = ();
 
159
my %ov_loc_defs = ();
 
160
 
 
161
my %ov_greet_decl_conds = ();
 
162
my %ov_greet_conds = ();
 
163
my $ov_greet_init = "";
 
164
my $ov_greet_init_qapp = "";
 
165
my @ov_greet_decls = ();
 
166
my %ov_greet_defs = ();
 
167
 
 
168
my %ov_xm_conds = ();
 
169
my @ov_xm = ("", "");
 
170
 
 
171
my %ov_km_conds = ();
 
172
my %ov_km = ();
 
173
 
 
174
my %sect_names = ();
 
175
my $sect = "";
 
176
my $sect_if;
 
177
 
 
178
my $key_if;
 
179
 
 
180
my %key_names;
 
181
 
 
182
my $kid_seq = 0x1000;
 
183
 
 
184
my $doc = "";
 
185
my $doc_ref = "";
 
186
 
 
187
sub emit_section()
 
188
{
 
189
  my $ts = $sect;
 
190
  $ts =~ s/-/_/;
 
191
  my @oa = (
 
192
    ["static Ent ents".$ts."[] = { \\\n".$ov_rd_ents."};", "ENTS"],
 
193
    ["static Ent ents".$ts."[] = { \\\n".$ov_gen_ents."};", "GENS"],
 
194
    ["sec".$ts." = { \"".$sect."\", ents".$ts.", as(ents".$ts.") },", "SEC"],
 
195
    ["&sec".$ts.",", "SECS"]
 
196
  );
 
197
  $ov_rd_ents = "";
 
198
  $ov_gen_ents = "";
 
199
  add_cond($sect_if, $ts, \@oa, \%ov_sec_conds);
 
200
  $ov_rd_sects .= " \\\n".$oa[0][0]." \\\n";
 
201
  $ov_gen_sects .= " \\\n".$oa[1][0]." \\\n";
 
202
  $ov_sect_defs .= "    ".$oa[2][0]." \\\n";
 
203
  $ov_sect_refs .= "\t".$oa[3][0]." \\\n";
 
204
  $doc_ref .= "</variablelist>\n</sect2>\n\n";
 
205
}
 
206
 
 
207
my %th = (
 
208
  "int" => [ "C_TYPE_INT", "", "int\t", "", "getCfgInt", "" ],
 
209
  "bool" => [ "C_TYPE_INT", " | C_BOOL", "int\t", "bool\t", "getCfgInt", "getCfgInt" ],
 
210
  "enum" => [ "C_TYPE_INT", " | C_ENUM", "int\t", "", "getCfgInt", "" ],
 
211
  "group" => [ "C_TYPE_INT", " | C_GRP", "int\t", "", "getCfgInt", "" ],
 
212
  "string" => [ "C_TYPE_STR", "", "char\t*", "QString\t", "getCfgStr", "getCfgQStr" ],
 
213
  "path" => [ "C_TYPE_STR", " | C_PATH", "char\t*", "QString\t", "getCfgStr", "getCfgQStr" ],
 
214
  "list" => [ "C_TYPE_ARGV", "", "char\t**", "QStringList\t", "getCfgStrArr", "getCfgQStrList" ]
 
215
);
 
216
 
 
217
my @tl = ("QFont\t*", "QStringList\t", "QString\t", "char\t**", "char\t*", "int\t", "bool\t");
 
218
 
 
219
sub init_defs($)
 
220
{
 
221
  for my $t (@tl) {
 
222
    $_[0]{$t} = "";
 
223
  }
 
224
}
 
225
 
 
226
init_defs(\%ov_glob_defs);
 
227
init_defs(\%ov_loc_defs);
 
228
init_defs(\%ov_greet_defs);
 
229
 
 
230
sub emit_defs($)
 
231
{
 
232
  my $ret = "";
 
233
  for my $t (@tl) {
 
234
    $ret .= $_[0]{$t};
 
235
  }
 
236
  return $ret;
 
237
}
 
238
 
 
239
while (<INFILE>) {
 
240
  chop;
 
241
  if (/^<code>$/) {
 
242
    while (<INFILE>) {
 
243
      last if (/^<\/code>\n$/);
 
244
      $raw_out .= $_;
 
245
    }
 
246
  } elsif (/^<kdmrc>$/) {
 
247
    my $comm = "";
 
248
    while (<INFILE>) {
 
249
      last if (/^<\/kdmrc>\n$/);
 
250
      chop;
 
251
      if (/^\[(.*)\]$/) {
 
252
        defined($ex_sects{$1}) &&
 
253
          pegout("redefinition of example section [$1]");
 
254
        push @ex_config, [$1, dedb($comm), "", ""];
 
255
        $ex_sects{$1} = $#ex_config;
 
256
        $comm = "";
 
257
      } else {
 
258
        if (!$_) {
 
259
          $comm .= " \\\n\"\\n\"";
 
260
        } elsif ($_ eq " _") {
 
261
          $comm .= " \\\n\"#\\n\"";
 
262
        } else {
 
263
          s/"/\\"/g;
 
264
          $comm .= " \\\n\"#".$_."\\n\"";
 
265
        }
 
266
      }
 
267
    }
 
268
  } elsif (/^<docu>$/) {
 
269
    while (<INFILE>) {
 
270
      last if (/^<\/docu>\n$/);
 
271
      $doc .= $_;
 
272
    }
 
273
  } elsif (/^<legacy>$/) {
 
274
    while (<INFILE>) {
 
275
      next if (/^($|#)/);
 
276
      my ($proc, $kif);
 
277
      if (/^If: (.+)$/) {
 
278
        $kif = $1;
 
279
        getl();
 
280
      } else {
 
281
        $kif = "";
 
282
      }
 
283
      if (/^Proc: (.+)$/) {
 
284
        $proc = $1;
 
285
        getl();
 
286
      } else {
 
287
        pegout("expecting Proc keyword in legacy section");
 
288
      }
 
289
      my $nsrc = 0;
 
290
      my $mcnt = 0;
 
291
      while (/^Source: (.+)$/) {
 
292
        my $src = $1;
 
293
        if ($src =~ /^xdm:(.*)$/) {
 
294
          my $what = $1;
 
295
          my $dsp = ($what =~ s/^\*\.//);
 
296
          my @oa = ([ "{ \"".$what."\", (char *)-1, 0, ".$proc." },", "XMO" ]);
 
297
          add_cond($kif, $what, \@oa, \%ov_xm_conds);
 
298
          $ov_xm[$dsp] .= $oa[0][0]." \\\n";
 
299
        } elsif ($src =~ /^kdm:(.*)\/(.*)$/) {
 
300
          my ($sec, $key) = ($1, $2);
 
301
          my @oa = ([ "{ \"".$key."\", (char *)-1, 0, ".$proc." },", "KMO".($mcnt++) ]);
 
302
          add_cond($kif, $key, \@oa, \%ov_km_conds);
 
303
          $ov_km{$sec} .= $oa[0][0]." \\\n";
 
304
        } else {
 
305
          pegout("invalid legacy option '$_'");
 
306
        }
 
307
        $nsrc++;
 
308
        getl();
 
309
      }
 
310
      $nsrc || pegout("no sources for legacy processor ".$proc);
 
311
      last if (/^<\/legacy>$/);
 
312
      pegout("unidentified section body '".$_."' in legacy section") if ($_);
 
313
    }
 
314
  } else {
 
315
    next if (/^($|#)/);
 
316
    if (/^Key: (.+)$/) {
 
317
      my $key = $1;
 
318
      $sect || pegout("defining key ".$key." outside any section");
 
319
      defined($key_names{$key}) &&
 
320
        pegout("redefinition of key ".$key." in section [".$sect."]");
 
321
      $key_names{$key} = "";
 
322
      getl();
 
323
      if (/^If: (.+)$/) {
 
324
        $key_if = $1;
 
325
        getl();
 
326
      } else {
 
327
        $key_if = "";
 
328
      }
 
329
      my $kif = $sect_if ?
 
330
        ($key_if ? "(".$sect_if.") && (".$key_if.")" : $sect_if) : $key_if;
 
331
      my ($e_comm, $e_desc) = ("", "");
 
332
      my $type = "";
 
333
      if (/^Type: (.+)$/) {
 
334
        $type = $1;
 
335
        if ($type eq "enum") {
 
336
          my $enum = "static const char *e".$key."[] = { ";
 
337
          my $n_e_def = 0;
 
338
          while (getl(), /^ (\w+)(\/(\w+))?: (.+)$/) {
 
339
            my $e_nam = $1;
 
340
            $enum .= "\"".$e_nam."\", ";
 
341
            defined($3) &&
 
342
              ($ov_enum_defs .= "#define ".$3." ".($n_e_def++)."\n");
 
343
            my ($comm, $desc) = (dedb($4), $4);
 
344
            $comm =~ s/\"/\\\"/g;
 
345
            $e_comm .= " \\\n\"# \\\"".$e_nam."\\\" - ".$comm."\\n\"";
 
346
            $e_desc .=
 
347
              "<varlistentry>\n".
 
348
              "<term><parameter>".$e_nam."</parameter></term>\n".
 
349
              "<listitem><para>".$desc."</para></listitem>\n".
 
350
              "</varlistentry>\n";
 
351
          }
 
352
          $enum .= "0 };";
 
353
          my @oa = ( [ $enum, "ENUM" ] );
 
354
          add_cond($kif, $key, \@oa, \%ov_enum_conds);
 
355
          $ov_enums .= $oa[0][0]." \\\n";
 
356
          $n_e_def && ($ov_enum_defs .= "\n");
 
357
        } elsif ($type =~ /^(int|bool|group|string|path|list)$/) {
 
358
          getl();
 
359
        } else {
 
360
          pegout("unknown Type ".$type." for key ".$key." in section [".$sect."]");
 
361
        }
 
362
      } else {
 
363
        pegout("expecting Type for key ".$key." in section [".$sect."]");
 
364
      }
 
365
      my ($odflt, $dflt, $cdflt, $ddflt);
 
366
      my $quot = ($type =~ /^(int|bool|enum|group)$/);
 
367
      if (/^Default: (\*?)(.+)$/) {
 
368
        my $defd = $1;
 
369
        ($odflt, $dflt) = ($2, $2);
 
370
        $quot && ($dflt = "\"".$dflt."\"");
 
371
        $defd && ($ov_defaults .= "#define def_".$key." ".$dflt."\n");
 
372
        getl();
 
373
      } else {
 
374
        pegout("expecting Default for key ".$key." in section [".$sect."]");
 
375
      }
 
376
      if (/^CDefault: (.+)$/) {
 
377
        if ($1 eq "-") {
 
378
          $ddflt =
 
379
          $cdflt = "";
 
380
        } else {
 
381
          $ddflt =
 
382
          $cdflt = $1;
 
383
          $cdflt =~ s/"/\\"/g;
 
384
          $cdflt = " \\\n\"# Default is ".$cdflt."\\n\"";
 
385
        }
 
386
        getl();
 
387
      } else {
 
388
        $ddflt = $odflt;
 
389
        if ($quot) {
 
390
          $cdflt = " \\\n\"# Default is ".$odflt."\\n\"";
 
391
        } else {
 
392
          $cdflt = " \\\n\"# Default is \\\"\" ".$dflt." \"\\\"\\n\"";
 
393
        }
 
394
      }
 
395
      if (/^DDefault: -$/) {
 
396
        $ddflt = "";
 
397
        getl();
 
398
      }
 
399
      my $pproc;
 
400
      if (/^PostProc: (.+)$/) {
 
401
        $pproc = $1;
 
402
        getl();
 
403
      } else {
 
404
        $pproc = "";
 
405
      }
 
406
      my $nusers = 0;
 
407
      my ($vname, $kid, $xkid, $ctype, $cpptype, $cget, $cppget);
 
408
      while (/^User: (.+)$/) {
 
409
        my $user = $1;
 
410
        if ($user eq "dummy") {
 
411
          $vname = "dummy";
 
412
          $kid = "C_INTERNAL | C_TYPE_STR";
 
413
          $xkid = "";
 
414
        } elsif ($user =~ s/^(core|greeter|greeter-c|dep|config)(\((.+)\))?(:font)?$/$1/) {
 
415
          my ($hvn, $isfn) = (defined($3) ? $3 : mkvname($key), $4);
 
416
          ($kid, $xkid, $ctype, $cpptype, $cget, $cppget) = @{$th{$type}};
 
417
          $kid = sprintf "%#x | %s", $kid_seq, $kid;
 
418
          if ($user eq "dep") {
 
419
            $vname = $hvn;
 
420
            $xkid .= " | C_INTERNAL";
 
421
          } elsif ($user eq "config") {
 
422
            $vname = $hvn;
 
423
            $xkid .= " | C_INTERNAL | C_CONFIG";
 
424
          } else {
 
425
            $vname = "";
 
426
            if ($user eq "core") {
 
427
              if ($sect =~ /^-/) {
 
428
                my @oa = (
 
429
                  [ "{ ".$kid.", boffset(".$hvn.") },", "LOC" ],
 
430
                );
 
431
                add_cond($kif, $hvn, \@oa, \%ov_loc_conds);
 
432
                $ov_locs .= " \\\n".$oa[0][0];
 
433
 
 
434
                @oa = (
 
435
                  [ $ctype.$hvn.";", "LDEF" ]
 
436
                );
 
437
                add_cond($kif, $hvn, \@oa, \%ov_loc_def_conds);
 
438
                $ov_loc_defs{$ctype} .= " \\\n\t".$oa[0][0];
 
439
              } else {
 
440
                my @oa = (
 
441
                  [ "{ ".$kid.", &".$hvn." },", "GLOB" ],
 
442
                  [ $ctype.$hvn.";", "GDEF" ],
 
443
                );
 
444
                add_cond($kif, $hvn, \@oa, \%ov_glob_conds);
 
445
                $ov_globs .= " \\\n".$oa[0][0];
 
446
                $ov_glob_defs{$ctype} .= " \\\n".$oa[1][0];
 
447
 
 
448
                @oa = (
 
449
                  [ "extern ".$ctype.$hvn.";", "GDECL" ]
 
450
                );
 
451
                add_cond($kif, $hvn, \@oa, \%ov_glob_decl_conds);
 
452
                $ov_glob_decls .= " \\\n".$oa[0][0];
 
453
              }
 
454
            } else { # greeter(-c)?
 
455
              my ($typ, $gtr, $isc, $qapp);
 
456
              if ($isfn) {
 
457
                $typ = "QFont\t*";
 
458
                $gtr = "str2Font( getCfgQStr( ".$kid." ) )";
 
459
                $isc = 0;
 
460
                $qapp = 1;
 
461
              } elsif ($user eq "greeter" && $cppget) {
 
462
                $typ = $cpptype;
 
463
                $gtr = $cppget."( ".$kid." )";
 
464
                $isc = 0;
 
465
                $qapp = 0;
 
466
              } else {
 
467
                $typ = $ctype;
 
468
                $gtr = $cget."( ".$kid.(($type eq "list") ? ", 0" : "")." )";
 
469
                $isc = 1;
 
470
                $qapp = 0;
 
471
              }
 
472
              my @oa = (
 
473
                [ "_".$hvn." = ".$gtr.";", "GRINIT" ],
 
474
                [ $typ."_".$hvn.";", "GRDEF" ],
 
475
              );
 
476
              add_cond($kif, $hvn, \@oa, \%ov_greet_conds);
 
477
              if ($qapp) {
 
478
                  $ov_greet_init_qapp .= " \\\n    ".$oa[0][0];
 
479
              } else {
 
480
                  $ov_greet_init .= " \\\n    ".$oa[0][0];
 
481
              }
 
482
              $ov_greet_defs{$typ} .= " \\\n".$oa[1][0];
 
483
 
 
484
              @oa = (
 
485
                [ "extern ".$typ."_".$hvn.";", "GRDECL" ]
 
486
              );
 
487
              add_cond($kif, $hvn, \@oa, \%ov_greet_decl_conds);
 
488
              $ov_greet_decls[$isc] .= " \\\n".$oa[0][0];
 
489
            }
 
490
          }
 
491
        } else {
 
492
          pegout("unrecognized User '".$user."' for key ".$key." in section [".$sect."]");
 
493
        }
 
494
        $nusers++;
 
495
        getl();
 
496
      }
 
497
      $nusers || pegout("expecting User for key ".$key." in section [".$sect."]");
 
498
      my $ninsts = 0;
 
499
      while (/^Instance: ?(.*)$/) {
 
500
        my $inst = $1;
 
501
        if ($inst ne "-") {
 
502
          my $on = 1 - ($inst =~ s/^#//);
 
503
          my $sec;
 
504
          if ($sect =~ /^-/) {
 
505
            ($inst =~ s/^([^\/]+)\///) || pegout("instance for key ".$key." in section [".$sect."] does not specify display");
 
506
            $sec = "X-".$1.$sect;
 
507
          } else {
 
508
            $sec = $sect;
 
509
          }
 
510
          if ($type eq "bool" && $inst eq "!") {
 
511
            $inst = ($dflt eq "\"true\"") ? "\"false\"" : "\"true\"";
 
512
          } elsif (!$inst) {
 
513
            $inst = $dflt;
 
514
          } else {
 
515
            $quot && ($inst = "\"".$inst."\"");
 
516
          }
 
517
          defined($ex_sects{$sec}) ||
 
518
            pegout("instantiating key ".$key." in section [".$sect."] in undeclared section");
 
519
          my @oa = ( [ "{ \"".$key."\",\t".$inst.", ".$on." },", "INST" ] );
 
520
          add_cond($key_if, $key, \@oa, \%ex_conds);
 
521
          $ex_config[$ex_sects{$sec}][2] .= $oa[0][0]." \\\n";
 
522
          $ex_config[$ex_sects{$sec}][3] = $sect_if;
 
523
        }
 
524
        $ninsts++;
 
525
        getl();
 
526
      }
 
527
      $ninsts ||
 
528
        print STDERR "Warning: key ".$key." in section [".$sect."] not instanciated\n";
 
529
      my ($update, $prio) = ("0", "");
 
530
      if (/^Update: ([^\/]+)(\/(\d+))?$/) {
 
531
        ($update, $prio) = ($1, $3);
 
532
        getl();
 
533
      }
 
534
      if ($prio) {
 
535
        ($max_prio < $prio) && ($max_prio = $prio);
 
536
      } else {
 
537
        $prio = 0;
 
538
      }
 
539
      my $mcnt = 0;
 
540
      while (/^Merge: (.+)$/) {
 
541
        my $merge = $1;
 
542
        if ($merge =~ /^xdm(:([^\(]+))?(\((.+)\))?$/) {
 
543
          my ($what, $proc) = ($2, $4);
 
544
          my @oa = (
 
545
            [ "{ \"".($what ? $what : lcfirst($key))."\", ".
 
546
              "\"".(($sect =~ /^-/) ? "X-%s" : "").$sect."\", ".
 
547
              ($what ? "\"".$key."\"" : "0").", ".
 
548
              ($proc ? $proc : "0")." },", "XM" ]
 
549
          );
 
550
          add_cond($kif, $key, \@oa, \%ov_xm_conds);
 
551
          $ov_xm[$sect =~ /^-/] .= $oa[0][0]." \\\n";
 
552
        } elsif ($merge =~ /^kdm:([^\(]+)(\((.+)\))?$/) {
 
553
          my ($where, $func) = ($1, $3);
 
554
          my $sec = "";
 
555
          ($where =~ s/^([^\/]+)\///) && ($sec = $1);
 
556
          my @oa = (
 
557
            [ "{ \"".($where ? $where : $key)."\", ".
 
558
              ($sec ? "\"".$sect."\"" : "0").", ".
 
559
              ($where ? "\"".$key."\"" : "0").", ".
 
560
              ($func ? $func : "0")." },", "KM".($mcnt++) ]
 
561
          );
 
562
          add_cond($kif, $key, \@oa, \%ov_km_conds);
 
563
          $ov_km{$sec ? $sec : $sect} .= $oa[0][0]." \\\n";
 
564
        } else {
 
565
          pegout("bogus Merge '".$merge."' for key ".$key." in section [".$sect."]");
 
566
        }
 
567
        getl();
 
568
      }
 
569
      # todo: handle $func here, too
 
570
      my @oa = ( [ "{ \"".$key."\", 0, 0, 0 },", "KM" ] );
 
571
      add_cond($kif, $key, \@oa, \%ov_km_conds);
 
572
      $ov_km{$sect} .= $oa[0][0]." \\\n";
 
573
      my $comm = "";
 
574
      if (/^Comment:(( [-&])?)$/) {
 
575
        if ($1 eq " &") {
 
576
          $comm = "&";
 
577
          getl();
 
578
        } elsif ($1 ne " -") {
 
579
          while (getl(), /^ (.*)$/) {
 
580
            $comm .= $1."\n";
 
581
          }
 
582
          $comm ||
 
583
            print STDERR "Warning: key ".$key." in section [".$sect."] has empty Comment\n";
 
584
        } else {
 
585
          getl();
 
586
        }
 
587
      } else {
 
588
        print STDERR "Warning: key ".$key." in section [".$sect."] has no Comment\n";
 
589
      }
 
590
      if (/^Description:(( [-!])?)$/) {
 
591
        if ($1 ne " -") {
 
592
          $doc_ref .=
 
593
            "<varlistentry>\n".
 
594
            "<term id=\"option-".lc($key)."\"><option>".$key."</option></term>\n".
 
595
            "<listitem>\n";
 
596
          ($1 eq " !") &&
 
597
            ($e_desc = "");
 
598
          my $desc = "";
 
599
          while (getl(), /^ (_|(.*))$/) {
 
600
            $desc .= $2."\n";
 
601
          }
 
602
          $desc ||
 
603
            print STDERR "Warning: key ".$key." in section [".$sect."] has empty Description\n";
 
604
          ($comm eq "&") &&
 
605
            ($comm = $desc);
 
606
          $desc = "<para>\n".$desc."</para>\n";
 
607
          if ($e_desc) {
 
608
            $e_desc = "<variablelist>\n".$e_desc."</variablelist>\n";
 
609
            ($desc =~ s/%ENUM%/$e_desc/) ||
 
610
              ($desc .= $e_desc);
 
611
          }
 
612
          $doc_ref .= $desc;
 
613
          if ($ddflt) {
 
614
            if ($ddflt eq '""') {
 
615
              $doc_ref .= "<para>Empty by default.</para>\n";
 
616
            } else {
 
617
              $ddflt =~ s/\"//g;
 
618
              $ddflt =~ s,KDMCONF ,\${<envar>kde_confdir</envar>}/kdm,;
 
619
              $ddflt =~ s,KDMDATA ,\${<envar>kde_datadir</envar>}/kdm,;
 
620
              $ddflt =~ s,XBINDIR ,\${<envar>x_bindir</envar>},;
 
621
              $doc_ref .= "<para>The default is <quote>".$ddflt."</quote>.</para>\n";
 
622
            }
 
623
          }
 
624
          $doc_ref .= "</listitem>\n</varlistentry>\n\n";
 
625
        } else {
 
626
          getl();
 
627
        }
 
628
      } else {
 
629
        print STDERR "Warning: key ".$key." in section [".$sect."] has no Description\n";
 
630
      }
 
631
      pegout("unidentified section body '".$_."' in section [".$sect."]") if ($_);
 
632
      if ($vname) {
 
633
        ($vname ne "dummy") &&
 
634
          ($arr_ov_vars{$vname} = $kif);
 
635
        $vname = "&V".$vname;
 
636
      } elsif ($pproc) {
 
637
        $vname = "(void *)".$pproc;
 
638
      } elsif ($type eq "enum") {
 
639
        $vname = "e".$key;
 
640
      } else {
 
641
        $vname = "0";
 
642
      }
 
643
      $comm = dedb($comm);
 
644
      $comm =~ s/"/\\"/g;
 
645
      $comm =~ s/([^\n]*)\n/ \\\n\"# $1\\n\"/g;
 
646
      @oa = (
 
647
        [ "{ \"".$key."\", ".$kid.$xkid.", ".$vname.", ".$dflt." },", "RENT" ],
 
648
        [ "{ \"".$key."\", ".$prio.", ".$update.",".$comm.$e_comm.$cdflt." },", "GENT" ],
 
649
      );
 
650
      add_cond($key_if, $key, \@oa, \%ov_ent_conds);
 
651
      $ov_rd_ents .= $oa[0][0]." \\\n";
 
652
      $ov_gen_ents .= $oa[1][0]." \\\n";
 
653
      $kid_seq++;
 
654
    } elsif (/^Section: (.+)$/) {
 
655
      emit_section() if ($sect);
 
656
      $sect = $1;
 
657
      defined($sect_names{$sect}) && pegout("redefinition of section [".$sect."]");
 
658
      $sect_names{$sect} = "";
 
659
      %key_names = ();
 
660
      getl();
 
661
      if (/^If: (.+)$/) {
 
662
        $sect_if = $1;
 
663
        getl();
 
664
      } else {
 
665
        $sect_if = "";
 
666
      }
 
667
      my ($sref, $stit, $sna);
 
668
      if ($sect =~ /^-(.*)$/) {
 
669
        $sref = lc($1);
 
670
        $stit = "X-*-".$1;
 
671
        $sna = "section class";
 
672
      } else {
 
673
        $sref = lc($sect);
 
674
        $stit = $sect;
 
675
        $sna = "section";
 
676
      }
 
677
      $doc_ref .=
 
678
        "\n<sect2 id=\"kdmrc-".$sref."\">\n".
 
679
        "<title>The [".$stit."] ".$sna." of &kdmrc;</title>\n\n";
 
680
      if (/^Description:(( -)?)$/) {
 
681
        if ($1 ne " -") {
 
682
          my $desc = 0;
 
683
          $doc_ref .= "<para>\n";
 
684
          while (getl(), /^ (_|(.*))$/) {
 
685
            $doc_ref .= $2."\n";
 
686
            $desc = 1;
 
687
          }
 
688
          $doc_ref .= "</para>\n";
 
689
          $desc ||
 
690
            print STDERR "Warning: section [".$sect."] has empty Description\n";
 
691
        } else {
 
692
          getl();
 
693
        }
 
694
      } else {
 
695
        print STDERR "Warning: section [".$sect."] has no Description\n";
 
696
      }
 
697
      $doc_ref .= "\n<variablelist>\n\n";
 
698
      pegout("unidentified section body '".$_."' in section [".$sect."]") if ($_);
 
699
    } else {
 
700
      pegout("invalid section leadin: '".$_."'");
 
701
    }
 
702
  }
 
703
}
 
704
emit_section();
 
705
close INFILE;
 
706
 
 
707
my $srcf = relpath($ARGV[0], $ARGV[1]);
 
708
my $exen = relpath($0, $ARGV[1]);
 
709
 
 
710
open (OUTFILE, ">".$ARGV[1]) || pegout("$0: cannot create output file ".$ARGV[1]);
 
711
 
 
712
if (!$do_doc) {
 
713
 
 
714
print OUTFILE
 
715
  "/* generated from $srcf by $exen - DO NOT EDIT! */\n\n".
 
716
  "#ifndef CONFIG_DEFS\n".
 
717
  "#define CONFIG_DEFS\n\n".
 
718
  $raw_out."\n\n".
 
719
  "#endif /* CONFIG_DEFS */\n\n\n";
 
720
 
 
721
print OUTFILE
 
722
  "#if (defined(WANT_CORE_DECLS) || defined(WANT_GREET_DECLS)) && !defined(CONF_ENUMS_DEFINED)\n".
 
723
  "#define CONF_ENUMS_DEFINED\n\n".
 
724
  $ov_enum_defs."\n".
 
725
  "#endif\n\n\n";
 
726
 
 
727
print OUTFILE
 
728
  "#if (defined(WANT_CONF_READ) || defined(WANT_CONF_GEN)) && !defined(CONF_SECTS)\n\n".
 
729
  emit_conds(\%ov_ent_conds).
 
730
  emit_conds(\%ov_sec_conds).
 
731
  "#define CONF_SECTS \\\n \\\n".
 
732
  "static Sect \\\n".
 
733
    $ov_sect_defs.
 
734
  "    *allSects[]\t= { \\\n".
 
735
    $ov_sect_refs.
 
736
  "    };\n\n".
 
737
  "#endif\n\n\n";
 
738
 
 
739
######### config reader definitions #########
 
740
 
 
741
print OUTFILE
 
742
  "#if defined(WANT_CONF_READ) && !defined(CONF_READ_DEFINED)\n".
 
743
  "#define CONF_READ_DEFINED\n\n";
 
744
 
 
745
my $ov_vars = "";
 
746
my %ov_var_conds = ();
 
747
for my $v (keys %arr_ov_vars) {
 
748
  my @oa = ( ["V".$v.",", "VAR"] );
 
749
  add_cond($arr_ov_vars{$v}, $v, \@oa, \%ov_var_conds);
 
750
  $ov_vars .= "    ".$oa[0][0]." \\\n";
 
751
}
 
752
print OUTFILE
 
753
  emit_conds(\%ov_var_conds).
 
754
  "#define CONF_READ_VARS \\\n \\\n".
 
755
  "static Value \\\n".
 
756
    $ov_vars.
 
757
    "    Vdummy;\n\n\n";
 
758
 
 
759
print OUTFILE
 
760
  emit_conds(\%ov_enum_conds).
 
761
  "#define CONF_READ_ENTRIES \\\n \\\n".
 
762
  $ov_enums.
 
763
  $ov_rd_sects." \\\n".
 
764
  "CONF_SECTS\n\n\n";
 
765
 
 
766
print OUTFILE
 
767
  "#endif /* WANT_CONF_READ */\n\n\n";
 
768
 
 
769
######### core definitions #########
 
770
 
 
771
print OUTFILE
 
772
  "#if defined(WANT_CORE_DECLS) && !defined(CONF_CORE_GLOBAL_DECLS)\n\n".
 
773
  emit_conds(\%ov_glob_decl_conds).
 
774
  "#define CONF_CORE_GLOBAL_DECLS \\\n".
 
775
  $ov_glob_decls."\n\n\n".
 
776
  emit_conds(\%ov_loc_def_conds).
 
777
  "#define CONF_CORE_LOCAL_DEFS \\\n".
 
778
  emit_defs(\%ov_loc_defs)."\n\n\n".
 
779
  "#endif /* WANT_CORE_DECLS */\n\n\n";
 
780
 
 
781
print OUTFILE
 
782
  "#if defined(WANT_CORE_DEFS) && !defined(CONF_CORE_GLOBAL_DEFS)\n\n".
 
783
  emit_conds(\%ov_glob_conds).
 
784
  "#define CONF_CORE_GLOBALS \\\n".
 
785
  $ov_globs."\n\n\n".
 
786
  "#define CONF_CORE_GLOBAL_DEFS \\\n".
 
787
  emit_defs(\%ov_glob_defs)."\n\n".
 
788
  emit_conds(\%ov_loc_conds).
 
789
  "#define CONF_CORE_LOCALS \\\n".
 
790
  $ov_locs."\n\n\n".
 
791
  "#endif /* WANT_CORE_DEFS */\n\n\n";
 
792
 
 
793
######### greeter definitions #########
 
794
 
 
795
print OUTFILE
 
796
  "#if defined(WANT_GREET_DECLS) && !defined(CONF_GREET_C_DECLS)\n\n".
 
797
  emit_conds(\%ov_greet_decl_conds).
 
798
  "#define CONF_GREET_C_DECLS \\\n".
 
799
  $ov_greet_decls[1]."\n\n\n".
 
800
  "#define CONF_GREET_CPP_DECLS \\\n".
 
801
  $ov_greet_decls[0]."\n\n\n".
 
802
  "#endif /* WANT_GREET_DECLS */\n\n\n";
 
803
 
 
804
print OUTFILE
 
805
  "#if defined(WANT_GREET_DEFS) && !defined(CONF_GREET_DEFS)\n\n".
 
806
  emit_conds(\%ov_greet_conds).
 
807
  "#define CONF_GREET_INIT \\\n".
 
808
  $ov_greet_init."\n\n\n".
 
809
  "#define CONF_GREET_INIT_QAPP \\\n".
 
810
  $ov_greet_init_qapp."\n\n\n".
 
811
  "#define CONF_GREET_DEFS \\\n".
 
812
  emit_defs(\%ov_greet_defs)."\n\n".
 
813
  "#endif /* WANT_GREET_DEFS */\n\n\n";
 
814
 
 
815
######### genkdmconf definitions #########
 
816
 
 
817
print OUTFILE
 
818
  "#if defined(WANT_CONF_GEN) && !defined(CONF_GEN_DEFINED)\n".
 
819
  "#define CONF_GEN_DEFINED\n\n";
 
820
 
 
821
print OUTFILE
 
822
  $ov_defaults."\n";
 
823
 
 
824
print OUTFILE
 
825
  "#define CONF_MAX_PRIO ".$max_prio."\n\n".
 
826
  "#define CONF_GEN_ENTRIES \\\n".
 
827
  $ov_gen_sects." \\\n".
 
828
  "CONF_SECTS\n\n\n";
 
829
 
 
830
my ($ov1, $ov2) = ("", "");
 
831
my %ex_sec_conds = ();
 
832
for my $i (@ex_config) {
 
833
  my $vn;
 
834
  if ($i->[0] =~ /^X-(.+)-(.+)$/) {
 
835
    if ($1 eq "*") {
 
836
      $vn = "dEntsAny".$2;
 
837
    } elsif ($1 eq ":*") {
 
838
      $vn = "dEntsLocal".$2;
 
839
    } else {
 
840
      my ($t1, $t2) = ($1, $2);
 
841
      $t1 =~ s/[-:]/_/g;
 
842
      $vn = "dEnts".$t1.$t2;
 
843
    }
 
844
  } else {
 
845
    $vn = "dEnts".$i->[0];
 
846
  }
 
847
  my @oa = (
 
848
    [ "static DEnt ".$vn."[] = { \\\n".$i->[2]."};", "DSEC" ],
 
849
    [ "{ \"".$i->[0]."\",\t".$vn.",\tas(".$vn."),".$i->[1]." },", "DSECS" ]
 
850
  );
 
851
  add_cond($i->[3], $vn, \@oa, \%ex_sec_conds);
 
852
  $ov1 .= $oa[0][0]." \\\n \\\n";
 
853
  $ov2 .= $oa[1][0]." \\\n";
 
854
}
 
855
print OUTFILE
 
856
  emit_conds(\%ex_conds).
 
857
  emit_conds(\%ex_sec_conds).
 
858
  "#define CONF_GEN_EXAMPLE \\\n \\\n".
 
859
  $ov1.
 
860
  "static DSect dAllSects[] = { \\\n".
 
861
    $ov2.
 
862
  "};\n\n\n";
 
863
 
 
864
print OUTFILE
 
865
  emit_conds(\%ov_xm_conds).
 
866
  "#define CONF_GEN_XMERGE \\\n \\\n".
 
867
  "XResEnt globents[] = { \\\n".
 
868
  $ov_xm[0].
 
869
  "}, dpyents[] = { \\\n".
 
870
  $ov_xm[1].
 
871
  "};\n\n\n";
 
872
 
 
873
my $ov_km_sects = "";
 
874
my $ov_km_sect_refs = "";
 
875
for my $s (keys %ov_km) {
 
876
  my $ts = $s;
 
877
  $ts =~ s/-/_/;
 
878
  $ov_km_sects .=
 
879
    "KUpdEnt upd".$ts."[] = { \\\n".
 
880
    $ov_km{$s}.
 
881
    "}; \\\n \\\n";
 
882
  $ov_km_sect_refs .= "{ \"".$s."\", upd".$ts.", as(upd".$ts.") }, \\\n";
 
883
}
 
884
print OUTFILE
 
885
  emit_conds(\%ov_km_conds).
 
886
  "#define CONF_GEN_KMERGE \\\n \\\n".
 
887
  $ov_km_sects.
 
888
  "KUpdSec kupsects[] = { \\\n".
 
889
  $ov_km_sect_refs.
 
890
  "};\n\n\n";
 
891
 
 
892
print OUTFILE
 
893
  "#endif /* WANT_CONF_GEN */\n";
 
894
 
 
895
} else {
 
896
 
 
897
$doc =~ s/%REF%/$doc_ref/;
 
898
print OUTFILE
 
899
  "<!-- generated from $srcf - DO NOT EDIT! -->\n\n".
 
900
  $doc;
 
901
 
 
902
}
 
903
 
 
904
close OUTFILE;