w3m-doc/sample/w3mdoc.pl

   1 #!/usr/local/bin/perl
   2
   3 package w3mdoc;
   4
   5 sub CHECK {
   6   my($a, @b) = @_;
   7   for(@b) {
   8     defined($a->{$_}) || die("\"$a->{id}.$_\" is not defined.\n");
   9   }
  10 }
  11
  12 sub DEF {
  13   my($a, $b, $c) = @_;
  14
  15   if (! defined($data->{$a})) {
  16      $data->{$a} = bless { id => $a };
  17   }
  18   $data->{$a}{$b} = $c;
  19 }
  20
  21 sub SUB {
  22   local($_) = @_;
  23   my($a, $b);
  24
  25   if (/^\@(\w+)\.(\w+)\@$/) {
  26     ($a, $b) = ($1, $2);
  27     defined($data->{$a}) || die("\"$a.$b\" is not defined.\n");
  28     $data->{$a}->CHECK($b);
  29     return $data->{$a}{$b};
  30   }
  31   if (/^\@(\w+)\((\w+)\)\@$/) {
  32     ($a, $b) = ($1, $2);
  33     defined(&{$a}) || die("\"$a()\" is not defined.\n");
  34     defined($data->{$b}) || die("\"$a($b)\" is not defined.\n");
  35     return $data->{$b}->$a();
  36   }
  37   return '@';
  38 }
  39
  40 package main;
  41
  42 @ARGV || unshift(@ARGV, "-");
  43 while(@ARGV) {
  44   $file = shift @ARGV;
  45   &make_doc($file);
  46 }
  47
  48 sub make_doc {
  49   my($file) = @_;
  50   my($in_def, $in_code, $code, $a, $b);
  51   local(*F);
  52   local($_);
  53
  54   open(F, $file) || die("$file: $!\n");
  55   $in_def = 0;
  56   $in_code = 0;
  57   while(<F>) {
  58     if ($in_def) {
  59       if (/^\@end/) {
  60         $in_def = 0;
  61         next;
  62       }
  63       s/^\s+//;
  64       s/^(\w+)\.(\w+)// || next;
  65       ($a, $b) = ($1, $2);
  66       s/^\s+//;
  67       s/\s+$//;
  68       &w3mdoc::DEF($a, $b, $_);
  69       next;
  70     }
  71     if ($in_code) {
  72       if (/^\@end/) {
  73         eval "package w3mdoc; $code";
  74         $in_code = 0;
  75         next;
  76       }
  77       $code .= $_;
  78       next;
  79     }
  80     if (/^\@define/) {
  81       $in_def = 1;
  82       next;
  83     }
  84     if (/^\@code/) {
  85       $in_code = 1;
  86       $code = "";
  87       next;
  88     }
  89     if (s/^\@include\s+//) {
  90       s/\s+$//;
  91       &make_doc($_);
  92       next;
  93     }
  94     if (/^\@/) {
  95       die("unknown command: $_");
  96     }
  97     s/(\\@|\@(\w+(\.\w+|\(\w+\)))\@)/&w3mdoc::SUB($1)/eg;
  98     print;
  99   }
 100   close(F);
 101 }
 102