Adding upstream version 0.5.1upstream/0.5.1

1 files changed, 102 insertions, 0 deletions

diff --git a/w3m-doc/sample/w3mdoc.pl b/w3m-doc/sample/w3mdoc.pl
new file mode 100755
index 0000000..6097926
--- /dev/null
+++ b/w3m-doc/sample/w3mdoc.pl
@@ -0,0 +1,102 @@
+#!/usr/local/bin/perl
+
+package w3mdoc;
+
+sub CHECK {
+  my($a, @b) = @_;
+  for(@b) {
+    defined($a->{$_}) || die("\"$a->{id}.$_\" is not defined.\n");
+  }
+}
+
+sub DEF {
+  my($a, $b, $c) = @_;
+
+  if (! defined($data->{$a})) {
+     $data->{$a} = bless { id => $a };
+  } 
+  $data->{$a}{$b} = $c;
+}
+
+sub SUB {
+  local($_) = @_;
+  my($a, $b);
+
+  if (/^\@(\w+)\.(\w+)\@$/) {
+    ($a, $b) = ($1, $2);
+    defined($data->{$a}) || die("\"$a.$b\" is not defined.\n");
+    $data->{$a}->CHECK($b);
+    return $data->{$a}{$b};
+  }
+  if (/^\@(\w+)\((\w+)\)\@$/) {
+    ($a, $b) = ($1, $2);
+    defined(&{$a}) || die("\"$a()\" is not defined.\n");
+    defined($data->{$b}) || die("\"$a($b)\" is not defined.\n");
+    return $data->{$b}->$a();
+  }
+  return '@';
+}
+
+package main;
+
+@ARGV || unshift(@ARGV, "-");
+while(@ARGV) {
+  $file = shift @ARGV;
+  &make_doc($file);
+}
+
+sub make_doc {
+  my($file) = @_;
+  my($in_def, $in_code, $code, $a, $b);
+  local(*F);
+  local($_);
+
+  open(F, $file) || die("$file: $!\n");
+  $in_def = 0;
+  $in_code = 0;
+  while(<F>) {
+    if ($in_def) {
+      if (/^\@end/) {
+        $in_def = 0;
+        next;
+      }
+      s/^\s+//;
+      s/^(\w+)\.(\w+)// || next;
+      ($a, $b) = ($1, $2);
+      s/^\s+//;
+      s/\s+$//;
+      &w3mdoc::DEF($a, $b, $_);
+      next;
+    }
+    if ($in_code) {
+      if (/^\@end/) {
+        eval "package w3mdoc; $code";
+        $in_code = 0;
+        next;
+      }
+      $code .= $_;
+      next;
+    }
+    if (/^\@define/) {
+      $in_def = 1;
+      next;
+    }
+    if (/^\@code/) {
+      $in_code = 1;
+      $code = "";
+      next;
+    }
+    if (s/^\@include\s+//) {
+      s/\s+$//;
+      &make_doc($_);
+      next;
+    }
+    if (/^\@/) {
+      die("unknown command: $_");
+    }
+    s/(\\@|\@(\w+(\.\w+|\(\w+\)))\@)/&w3mdoc::SUB($1)/eg;
+    print;
+  }
+  close(F);
+}
+