<html><head></head><body># Another HTML-lint ###########################################

eval(q|require 'htmllint.env'|);
eval(q|require 'common.rul'|);

package htmllint;

BEGIN {     require 5.002;  # JPerl では動作しません

$VERSION = '1.82';

$myADDRESS = 'k16@chiba.email.ne.jp';

$version = &lt;<endofversion; another="" html-lint="" ver$version="" copyright="" (c)="" 1997-2000="" by="" ishino="" keiichiro="" <$myaddress="">.
    All rights reserved.
EndOfVersion

$WIN = $^O =~ /Win32/oi;
$MAC = $^O =~ /MacOS/oi;
#$OS2 = UNSUPPORTED;
$UNIX = !($WIN || $MAC || $OS2);

$SEP = '/';
if ($WIN) {
  ($PROGRAM = $0) =~ s#\\#/#og; # 日本語ファイル名不可
  $PROGRAM =~ m#^([A-Za-z]:)?(.*)#o;
  $PROGDIR = $1;
  $2 =~ m#^(.*?)([^/]+)$#o;
  $PROGRAM = $2;
  $PROGDIR .= ($1 eq '')? '.': $1;
} elsif ($MAC) {
  ($PROGDIR, $PROGRAM) = $0 =~ m#^(.*?)([^:]+)$#o;
  $SEP = ':';
} else {
  $PROGRAM = $0;
  my $LINK;
  while ($LINK = readlink($PROGRAM)) {
    if ($LINK =~ m#^/#o) {
      $PROGRAM = $LINK;
    } else {
      $PROGRAM =~ m#^(.*?)[^/]+$#o;
      $PROGRAM = $1.$LINK;
    }
    $PROGRAM = &amp;NormalizeDots($PROGRAM);
  }
  ($PROGDIR, $PROGRAM) = $PROGRAM =~ m#^(.*?)([^/]+)$#o;
  $PROGDIR = '.' if $PROGDIR eq '';
}
$PROGDIR .= $SEP if $PROGDIR !~ m#$SEP$#o;
unshift @::INC, $PROGDIR;

sub HTMLlint(@);
sub ListWarnings(;\@);

sub NormalizeDots
{
  my @files;
  my $filespec = shift;
  $filespec .= '/' if $filespec =~ m#(?:^|/)\.\.?$#o;
  foreach (split(m#/+#, $filespec, -1)) {
    next if $_ eq '.';
    if ($_ eq '..' &amp;&amp; @files) {
      my $parent = pop(@files);
      next if $parent ne '' &amp;&amp; $parent ne $_;
      push(@files, $parent);
    }
    push(@files, $_);
  }
  join('/', @files);
}
                                  } # End of BEGIN

use Getopt::Long;
   $Getopt::Long::autoabbrev = 1;
use Cwd;
use File::Find;
require RFC2396;
if (!$::NOUSEJCODE &amp;&amp; eval('require Jcode')) {
  $Jcode = $Jcode::VERSION;
  *Jgetcode = \&amp;Jcode::getcode;
  *Jconvert = \&amp;Jcode::convert;
} else {
  $Jcode = 0;
  require 'jcode.pl';
  *Jgetcode = \&amp;jcode::getcode;
  *Jconvert = \&amp;jcode::convert;
}

$usage = &lt;<endofusage .="" <<'endofoptions';="" usage:="" perl5="" $program="" options="" file.html...="" endofusage="" options:="" -d="" <warn="">     : 指定された警告を無効にする。(各警告はコンマで区切る)
    -e <warn>     : 指定された警告を有効にする。(各警告はコンマで区切る)
    -f <file>     : 設定ファイル(htmllintrc)を指定する。
    -pedantic     : すべての警告を有効にする。(このとき -d -e の指定無効)
    -nopedantic   : すべての警告を有効にすることはしない。
    -religious    : 宗教的な警告を有効にする。
    -noreligious  : 宗教的な警告を無効にする。
    -accessibility   : アクセス性向上に関する警告を有効にする。
    -noaccessibility : アクセス性向上に関する警告を無効にする。
    -banner       : 処理開始と終了メッセージを表示する。
    -nobanner     : 処理開始と終了メッセージを表示しない。
    -score        : チェックした HTML の点数を表示する。
    -noscore      : チェックした HTML の点数を表示しない。
    -prune        : ディレクトリ指定のとき下位ディレクトリを探さない。
    -noprune      : ディレクトリ指定のとき下位ディレクトリを探す。
    -warnings     : チェックによる警告を表示する。
    -nowarnings   : チェックだけして何も警告を表示しない。
    -listwarnings : サポートされているすべての警告を表示する。
    -w <style>    : 警告メッセージのスタイルを指定する。
                     <style> = lint     file(#): warning-message
                             = short    #: warning-message
                             = long     #: warning-id: warning-message
                             = terse    file:#:warning-id
                             = verbose  file: #: warning-id: warning-message
    -limit <n>    : 警告の打ち切り個数を指定する。
    -omit <n>     : 無減点同一警告の打ち切り数を指定する。
    -x <html>     : 指定された HTML ヴァージョンでチェックする。
                     <html> = html10
                            = html20 | RFC1866
                            = html2x | RFC2070 | i18n
                            = html30 | arena
                            = html32 | wilbur
                            = html40 | html40s | html40-strict
                            = html40t | html40-transitional
                            = html40f | html40-frameset
                            = html40m | html40-mobile
                            = html401 | html401s | html401-strict
                            = html401t | html401-transitional
                            = html401f | html401-frameset
                            = 15445 | iso-html
                            = mozilla20
                            = mozilla30
                            = mozilla40 | navigator | netscape
                            = ie30b | msie30b
                            = ie30 | msie30
                            = ie40 | msie40
                            = ie50 | msie50 | microsoft
                            = webexp
                            = compact-html | compact
                            = imode10
                            = imode20
                            = jpo
                    大文字小文字の区別なし。
    -igndoctype   : HTML 中の DOCTYPE 宣言を無視する。
    -usedoctype   : HTML 中の DOCTYPE 宣言を無視しない。
    -igncharset   : CHARSET の指定とコードの一致性を無視する。
    -usecharset   : CHARSET の指定とコードの一致性を無視しない。
    -local        : HTML 中のローカルファイルの参照を許可する。
    -nolocal      : HTML 中のローカルファイルの参照を禁止する。
    -r <dir>      : 規則ファイルのディレクトリを指定する。指定がなければ
                    htmllint と同じ場所とみなされる。
    -v | -version : ヴァージョンを表示する。
    -u | -help    : このメッセージを表示する。
  return: 何もエラーがなければエラーステータス 0 で終了する。
EndOfOptions

$myCODE = &Jgetcode(\$usage); # euc または sjis

$::HTMLEXT   = 'html?|[sp]ht(ml)?'    unless defined($::HTMLEXT);
$::INDEXHTML = "index\\.($::HTMLEXT)" unless defined($::INDEXHTML);

$stdNameChr  = '[A-Za-z0-9\.\-]';
$stdTokenStr = $stdNameChr.'+';
$nameStr     = '[A-Za-z]'.$stdNameChr.'*';
$allc     = '[\x00-\xFF]';
$digits   = '\d+';
$charData = '(?=[CNIE])(?:CDATA|NUMBER|NAME|NMTOKEN|NUTOKEN'.
            '|NUMBERS|NAMES|NMTOKENS|NUTOKENS|ID|IDREF|IDREFS|ENTITY'.
            '|CDATA\+)'; # 空にできない CDATA
$internalElem = '#\d+';
$unsafeuri   = '~';
$nameSep     = '/';  # $nameChr に含まれないもの

%TagAttrCheckers = (
  'BASE'.  $nameSep.'HREF'      => \&CheckTagAttrBASE_HREF,
  'FRAME'. $nameSep.'NAME'      => \&CheckTagAttrFRAME_NAME,
  'FRAME'. $nameSep.'SRC'       => \&CheckTagAttrFRAME_SRC,
  'A'.     $nameSep.'HREF'      => \&CheckTagAttrA_HREF,
  'IMG'.   $nameSep.'ALT'       => \&CheckTagAttrIMG_ALT,
  'IMG'.   $nameSep.'USEMAP'    => \&CheckTagAttrIMG_USEMAP,
  'OBJECT'.$nameSep.'TITLE'     => \&CheckTagAttrOBJECT_TITLE,
  'OPTION'.$nameSep.'SELECTED'  => \&CheckTagAttrOPTION_SELECTED,
  'FONT'.  $nameSep.'COLOR'     => \&CheckTagAttrFONT_COLOR,
);
%AttrCheckers = (
  LANG         => \&CheckAttrLANG,
  ALT          => \&CheckAttrALT,
  ISMAP        => \&CheckAttrISMAP,
  TARGET       => \&CheckAttrTARGET,
  STYLE        => \&CheckAttrSTYLE,
  TABINDEX     => \&CheckAttrTABINDEX,
  DISABLED     => \&CheckAttrDISABLED,
);
%TagCheckers = (
  HTML         => \&CheckTagHTML,
  BODY         => \&CheckTagBODY,
  LINK         => \&CheckTagLINK,
  META         => \&CheckTagMETA,
  SCRIPT       => \&CheckTagSCRIPT,
  STYLE        => \&CheckTagSTYLE,
  DD           => \&CheckTagDD,
  A            => \&CheckTagA,
  LABEL        => \&CheckTagLABEL,
  SELECT       => \&CheckTagSELECT,
  OPTION       => \&CheckTagOPTION,
  INPUT        => \&CheckTagINPUT,
  TEXTAREA     => \&CheckTagTEXTAREA,
  FORM         => \&CheckAttrNAME_ID,
  IMG          => \&CheckAttrNAME_ID,
  FRAME        => \&CheckAttrNAME_ID,
  IFRAME       => \&CheckAttrNAME_ID,
# TABLE        => \&CheckTagTABLE,
  TR           => \&CheckTagTR,
  TH           => \&CheckTagTHTD,
  TD           => \&CheckTagTHTD,
  BR           => \&CheckTagBR,
  PRE          => \&CheckTagPRE,
  APPLET       => \&CheckTagAPPLET,
  OBJECT       => \&CheckTagOBJECT,
  XML          => \&CheckTagXML,
);

##################################################
# 入り口

sub HTMLlint(@)
{
  local @ARGV = @_;
  local ($opt_pedantic, $opt_banner, $opt_echoname, $opt_score, $opt_local,
         $opt_religious, $opt_accessibility, $opt_warnings, $opt_prune, $opt_base,
         $opt_igndoctype, $opt_igncharset, $opt_lang, $opt_charset,
         $opt_limit, $opt_omit, $opt_w, $opt_f, $opt_x, $opt_stat, $opt_dbg);
  return if &ReadOptions();
  &ReadRule('charsets.rul');
  &ReadRule('colortable.rul');
  &ReadTagsSet();

  if ($myCODE eq 'sjis') {
    # 日本語の含まれる正規表現用文字列をエスケープする
    my $esc = 0;
    my $escStr = '';
    foreach (unpack('C*', $::hereAnchorsJ)) {
      $esc = 2 if $esc <= 0 && ((0x0081 <= $_ && $_ <= 0x009F) ||
                                (0x00E0 <= $_ && $_ <= 0x00FC));
      $escStr .= ($esc-- <= 0)? chr: sprintf('\\x%02X', $_);
    }
    $::hereAnchorsJ = $escStr; # 二重エスケープ注意
  }

  my $exit_status;
  while (@ARGV > 0) {
    local @htmlfiles;
    $_ = shift(@ARGV);
    if ($_ eq $stdio) {
      *HTML = *STDIN;
      &Lint('stdin');
    } else {
      local $curcwd = &getcwd.$SEP;
      if (-d) {
        local $ext = '\.('.$::HTMLEXT.')';
        local $prune = 0;
        &find(\&HTMLwanted, $_);
      } else {
        /^(.*?[$SEP])?([^$SEP]+)$/o;
        my $dir = $1;
        local $ext = $2;
        if ($ext =~ /[*?]/o) {
          $ext =~ s/\./\\\./og;
          $ext =~ s/\^/\\\^/og;
          $ext =~ s/\(/\\\(/og;
          $ext =~ s/\)/\\\)/og;
          $ext =~ s/\$/\\\$/og;
          $ext =~ s/\@/\\\@/og;
          $ext =~ s/\%/\\\%/og;
          $ext =~ s/\+/\\\+/og;
          $ext =~ s/\*/.*/og;
          $ext =~ s/\?/./og;
          local $opt_prune = 1;
          local $prune = 0;
          &find(\&HTMLwanted, ($dir eq '')? '.': $dir);
        } else {
          push(@htmlfiles, $_);
        }
      }
      foreach (@htmlfiles) {
        if (open(HTML, "<$_")) {
          local $/ = &DetectSeparator;
          $exit_status = 1 if &Lint($_);
          close(HTML);
        } else {
          warn "Can't open `$_`.\n";
        }
      }
    }
    &::TakeStatistics($opt_stat) if $opt_stat;
  }
  $exit_status;
}

sub HTMLwanted
{
  if (-d) {
    if ($opt_prune && $prune++ > 1) {
      $File::Find::prune = 1;
    }
  } elsif (/$ext$/i) {
    my $name = &getcwd.$SEP.$_;
    if (substr($name, 0, length($curcwd)) eq $curcwd) {
      $name = substr($name, length($curcwd));
    }
    push(@htmlfiles, $name);
  }
}

sub DetectSeparator
{
  my $sep = "\n";
  my $buff;
  read(HTML, $buff, 1024);
  if ($buff !~ /\x0D\x0A/o) {
    $sep = "\x0A" if $buff =~ /\x0A/o;
    $sep = "\x0D" if $buff =~ /\x0D/o;
  }
  seek(HTML, 0, 0);
  $sep;
}

##################################################
# HTML を読んで解析する

sub Lint
{
  local ($htmlfile) = @_;
  local ($rule, $line, $token, $reacheof, $readsize, $textcode, $jcharcode,
         $charset, @ucase, @lcase, @xcase, @ucaseln, @lcaseln, @xcaseln,
         $tagscnt, $whinescnt, $pwhinescnt, $upenalty, $penalty, $lang,
         $tagsNestWhine, @tagsNest, @inclNest, @exclNest, $nonAsciiEarly,
         $omit_html, $p_isnot_br, $appElem, $lastTag, $contBRs, %seenAllTags,
         $seenCharset, $metaCharset, $baseURL, @refreshHTML,
         %seenAnchors, %seenAnchorsU, %seenAnchorsID, %iddef, %idref,
         %seenFrameName, $seenURL, $headElements, %hrefAnchors,
         @tableInfos, @tableInfo, $tableCell, @imgAlt, $bgcolor,
         $multibody, $bodyline, @seenLabels, @seenLabel, @ctrlLabels, @ctrlLabel,
         @seenSelect, @selOption, $selOptions, $seenPre, @seenObject, $pretab,
         @headingLevel, $headingStart, %formNames, $needprchar, $xml, @xmlns);
  local ($emptyTags, $pairTags, $deprecatedTags, $omitStartTags, $omitEndTags,
         $maybeEmpty, %requiredTags, %onceonlyTags, $sequencialTags,
         %tagsElements, %excludedElems, %includedElems,
         %deprecatedElems, %deprecatedAttrs, %deprecatedAttrsCss, %deprecatedVals,
         %tagsAttributes, %requiredAttrs, $disabled,
         %refEntities, %refParams, %indexhtml, %stathtml);
  local ($nameChr, $nameStr, $tokenStr, $nutokenStr, %tokenizedType);
  return 1 if &Doctype;
  $lang = [ $opt_lang, 0 ];
  if ($opt_charset ne '') {
    if ($opt_charset =~ /^(?:$usascii)$/oi) {
      $charset = 'usascii';
    } else {
      $charset = $opt_charset;
      foreach (keys %japanesesets) {
        if ($opt_charset =~ /^(?:$japanesesets{$_})$/i) {
          $jcharcode = $_;
          last;
        }
      }
    }
    $metaCharset++;
  }
  $penalty = $tagscnt = 0;
  my ($ln, $tag);
  local $analizing = 1;
  ($ln, $tag) = &ReadTag('HTML') until $tag eq 'HTML';
  $analizing = 0;
  # これ以降後始末 #############
  my $over = ($whinescnt >= $opt_limit);
  if (!$over) {
    {
      my @noattrs;
      my $seens = 0;
      foreach (qw(BGCOLOR TEXT LINK VLINK ALINK)) {
        if ($seenAllTags{'BODY'.$nameSep.$_}) {
          $seens++;
        } elsif ($tagsAttributes{'BODY'}->{$_} ne '') {
          push(@noattrs, $_);
        }
      }
      if ($seens && @noattrs) {
        if ($seenAllTags{'A'.$nameSep.'HREF'}) {
          my $attrs = join('、', @noattrs);
          &Whine($bodyline, 'body-color', 'BODY', $attrs);
        } elsif ($tagsAttributes{'BODY'}->{'BGCOLOR'} ne '') {
          if ($seenAllTags{'BODY'.$nameSep.'TEXT'}) {
            &Whine($bodyline, 'body-color', 'BODY', 'BGCOLOR')
              unless $seenAllTags{'BODY'.$nameSep.'BGCOLOR'};
          } else {
            &Whine($bodyline, 'body-color', 'BODY', 'TEXT')
              if $seenAllTags{'BODY'.$nameSep.'BGCOLOR'};
          }
        }
      }
    }
    foreach (@ctrlLabels) {
      my @label = &SearchLabel(@$_);
      &CheckAccesskey(\@label, \@$_);
    }
    &SkipComment;
    if ($line ne '') {
      &Whine($., 'unexpected-end-of-html');
      while (&GetLine ne '') { $line = ''; } # 行数をカウントしておく
    }
    foreach (reverse keys %idref) {
      unless ($iddef{$_}) {
        $idref{$_} =~ /^(\d+)$nameSep($nameStr)$nameSep($nameStr)$/;
        &Whine($., 'undef-id', $2, $3, $_, $1);
      }
    }
    if ($htmlVer >= 4) {
      # HTML4 では、アンカー名と ID は同一空間
      foreach (sort {$seenAnchors{$a} <=> $seenAnchors{$b}} keys %seenAnchors) {
        my $uval = uc;
        &Whine($seenAnchors{$_}, 'same-fragment-id', 'A', $_, $iddef{$uval})
          if $iddef{$uval} && !$seenAnchorsID{$uval};
      }
    }
    foreach (sort {$hrefAnchors{$a} <=> $hrefAnchors{$b}} keys %hrefAnchors) {
      if ($seenAnchors{$_}) {
        delete $seenAnchors{$_};
      } else {
        my $uval = uc;
        &Whine($hrefAnchors{$_}, ($htmlVer >= 4 && $iddef{$uval})?
                                 'id-link': 'bad-link', 'A', $_, $iddef{$uval});
      }
    }
    foreach (sort {$seenAnchors{$a} <=> $seenAnchors{$b}} keys %seenAnchors) {
      &Whine($seenAnchors{$_}, 'unref-link', 'A', $_);
    }
    foreach (keys %::nonsupportedTagsPair) {
      my $alt = $::nonsupportedTagsPair{$_}[0];
      if ($alt =~ /^(?:$emptyTags|$pairTags)$/ &&
          $seenAllTags{$_} && !$seenAllTags{$alt}) {
        &Whine($., $::nonsupportedTagsPair{$_}[1], $_, $alt);
      }
    }
  }
  if (!$opt_igncharset) {
    if (($textcode eq 'jis' || $textcode eq 'euc') &&
        (${$::doctypes{$rule}}{restrict} & 1)) {
      &Whine($., 'jpo-shift-jis', '', ${$::doctypes{$rule}}{guide}, 'Shift JIS');
    }
    if ($jcharcode && $textcode && $jcharcode ne $textcode) {
      $textcode =~ tr/a-z/A-Z/;
      $textcode = 'Shift JIS' if $textcode eq 'SJIS';
      $textcode = 'UTF-8'     if $textcode eq 'UTF8';
      if ($opt_charset ne '') {
        &Whine($., 'charset-mismatch', $charset, $textcode, 'HTTPレスポンスヘッダに');
      } else {
        &Whine($seenCharset, 'charset-mismatch', $charset, $textcode);
      }
    }
    if ($opt_charset ne '' && $opt_charset !~ /^($charsets)$/oi) {
      &Whine($., ($opt_charset =~ /^x-/oi)?
                  'no-registered-charset-ex':
                  'no-registered-charset', '', 'HTTPレスポンスヘッダに', $opt_charset);
    }
  }
  &Whine($refreshHTML[0], 'refresh-link') if @refreshHTML;
  foreach (0, 1) {
    if (($lcase[$_] && $ucase[$_]) || $xcase[$_]) {
      $ln = $xcaseln[$_];
      $ln = $lcaseln[$_] if $lcase[$_] && $lcase[$_] <= $ucase[$_];
      $ln = $ucaseln[$_] if $ucase[$_] && $ucase[$_] <= $lcase[$_];
      &Whine($ln, 'mixed-case', $_? '属性名': '要素名');
    }
  }
  if (${$::doctypes{$rule}}{doclimit} &&
      ${$::doctypes{$rule}}{doclimit}*1024 < $readsize) {
    &Whine($., 'over-file-size', '', ${$::doctypes{$rule}}{guide},
                                     ${$::doctypes{$rule}}{doclimit});
  }
  &Whine($., 'over-limit-whines', $opt_limit) if $over;
  $ln = $.;
  my $kind = scalar(keys %seenAllTags);
  if ($opt_stat) {
    $::seenMultiBody{$multibody}++ if $multibody > 1;
    $::seenTagsKind{$kind}++;
    foreach (keys %seenAllTags) {
      $::seenTagsStat{$_} += $seenAllTags{$_} unless m#$nameSep#o;
    }
  }
  print "panalty=$penalty+$upenalty/lines=$ln/tags=$tagscnt/kind=$kind" if $opt_dbg;
  if ($penalty+$upenalty) {
    my $weight = $tagscnt+($kind+13)/29; # 16(=29-13)個位はタグの種類が欲しい
#   my $threshold = 200;
#   if ($tagscnt > $threshold) {
#     $weight += $tagscnt*sqrt($tagscnt-$threshold)/$threshold;
#   }
    $penalty = int((1-$penalty/$weight)*100 -$upenalty);
    $penalty = 99 if $penalty == 100;
    if ($penalty < 80) {
      # (80, 80), (0, -$c) を通り、(80, 80) の傾きが 1 の sqrt 曲線
      my $c = -5;
      my $a = $c/6400;
      my $b = (1-$c/40)/$a;
      $penalty = int((-$b-sqrt($b*$b-4*($c-$penalty)/$a))/2);
    }
  } else {
    $penalty = 100;
  }
  print "/score=$penalty\n" if $opt_dbg;
  if ($opt_banner) {
    if ($whinescnt) {
      print $whinescnt, '個のエラーがありました',
            ($opt_score && $penalty >= 100)? 'が、': '。';
    } else {
      print 'エラーは見つかりませんでした。＼(^o^)／ ';
    }
  }
  if ($opt_score) {
    print 'このHTMLは ', $penalty, '点です。';
    print 'タグが ', $kind, '種類 ', $tagscnt, '組使われています。' if !$over;
  }
  print "\n" if $opt_banner || $opt_score;
  $whinescnt? 1: 0;
}

##################################################
# タグを読む
# タグを処理したときは、もしあれば終了タグまで処理され、行番号とタグ名が返る
# それらは、(nnn, TAG) の形のリストである
# タグを処理しなかったときは nnn が 0 である
# そのとき処理しようとしたタグが TAG にセットされているかも知れない

sub ReadTag
{
  my $tags = shift; # 許可されるタグセット
  $pretab = 0;
  local $ln;
  $tags = ($tags =~ /^%(.*)/o)? $refParams{$1}: &ExpandInternalElements($tags);
  if ($tags =~ /^R?CDATA$/o) {
    $ln = $.;
    &ReadCDATA($tags);
    return (0, $tag);
  }
  my $oldxml = $xml;
  local $xml = $oldxml;
  local $tag = &GetTag;
  local $atag = $tag; # XMLNS:namespace に対応するための代表
  $needprchar = 0 unless $token =~ /^<A(?:\s|>|$)/oi;
  $ln = $.;
  local $unknownTag = 0;
  if ($tag eq '') {
    # 次の $appElem は有効な内容がないときに無限ループを防ぐ
    &GetLine ne '' || !$appElem++ || return (0, '');
    $ln = $.;
    $tag = '#PCDATA';
  } else {
    if ($tag =~ m#^/#o) {
      if ($#tagsNest >= 0) {
        # ここでは終了タグは処理できない
        &UnGetToken;
        return (0, $tag);
      }
    } else {
      my $unknown;
      if ($tag =~ /^([^:]+):/o) {
        # IE5 の XMLNS:namespace 対応 (: の含まれる要素名は普通は存在しないと仮定)
        my $xmlns = $1;
        $unknown = 1;
        foreach (@xmlns) {
          if ($xmlns eq $_) {
            $unknown = 0;
            $atag = ':XMLNS:';
            $tagsElements{$tag} = $tagsElements{$atag};
            &Whine($., 'unsupported-tag', $tag);
            last;
          }
        }
      } else {
        $unknown = $tag !~ /^(?:$emptyTags|$pairTags)$/ && !$xml;
      }
      if ($unknown) {
        # 不明なタグ
        if ($tag eq '!DOCTYPE') {
          &Whine($., 'misplaced-doctype');
          &AdvanceCloseTag($tag, $.);
          return ($ln, $lastTag = $tag);
        }
        $unknownTag++;
        if (&WhineUnknownElement($tag)) {
          # 他のHTMLの要素
          $seenAllTags{$tag}++;
          $tagscnt++;
          $unknownTag++;
        }
      }
    }
  }
  my $omitstart = '';
  my $omitstart_trivial = 0;
  my $allow = 0;
  my $unget = 0;
  unless ($unknownTag) {
    if ($tag ne 'HTML') {
      # 開始タグの省略は $omitStartTags にあるタグで次のいずれかのときに可能とする
      #   $tags が 1 タグのとき
      #   順序タグのとき
      #   省略可能なタグがひとつでそれによって $tag が書けるようになるとき
      if (@seq) {
        my $stag = &ExpandInternalElements($seq[$seqid]);
        my $parent = $tagsNest[$#tagsNest][0];
        if ($tag =~ /^(?:$stag)$/ && $tag !~ /^(?:$onceonlyTags{$parent})$/) {
          # このタグはここに書ける
        } else {
          foreach $i ($seqid+1..$#seq) {
            $stag = &ExpandInternalElements($seq[$i]);
            last if $tag =~ /^($stag)$/;
            next unless $seq[$i] =~ /^(?:$requiredTags{$parent})$/;
            foreach (split(/\|/o, $stag)) {
              if (/^(?:$omitStartTags)$/) {
                $omitstart = $_;
                $seqid = $i;
                # 次の判定あいまい (TBODY対応)
                $omitstart_trivial = 1 if $#tagsNest > 0;
                last;
              }
            }
            last if $omitstart;
          }
        }
      } else {
        if ($tags =~ /\|/o) {
          # ここの処理はすごくいいかげん
          # Cougar09/04 の TABLE 処理を想定しているが、TBODY の順序関係など見ていない
          foreach (split(/\|/o, $tags)) {
            if (/^(?:$omitStartTags)$/) {
              $omitstart = $_;
              $omitstart_trivial = 1 if $#tagsNest > 0;
              last;
            }
          }
        } else {
          $omitstart = $tags if $tags =~ /^(?:$omitStartTags)$/;
        }
      }
    }
    if ($tag ne '') {
      foreach (reverse @inclNest) {
        if ($tag =~ /^(?:$_)$/) {
          $allow = 1;
          last;
        }
      }
    }
    unless ($allow) {
      my ($exclude, $exclude_force) = (-1, -1);
      # 禁止されているタグを調べる (後ろから)
      foreach (reverse 0..$#exclNest) {
        if ($tag =~ /^(?:$exclNest[$_])$/) {
          if ($omitstart) {
            # 開始タグが省略できるときはそれが現れたとして処理を続ける
            $unget++;
            last;
          }
          if (&OmitEndTag($_)) {
            # 終了タグが省略できるときは処理を終える
            &UnGetToken;
            return (0, $tag);
          }
          $exclude_force = $exclude = $_+1;
          last;
        }
      }
      if (!$unget && $tags ne 'ANY' && ($tag eq '' || $tag !~ /^(?:$tags)$/)) {
        # ここには書けないタグ
        if ($omitstart) {
          # ここに $tags が現れたとして処理する
          $unget++;
          $exclude = -1;
        } else {
          if (&OmitEndTag($#tagsNest)) {
            # 終了タグが省略できるときは処理を終える
            &UnGetToken;
            return (0, $tag);
          }
          $exclude = $#tagsNest+1;
        }
      }
      my ($parent, $pln);
      if ($exclude == -1) {
        ($parent, $pln) = ($tagsNest[$#tagsNest][0], $tagsNest[$#tagsNest][1])
          if $#tagsNest != -1;
        if ($unget || ($omitstart && $omitstart ne $tag &&
            $omitstart =~ /^(?:$requiredTags{$parent})$/)) {
          # 省略されている省略可能なタグが必要なときはそれが現れたとして処理を続ける
          &UnGetToken;
          $tag = $omitstart;
          &Whine($., $omitstart_trivial? 'omit-start-tag-trivial':
                                         'omit-start-tag', $tag);
          $unget++;
        }
      } elsif ($exclude-- == 0) {
        # 省略不可の <HTML> が省略されたケース
        &UnGetToken;
        &Whine($., 'required-start-tag', $tag = $tags);
        $unget++;
      } else {
        # 書けないタグに対する警告
        ($parent, $pln) = ($tagsNest[$exclude][0], $tagsNest[$exclude][1]);
        my ($msg, @cand);
        if ($tag ne '#PCDATA') {
          foreach $x (reverse 0..$exclude-1) {
            @cand = grep((!/^$internalElem$/o &&
                          $tag =~ /^($tagsElements{$_})$/ &&
                          $tagsElements{$_} !~ /^($deprecatedTags)$/),
                           split(/\|/o, $tagsElements{$tagsNest[$x][0]}));
            last if @cand;
          }
          if (@cand) {
            $msg = &Join('|', @cand);
            if ($exclude_force == -1 &&
                $msg !~ /\|/o && $msg =~ /^(?:$omitStartTags)$/ &&
                $tag =~ /^(?:$tagsElements{$msg})$/ &&
                $msg =~ /^(?:$tagsElements{$lastTag})$/) {
              # 候補がひとつでそれが省略可能で、
              # その候補をここに書くことができるときは、
              # ここにそれが現れたとして処理する
              &UnGetToken;
              $tag = $omitstart = $msg;
              &Whine($., 'omit-start-tag', $tag);
              $unget++;
              $exclude = -1;
            } else {
              $msg = ($#cand >= 5)? '': # あまり候補が多いときは出さない
                     &FormatTagGuide($msg, '%s 内になら書けます。');
            }
          }
        }
      }
      if ($exclude != -1) {
        foreach (reverse 0..$exclude-1) {
          last unless $tagsNest[$_+1][0] =~ /^(?:$omitEndTags)$/;
          if ($tag =~ /^(?:$tagsElements{$tagsNest[$_][0]})$/) {
            # 親を省略すると書けるようになるタグ
            &UnGetToken;
            return (0, $tag);
          }
        }
        if ($tag ne '#PCDATA') {
          &::PushStat('ExcludedElement', $parent.' '.$tag) if $opt_stat;
          if ($tag =~ /^(?:$pairTags)$/ && $parent =~ /^(?:$tagsElements{$tag})$/) {
            # 入れ替えると書けるようになるタグ
            $msg = "<$tag>～</$tag>".' 内に '."<$parent>".' を書くことはできます。';
          }
          if ($exclude == $#tagsNest && $tag eq $parent) {
            if ($tag ne 'HTML') {
              # 直前が同じタグのときは、その終了タグを補うと </A> 忘れでの
              # 大量警告を減らせる
              &WhineExcludedElement($tag, $parent, $pln,
                                    "</$parent>".' を補ってください。');
              &UnGetToken;
            } else {
              &WhineExcludedElement($tag, $parent, $pln, $msg);
            }
            return (0, $tag);
          }
          &WhineExcludedElement($tag, $parent, $pln, $msg);
          $parent = '';
        }
      }
      if ($parent && $tag =~ /^(?:$deprecatedElems{$parent})$/) {
        my $elem = ($tag eq '#PCDATA')? '普通のテキスト': "<$tag> ";
        &Whine($., 'deprecated-element', '', $elem, $parent, $pln);
        &::PushStat('DeprecatedElement', $parent.' '.$tag) if $opt_stat;
      }
      if ($tag eq '#PCDATA') {
        if ($exclude != -1 || ($tags ne 'ANY' && $tag !~ /^(?:$tags)$/)) {
          &WhineExcludedElement($tag, $tagsNest[$#tagsNest][0]);
          &::PushStat('UnexpectedPCDATA', $tagsNest[$#tagsNest][0]) if $opt_stat;
        }
        &ReadPCDATA;
        return ($ln, $lastTag = $tag);
      }
    }
  }
  unless ($unget) {
    unless ($unknownTag) {
      if (@seq) {
        # タグの出現順序を調べる
        # @seq と $seqid の寿命に注意
        # @seq には #XXX というのが入っているがそのままで構わない
        my ($where, $stag, $rtag, @last);
        my $parent = $tagsNest[$#tagsNest][0];
        foreach $where ($seqid..$#seq) {
          $stag = $seq[$where];
          $stag = &ExpandInternalElement($stag) if $stag =~ /^$internalElem$/o;
          if ($tag =~ /^(?:$stag)$/) {
            my $err;
            if ($where == $seqid) {
              if ($tag =~ /^(?:$onceonlyTags{$parent})$/) {
                $err = $where;
                my $last = '';
                foreach (@seq) {
                  push(@last, $last) if $_ eq $tag;
                  $last = $_;
                }
              }
            } else {
              foreach ($seqid+1..$where-1) {
                if ($seq[$_] =~ /^(?:$requiredTags{$parent})$/) {
                  $err = $_;
                  push(@last, $seq[$_]);
                }
              }
            }
            unless ($err) {
              undef @last;
              $seqid = $where;
              last;
            }
          }
        }
        if (@last) {
          my $last = join('|',
            map { (($_ eq '')? $parent: /^(?:$pairTags)$/? "/$_": $_) } @last);
          &Whine($., 'must-follow', $tag, &FormatTagGuide($last));
          &::PushStat('MustFollow', $tag.' '.$last) if $opt_stat;
        }
      }
      # 特定のタグ内にしか書けないタグか調べる
      my $badInner = '';
      foreach (keys %::innerElements) {
        if ($tag =~ /^(?:$::innerElements{$_})$/) {
          $badInner = $_;
          foreach (reverse @tagsNest) {
            if ($badInner eq $$_[0]) {
              $badInner = '';
              last;
            }
          }
          if ($badInner ne '') {
          # &Whine($., 'misplaced-element', $tag, $badInner);
            last;
          }
        }
      }
      # 薦められないタグか調べる
      if ($tag =~ /^(?:$deprecatedTags)$/) {
        my $alt = '';
        my $whine = 'deprecated-tag';
        foreach (keys %::altDeprecated) {
          if ($tag =~ /^(?:$_)$/) {
            $alt = $::altDeprecated{$_};
            if ($alt eq 'css') {
              $whine = 'deprecated-tag-css';
#             &::PushStat('DeprecatedTagCSS', $tag) if $opt_stat;
            } else {
              $alt = "<$alt>".(($htmlVer >= 4 && $alt =~ /ALIGN/o)?
                               ' かスタイルシートを使いましょう。':
                               ' を使いましょう。');
            }
            last;
          }
        }
        &Whine($., $whine, $tag, $alt);
        &::PushStat('DeprecatedTag', $tag) if $opt_stat && $whine eq 'deprecated-tag';
      }
      # 物理フォントタグか調べる
      if ($::physicalFontElements{$tag}) {
        my @p = grep(/^(?:$emptyTags|$pairTags)$/,
                     split(/\|/o, $::physicalFontElements{$tag}));
        &Whine($., 'physical-font', $tag,
                   &FormatTagGuide(&Join('|', @p), '例えば %s。')) if @p;
      }
      # ヘディングの順序を調べる
      if ($tag =~ /^H(\d)$/o) {
        my $level = $1;
        if ($headingStart <= $#headingLevel) {
          my $last = $headingLevel[$#headingLevel];
          if ($last->[0]+1 < $level) {
            &Whine($., 'heading-order', $tag, 'H'.$last->[0],
                                                  $last->[1]);
          } else {
            foreach (reverse $headingStart..$#headingLevel) {
              last if $level >= $last->[0];
              pop(@headingLevel);
            }
          }
        }
        push(@headingLevel, [ $level, $. ]);
      }
      # 使うべきでないタグ
      &Whine($., 'should-not-use', $tag) if $tag =~ /^(?:$::shouldNotUse)$/o;
    }
    # 属性を調べる
    local ($attr, $subattr, $value, %seenAttrs);
    while (&GetAttrName ne '') {
      my $sp = $line =~ /^(?:\s|$)/o;
      if (&GetLine =~ /^=($allc*)/o) {
        # 属性名 = 属性値
        $line = $1;
        &Whine($., 'space-around-equal', $tag, $attr) if $sp || $line =~ /^(?:\s|$)/o;
        $value = &GetAttrValue;
        &CheckAttribute($tag, $attr) || next;
        ($_ = $TagAttrCheckers{$tag.$nameSep.$attr}) and &$_;
        ($_ = $AttrCheckers{$attr}) and &$_;
        # 次の判定の '%Script' 要注意 (規則ファイル中にこの字面を仮定)
        $tagsAttributes{$atag}->{$attr} eq '%Script' and &CheckAttrINTRINSIC;
      } else {
        # 属性名が省略されている場合
        $line = ' '.$line if $sp;
        ($_ = $TagAttrCheckers{$tag.$nameSep.$attr}) and &$_;
        if ($attr =~ /:$/o) {
          # IE5 の XMLNS:namespace 対応
          $value = '';
        } else {
          $value = $attr;
          my ($akey, $avals) = ('', '');
          my $attrval = \%{$tagsAttributes{$tag}};
          foreach (keys %{$attrval}) {
            # 指定された属性値を持つ属性名を探す
            $attr = $_;
            if (($avals = $attrval->{$attr}) =~ /^%(.*)/o) {
              # ここでは <TABLE BORDER> のような書式を判定する
              # 選択以外を非正規表現として比較する quotemeta ではだめ
              my $x = $refParams{$1};
              $x =~ s/([^\w\(\|\)])/\\$1/og;
              if ($value =~ /^($x)$/i) {
                $akey = $attr;
                last;
              }
            }
            if ($avals !~ /^(?:$charData)$/oi && $value =~ /^(?:$avals)$/i) {
              if ($akey) {
                # 同じ属性値を持つ属性が複数存在する
                $akey = '';
                last;
              }
              $akey = $attr;
            }
          }
          if ($akey eq '') {
            if ($tagsAttributes{$atag}->{$value} ne '') {
              # 属性値の候補を表示してもよい
              &Whine($., 'required-value', $tag, $value);
              &::PushStat('RequiredValue', $tag.' '.$value) if $opt_stat;
            } else {
              &WhineUnknownAttribute($tag, $value);
            }
            next;
          }
          if ($value ne $akey) {
            &Whine($., 'omit-attribute-name', $tag, $akey, $value);
            &::PushStat('OmitAttributeName', $tag.' '.$value) if $opt_stat;
          }
          $attr = $akey;
        }
      }
      if ($attr =~ /^(?:$deprecatedAttrsCss{$tag})$/) {
        # 薦められない属性 (スタイルシートからみ)
        &Whine($., 'deprecated-attribute-css', $tag, $attr);
#       &::PushStat('DeprecatedAttrCSS', $tag.' '.$attr) if $opt_stat;
      } elsif ($attr =~ /^(?:$deprecatedAttrs{$tag})$/) {
        # 薦められない属性
        &Whine($., 'deprecated-attribute', $tag, $attr);
        &::PushStat('DeprecatedAttr', $tag.' '.$attr) if $opt_stat;
      }
      &Whine($., 'repeated-attribute', $tag, $attr) if defined($seenAttrs{$attr});
      $seenAttrs{$attr.$subattr} = $value;
    } # &GetAttrName
    if ($textcode =~ /^(?:jis|euc|sjis)$/ && ${$lang}[0] ne '') {
      # 日本語以外が指定されているときに属性値の文字コードを調べる
      foreach (keys %seenAttrs) {
        if (&CheckLanguageCode($seenAttrs{$_})) {
          &WhineLanguageCode($ln, 'lang-attribute', $tag, $_);
        }
      }
    }
    if ($unknownTag) {
      return ($ln, $lastTag = $tag);
    }
    if ($tag =~ /^(?:$::formControls)$/o) {
      my @label;
      if (@seenLabel) {
        # ラベル内のフォームコントロールを調べる
        @label = @seenLabel;
        &Whine($., 'label-control', $tag, $seenLabel[0], $ctrlLabel[0], $ctrlLabel[1])
          if @ctrlLabel;
        if ($seenLabel[1] ne '') {
          &Whine($., 'label-for-control', $tag, $seenLabel[0],  'LABEL',
                     ($seenAttrs{'ID'} eq '')? '指定されていない': '')
            if uc($seenLabel[1]) ne uc($seenAttrs{'ID'});
        }
        @ctrlLabel = ($., $tag);
      }
      if (!$disabled && $tag =~ /^(?:$::recommendedAccesskey)$/o) {
        # コントロールに対応するラベルを探す
        my @ctrl = ($., $tag, $seenAttrs{'ID'}, $seenAttrs{'ACCESSKEY'});
        @label = &SearchLabel(@ctrl) unless @label;
        if (@label) {
          # 対応するラベルがすでにある
          &CheckAccesskey(\@label, \@ctrl);
        } else {
          # 対応するラベルがまだない (永久にないかも知れない)
          push(@ctrlLabels, [@ctrl])
            if $tag ne 'INPUT' || uc($seenAttrs{'TYPE'}) ne 'HIDDEN';
        }
      }
    }
    # 必須属性を調べる
    foreach (split(/&/o, $requiredAttrs{$tag})) {
      if (/\|/o) {
        my $req = $_;
        foreach (keys %seenAttrs) {
          if (/^(?:$req)$/) {
            $req = '';
            last;
          }
        }
        if ($req) {
          &Whine($., 'required-attribute', $tag, &FormatAttrGuide($req));
          &::PushStat('RequiredAttr', $tag.' '.$req) if $opt_stat;
        }
      } elsif (!defined($seenAttrs{$_})) {
        &Whine($., 'required-attribute', $tag, $_);
        &::PushStat('RequiredAttr', $tag.' '.$_) if $opt_stat;
      }
    }
    ($_ = $TagCheckers{$tag}) and &$_;
    if ($badInner eq '' && $tag =~ /^($::innerElements{'FORM'})$/o) {
      my $name = $seenAttrs{'NAME'};
      my $type = uc($seenAttrs{'TYPE'});
      $type = 'TEXT' if $type eq '';
      if ($name ne '') {
        my ($ln, $chk);
        if ($formNames{$name} =~ /^(\d+)$nameSep($nameStr)(${nameSep}1)?/) {
          ($ln, $chk) = ($1, $3);
          &Whine($., 'repeated-name', $tag, 'NAME', $name, $ln)
            if $type ne $2 || $tag ne 'INPUT' ||
               $type !~ /^(?:RADIO|CHECKBOX|SUBMIT|RESET|BUTTON|IMAGE)$/o;
        }
        if ($tag eq 'INPUT' && $type eq 'RADIO' && $seenAttrs{'CHECKED'} ne '') {
          &Whine($., 'multiple-checked', $tag, $ln) if $chk;
          $chk = $nameSep.'1';
        }
        $formNames{$name} = $..$nameSep.$type.$chk;
      }
      if ($tag eq 'INPUT' && $type eq 'TEXT' && !defined($seenAttrs{'VALUE'})) {
        &Whine($., 'default-text', $tag, ' VALUE 属性で');
      }
    }
    my $alt = 'ALT';
    if ($tagsAttributes{$atag}->{$alt} ne '' && !defined($seenAttrs{$alt}) &&
        # INPUT は IMAGE のときのみ警告する
        ($tag ne 'INPUT' || uc($seenAttrs{'TYPE'}) eq 'IMAGE') &&
        # APPLET は applet-text-equivalent で警告する
        $tag ne 'APPLET') {
      my $req = $requiredAttrs{$tag};
      $req =~ s/&/\|/og;
      # %requiredAttrs 中に ALT があるとエラーが重複するのを避ける
      &Whine($., 'img-alt', $tag) unless $alt =~ /^(?:$req)$/;
    }
    if ($tag =~ /^($::recommendedWidth)$/o &&
        $tagsAttributes{$tag}->{'WIDTH'} ne '' &&
        !($seenAttrs{'WIDTH'} ne '' && $seenAttrs{'HEIGHT'} ne '')) {
      &Whine($., 'img-size', $tag) unless $headElements;
    }
    &WhineRecommendedAttribute($., 'TITLE', $::recommendedTitle, 'recommended-title');
    &WhineRecommendedAttribute($., 'TITLE', $::recommendedFrameTitle, 'frame-title');
    &WhineRecommendedAttribute($., 'SUMMARY', $::recommendedSummary, 'table-summary');
    &WhineRecommendedAttribute($., 'ABBR', $::recommendedAbbr, 'abbr-header-label');
    unless ($disabled) {
      &WhineRecommendedAttribute($., 'ACCESSKEY', $::recommendedAccesskey,
                                 ($tag eq 'A')? 'link-accesskey': 'form-accesskey')
        if $tag !~ /^(?:$::formControls)$/o && # フォームコントロールは別仕立て
           $tagsAttributes{$tag}->{'HREF'} eq '' || $seenAttrs{'HREF'} ne '';
      &WhineRecommendedAttribute($., 'TABINDEX',
                                $::recommendedTabindex, 'form-tabindex');
    }
    if ($tag =~ /^(?:$::cuddleContainers)$/) {
      &Whine($., 'container-whitespace', $tag, '先頭') if $line =~ /^\s/o;
    }
    $seenAllTags{$tag}++;
    $tagscnt++;
  } # $unget
  $lastTag = $tag;
  if ($tag !~ /^($emptyTags)$/ || $xml) {
    push(@tagsNest, [ $tag, $., $lang, $xml ]);
    if ($#tagsNest >= 100) {
      &Whine($., 'tags-nest', $tag) unless $tagsNestWhine++;
    } else {
      $tagsNestWhine = 0;
    }
    push(@inclNest, $includedElems{$tag});
    push(@exclNest, $excludedElems{$tag});
    local ($innerTags, $lastPairTag, $lastOmitTag) = (0, '', $omitstart);
    local (%seenTags, @seq);
    local $seqid = -1;
    my $lastTagElements = $thisTagElements;
    local $thisTagElements = $tagsElements{$tag};
    if ($headElements && $tag eq 'OBJECT') {
      # HEAD 中の OBJECT 要素にはほとんど何も書けない
      push(@exclNest, &Join('|', pop(@exclNest),
              grep(!/^(?:$headElements|PARAM)$/, split(/\|/o, $thisTagElements))));
    }
    if ($tag =~ /^(?:INS|DEL)$/o && $#tagsNest > 0) {
      # HTML4.0 での INS と DEL の要素を調整する
      $thisTagElements = &Join('|',
              grep(/^(?:$lastTagElements)$/, split(/\|/o, $thisTagElements)));
    }
    @seq = split(/\|/o, $thisTagElements) if $tag =~ /^(?:$sequencialTags)$/;
    my $tableInfoSave = $#tableInfos;
    my $tableCellSave = $tableCell;
    if ($tag eq 'TABLE') {
      push(@tableInfos, [@tableInfo]);
      @tableInfo = ();
      $tableCell = 0;
    } elsif ($tag eq 'HEAD') {
      $headElements = $thisTagElements;
    }
    my $headingStartSave = $headingStart;
    $headingStart = $#headingLevel+1 if $tag =~ /^(?:$::headingBlocks)$/;
    TAGSLOOP:
    while ($whinescnt < $opt_limit) {
      while () {
        last TAGSLOOP if $whinescnt >= $opt_limit;
        local ($ahref, $titleattr);
        my $olddisabled = $disabled;
        my ($rln, $read) = &ReadTag($thisTagElements);
        $disabled = $olddisabled;
        $needprchar = $ahref if $read eq 'A';
        last unless $rln;
        $innerTags++;
        if ($read eq '#PCDATA') {
          if ($tag eq 'TITLE') {
            $pcdata =~ s/^\s+//o;
            $pcdata =~ s/\s+$//o;
            &Whine($., 'title-length', $tag, 64) if &StrLength($pcdata) > 64;
          }
          foreach (0..$#seenObject) {
            $seenObject[$_]->[0] = $.;
          }
        } else {
          $lastPairTag = $read if $read =~ /^(?:$pairTags)$/;
          my $once = $onceonlyTags{$tag};
          if ($read =~ /^(?:$once)$/) {
            if ($seenTags{$read}) {
              my @once = ($once =~ /\b($read)\b/g);
              if ($#once == 0) {
                &Whine($rln, 'once-only', $read, $tag, $seenTags{$read});
                &::PushStat('OnceOnly', $read) if $opt_stat;
              }
            }
          } else {
            ONCELOOP:
            while ($once =~ /($internalElem)(.*)/o) {
              $once = $2;
              my $ext = $tagsElements{$1}; # 一段の展開のみ
              if ($read =~ /^(?:$ext)$/) {
                if ($seenTags{$read}) {
                  &Whine($rln, 'once-only', $read, $tag, $seenTags{$read});
                  &::PushStat('OnceOnly', $read) if $opt_stat;
                  last ONCELOOP;
                }
                foreach (split(/\|/o, $ext)) {
                  if ($seenTags{$_}) {
                    &Whine($rln, 'once-only-group', $read, $tag, $seenTags{$_}, $_);
                    &::PushStat('OnceOnlyGroup', (($read lt $_)?
                              $read.' '.$_: $_.' '.$read).' '.$tag) if $opt_stat;
                    last ONCELOOP;
                  }
                }
              }
            }
          }
          $seenTags{$read} = $rln;
        }
      }
      if (&ReadEndTag) {
        foreach (split(/\|/o, $requiredTags{$tag})) {
          my $req = $_;
          if (/^$internalElem$/o) {
            $req = &ExpandInternalElement($req);
            foreach (split(/\|/o, $req)) {
              if ($seenTags{$_}) {
                undef $req;
                last;
              }
            }
          } else {
            undef $req if $seenTags{$req};
          }
          if ($req && $req !~ /#PCDATA/o) {
            my $msg = &FormatTagGuide($req, '', 5);
            $msg .= ' ' if $msg =~ />$/o;
            &Whine($., 'required', $tag, $msg);
            &::PushStat('Required', $tag.' '.$req) if $opt_stat;
          }
        }
        if (!$innerTags) {
          if ($tag !~ /^(?:$maybeEmpty)$/) {
            &Whine($., 'empty-container', $tag);
            &::PushStat('EmptyContainer', $tag) if $opt_stat;
          }
          if ($tag eq 'TEXTAREA') {
            &Whine($., 'default-text', $tag);
#         } elsif ($tag eq 'OBJECT') {
#           &Whine($., 'recommended-title', $tag,
#                      $headElements? '': 'か内容') unless $titleattr;
          }
        } elsif ($innerTags == 1 && $tag eq 'A' && defined(@imgAlt)) {
          &Whine($imgAlt[0], 'link-text-equivalent', $imgAlt[1], $imgAlt[2])
            if $imgAlt[3] =~ /^\s*$/o;
        }
        if ($tag eq 'PRE') { # PRE は入れ子にできないと仮定
          undef $seenPre;
        } elsif ($tag eq 'FORM') { # FORM は入れ子にできないと仮定
          undef %formNames;
        } elsif ($tag eq 'SELECT') { # SELECT は入れ子にできないと仮定
          undef @seenSelect;
          undef @selOption;
          undef $selOptions;
        } elsif ($tag eq 'LABEL') { # LABEL は入れ子にできないと仮定
          if ($seenLabel[1] eq '') {
            &Whine($seenLabel[0], 'label-no-control', 'LABEL') if !@ctrlLabel;
          }
          undef @seenLabel;
          undef @ctrlLabel;
        } elsif ($tag eq 'HEAD') {
          if ('LINK' =~ /^(?:$emptyTags|$pairTags)$/) {
            &Whine($., 'mailto-link')     if !$seenTags{'LINK'.$nameSep.'MAILTO'};
            &Whine($., 'navigation-link') if !$seenTags{'LINK'.$nameSep.'NAVIGATE'};
          }
          if ('META' =~ /^(?:$emptyTags|$pairTags)$/ && $opt_charset eq '' &&
              $opt_charset eq '' && !$seenTags{'META'.$nameSep.'CONTENT-TYPE'}) {
            &Whine($., 'content-type');
          }
          $metaCharset++;
          undef $headElements;
        } elsif ($tag =~ /^(?:OBJECT|APPLET)$/o) {
          my $obj = pop(@seenObject);
          if ($obj->[0]) {
            &Whine($obj->[1], 'applet-text-equivalent', $tag, 'ALT')
              if defined($obj->[2]);
          } else {
            &Whine($obj->[1], 'object-text-equivalent', $tag)
              if !defined($obj->[2]) && !$headElements;
          }
        }
        # 終了タグが処理できたら抜ける
        last;
      }
    } # TAGSLOOP
    if ($headingStart != $headingStartSave) {
      splice(@headingLevel, $headingStart);
      $headingStart = $headingStartSave;
    }
    if ($tableInfoSave != $#tableInfos) {
      @tableInfo = @{pop(@tableInfos)};
      $tableCell = $tableCellSave;
    }
    pop(@exclNest);
    pop(@inclNest);
    pop(@tagsNest);
  } # $emptyTag
  $lang = @tagsNest? $tagsNest[$#tagsNest][2]: undef;
  ($ln, $tag);
}

##################################################
# ラベルとコントロールの関係を調べる補助関数

sub SearchLabel
{
  my $id = $_[2];
  if ($id ne '') {
    foreach (@seenLabels) {
      return @$_ if lc($$_[1]) eq lc($id);
    }
  }
  ();
}

sub CheckAccesskey
{
  my ($label, $ctrl) = @_;
  # @$label == [ ln, for, accesskey ]
  # @$ctrl  == [ ln, tag, id, accesskey ]
  local $tag = $$ctrl[1];
  if ($$label[2] eq '') {
    &WhineRecommendedAttribute($$ctrl[0], 'ACCESSKEY', $::recommendedAccesskey,
            ($tag eq 'A')? 'link-accesskey': 'form-accesskey') if $$ctrl[3] eq '';
  } else {
    # if ($$ctrl[3] ne '' && uc($$ctrl[3]) ne uc($$label[2]))
    #   キーが食い違っているがとりあえずは警告しない
  }
}

##################################################
# タグ/属性チェック関数群

sub CheckTagAttrBASE_HREF
{
  &Whine($., 'later-base', $tag, $attr, $seenURL) if $seenURL;
  if ($value =~ m#^$RFC2396::scheme://.#o) {
    $baseURL = $value;
  } else {
    &Whine($., 'absolute-base-url', $tag, $attr);
  }
}

sub CheckTagAttrFRAME_NAME
{
  if ($value ne '') {
    &Whine($., 'existing-target-name', $tag, $attr, $value,
               $seenFrameName{$value}) if $seenFrameName{$value};
    if ($value =~ /^(?:$::reservedFrameNames)$/o) {
      &Whine($., 'reserved-target-name', $tag, $attr, $value);
    } elsif ($value !~ /^[A-Za-z]/o) {
      &Whine($., 'illegal-target-name', $tag, $attr, $value);
    }
    $seenFrameName{$value} = $.;
  }
}
sub CheckTagAttrFRAME_SRC
{
  if ($value ne '') {
    my ($scheme, $url) = &SplitFragmentID($value);
    &Whine($., 'same-document-frameset', $tag, $attr, $value) if $url eq '';
  }
}
sub CheckTagAttrA_HREF
{
  my ($scheme, $url, $frgid) = &SplitFragmentID($value);
  if ($frgid =~ /^#(.*)/o) {
    $frgid = $1;
    if ($frgid eq '' ) {
      &Whine($., 'empty-fragment-id', $tag);
    } else {
      $hrefAnchors{$frgid} = $. if $url eq '';
      if ($frgid =~ /\s/o) {
        &Whine($., 'fragment-id-whitespace', $tag, $frgid);
      } elsif ($frgid =~ /%/o || $frgid !~ /^(?:$RFC2396::fragment)$/o) {
        &Whine($., 'unsafe-fragment-id', $tag, $frgid);
      }
    }
  }
  if ($needprchar) {
    &Whine($., 'link-separation', $tag);
    $needprchar = 0;
  }
  $ahref = 1;
}
sub CheckTagAttrIMG_ALT
{
  @imgAlt = ($., $tag, $attr, $value);
}
sub CheckTagAttrIMG_USEMAP
{
  foreach (reverse @tagsNest) {
    if ($$_[0] eq 'BUTTON') {
      &Whine($., 'button-usemap', $$_[0], $tag, $attr);
      last;
    }
  }
}
sub CheckTagAttrOBJECT_TITLE
{
  $titleattr = $ln;
}
sub CheckTagAttrOPTION_SELECTED
{
  if (@seenSelect && !$seenSelect[1]) {
    if (@selOption) {
      my $msg = ($tagsAttributes{'SELECT'}->{'MULTIPLE'} ne '')?
        $seenSelect[0].'行目の <SELECT> に MULTIPLE 属性を指定してください。': '';
      &Whine($., 'multiple-selected', $tag, $selOption[0], $msg);
    }
    @selOption = ($., $tag);
  }
}
sub CheckTagAttrFONT_COLOR
{
  &CheckBgColor($attr, $value);
}

sub CheckAttrLANG
{
  $lang = [ $value, $. ];
}
sub CheckAttrALT
{
  &Whine($., 'alt-spaces', $tag, $attr) if $value =~ /^(?:&nbsp;?|\s)+$/o;
}
sub CheckAttrISMAP
{
  &Whine($., 'server-side-image-map', $tag, $attr);
}
sub CheckAttrTARGET
{
  &Whine($., 'illegal-target-name', $tag, $attr, $value)
    if $value !~ /^(?:$::reservedFrameNames)$/o && $value !~ /^[A-Za-z]/o;
}
sub CheckAttrSTYLE
{
  &Whine($., 'need-content-xxxx-type', $tag, 'CONTENT-STYLE-TYPE', $attr)
    if !$seenAllTags{'META'.$nameSep.'CONTENT-STYLE-TYPE'};
}
sub CheckAttrINTRINSIC
{
  &Whine($., 'need-content-xxxx-type', $tag, 'CONTENT-SCRIPT-TYPE', $attr)
    if !$seenAllTags{'META'.$nameSep.'CONTENT-SCRIPT-TYPE'};
}
sub CheckAttrTABINDEX
{
  &WhineAttributeFormat('[0-32767]') if $value < 0 || $value > 32767;
}
sub CheckAttrDISABLED
{
  $disabled++;
}

sub CheckTagHTML
{
  if (!$opt_lang &&
      $seenAttrs{'LANG'} eq '' && $tagsAttributes{$tag}->{'LANG'} ne '') {
    &Whine($., 'html-lang', $tag);
  }
}
sub CheckTagBODY
{
  if (!$multibody++) {
    $bodyline = $.;
    foreach (qw(BGCOLOR TEXT LINK VLINK ALINK)) {
      $seenAllTags{'BODY'.$nameSep.$_}++ if $seenAttrs{$_} ne '';
    }
  }
  if ($tagsAttributes{'BODY'}->{'BGCOLOR'} ne '' &&
      $seenAttrs{'BACKGROUND'} ne '' && $seenAttrs{'BGCOLOR'} eq '') {
    &Whine($., 'background', $tag, 'BACKGROUND', 'BGCOLOR');
  }
  $bgcolor = &HexColor($seenAttrs{'BGCOLOR'}) if $seenAttrs{'BGCOLOR'} ne '';
  &CheckBgColor('TEXT',  $seenAttrs{'TEXT'});
  &CheckBgColor('LINK',  $seenAttrs{'LINK'});
  &CheckBgColor('VLINK', $seenAttrs{'VLINK'});
  &CheckBgColor('ALINK', $seenAttrs{'ALINK'});
}
  sub CheckBgColor
  {
    if ($bgcolor ne '') {
      my ($attr, $col) = @_;
      $col = &HexColor($col);
      if ($col ne '') {
        if (hex($col) == hex($bgcolor)) {
          &Whine($., 'same-bgcolor', $tag, $attr);
        } elsif (&NearColor($col, $bgcolor)) {
          &Whine($., 'near-bgcolor', $tag, $attr);
        }
      }
    }
  }
  sub HexColor
  {
    my $col = shift;
    ($col =~ /^#?([0-9A-Fa-f]{6})$/o)? $1: $colorTable{lc($col)};
  }
  sub NearColor
  {
    my @x = shift =~ /(..)/g;
    my @y = shift =~ /(..)/g;
    foreach (0..2) {
      return 0 if int((hex($x[$_])-hex($y[$_]))/(0x33/2));
    }
    1;
  }
sub CheckTagLINK
{
  if (uc($seenAttrs{'REV'}) eq 'MADE') {
    if ($seenAttrs{'HREF'} =~ /^mailto:/oi) {
      $seenTags{'LINK'.$nameSep.'MAILTO'} = $.;
    }
  }
  if (uc($seenAttrs{'REL'}) eq 'CONTENT') {
    &Whine($., 'mistype-links', $tag, 'REL', $seenAttrs{'REL'}, 'CONTENTS');
  }
  if ($seenAttrs{'REL'} =~ /^(?:INDEX|NEXT|PREV(IOUS)?|CONTENTS|TOC)$/oi) {
    if ($seenAttrs{'HREF'} ne '') {
      $seenTags{'LINK'.$nameSep.'NAVIGATE'} = $.;
    }
  }
}
sub CheckTagMETA
{
  if ($seenAttrs{'HTTP-EQUIV'} =~ /^(CONTENT-.+-TYPE)$/oi) {
    my $content_type = uc($1);
    &Whine($., 'existing-content-type', $tag, $content_type,
              $seenTags{$tag.$nameSep.$content_type})
           if $seenTags{$tag.$nameSep.$content_type};
    $seenTags{$tag.$nameSep.$content_type} = $.;
    $seenAllTags{$tag.$nameSep.$content_type}++;
  } elsif ($seenAttrs{'HTTP-EQUIV'} =~ /^(CONTENT-TYPE)$/oi) {
    my $content_type = uc($1);
    &Whine($., 'existing-content-type', $tag, $content_type,
              $seenTags{$tag.$nameSep.$content_type})
           if $seenTags{$tag.$nameSep.$content_type};
    $seenTags{$tag.$nameSep.$content_type} = $.;
    if ($seenAttrs{'CONTENT'} ne '') { # 冗長だが念のため
      $seenAttrs{'CONTENT'} =~ m#^\s*([^\s;]+)(?:\s*;\s*)?(.*)#o;
      my $type = $1;
      my @param = split(/\s*;\s*/o, $2);
      unless ($type =~ m#^\s*text/html( |;|$)#oi) {
        &Whine($., 'no-text-html');
        &::PushStat('NoTextHtml', $type) if $opt_stat;
      }
      while (@param) {
        my ($a, $v) = shift(@param) =~ /^\s*([^\s=]+)\s*=\s*([^\s=]+)/o;
        if (uc($a) eq 'CHARSET') {
          $seenCharset = $.;
          $charset = $v if $opt_charset eq '';
          if ($v =~ /^(?:$charsets)$/oi) {
            if ($v =~ /^(?:$usascii)$/oi) {
              # US-ASCII
              if ($opt_charset eq '') {
                $charset = 'usascii';
              } elsif ($opt_charset !~ /^(?:$usascii)$/oi) {
                # 矛盾したCHARSET
                &Whine($., 'conflict-charset', $tag, $opt_charset, $v);
              }
            } else {
              # 日本語CHARSETか調べる
              foreach (keys %japanesesets) {
                if ($v =~ /^(?:$japanesesets{$_})$/i) {
                  if ($opt_charset eq '') {
                    $charset = $v;
                    $jcharcode = $_;
                  } elsif ($opt_charset !~ /^(?:$japanesesets{$_})$/i) {
                    # 矛盾したCHARSET
                    &Whine($., 'conflict-charset', $tag, $opt_charset, $v);
                  }
                  last;
                }
              }
            }
          } elsif ($opt_charset eq '') {
            $a = ''; # 以下の判定順序注意 (後勝ち)
            if ($Jcode && ($v =~ /utf\W*8/oi)) {
              $a = 'UTF-8';
              $jcharcode = 'utf8';
            }
            if ($v =~ /jis|2022|jp/oi) {
              $a = 'ISO-2022-JP';
              $charset = $v;
              $jcharcode = 'jis';
            }
            if ($v =~ /s(?:hift)?\W*(?:jis|jp)/oi) {
              $a = 'Shift_JIS|MS_Kanji';
              $charset = $v;
              $jcharcode = 'sjis';
            }
            if ($v =~ /euc\W*j/oi) {
              $a = 'EUC-JP';
              $charset = $v;
              $jcharcode = 'euc';
            }
            &Whine($., ($v =~ /^x-/oi)?
                        'no-registered-charset-ex':
                        'no-registered-charset', '', "<$tag>".' に',
                        $v, &FormatAttrGuide($a, '%s なら登録されています。'));
            &::PushStat('NoRegCharset', $v) if $opt_stat;
          }
        }
      }
      $seenCharset? $metaCharset++: &Whine($., 'no-charset');
    }
  } elsif (uc($seenAttrs{'HTTP-EQUIV'}) eq 'REFRESH') {
    &Whine($., 'existing-content-type', $tag, 'REFRESH',
              $seenTags{$tag.$nameSep.'REFRESH'})
           if $seenTags{$tag.$nameSep.'REFRESH'};
    $seenTags{$tag.$nameSep.'REFRESH'} = $.;
    if ($seenAttrs{'CONTENT'} =~ /^\d+(?:\s*(\W)\s*(.+))?/o) {
      my ($sep, $href) = ($1, $2);
      if ($sep) {
        $href = $1 if $sep eq ';' && $href =~ /^URL\s*=\s*(.*)/oi;
        local $attr = 'CONTENT';
        &CheckURL($href);
        @refreshHTML = ($., &NormalizeURL($href)) if $href;
      }
      &Whine($., 'refresh', $tag);
    }
  }
  if (uc($seenAttrs{'NAME'}) eq 'ROBOTS') {
#   &Whine($., 'robots-upper', $tag, $seenAttrs{'NAME'})
#     if $seenAttrs{'NAME'} ne 'ROBOTS';
    if ($::robotsContents ne '') {
      foreach (split(/\s*,\s*/o, $seenAttrs{'CONTENT'})) {
        &Whine($., 'robots-content', $tag, $_) unless /^(?:$::robotsContents)$/o;
      }
    }
  }
}
sub CheckTagSCRIPT
{
  &Whine($., 'content-xxxx-type', $tag, 'CONTENT-SCRIPT-TYPE', 'SCRIPT')
    if !$seenAllTags{'SCRIPT'} && !$seenAllTags{'META'.$nameSep.'CONTENT-SCRIPT-TYPE'};
}
sub CheckTagSTYLE
{
  &Whine($., 'content-xxxx-type', $tag, 'CONTENT-STYLE-TYPE', 'STYLE')
    if !$seenAllTags{'STYLE'} && !$seenAllTags{'META'.$nameSep.'CONTENT-STYLE-TYPE'};
}
sub CheckTagDD
{
  if ($htmlVer < 4) {
    &Whine($., 'must-follow-slight', $tag, '</DT>') if $lastPairTag ne 'DT';
  }
}
  sub CheckAttrNAME_ID
  {
    if ($htmlVer >= 4) {
      my $name = $seenAttrs{'NAME'};
      my $id   = $seenAttrs{'ID'};
      if ($name ne '' && $id ne '' && $name ne $id) {
        &Whine($., 'diff-id-link', $tag, $name, $id);
      }
    }
  }
sub CheckTagA
{
  if ($line =~ /^\s*($::hereAnchors|$::hereAnchorsJ)\s*</oi) {
    my $here = $1;
    $here =~ s/^\s+//o;
    $here =~ s/\s+$//o;
    &Whine($., 'here-anchor', $tag, $here);
    &::PushStat('HereAnchor', $here) if $opt_stat;
  }
  my $href = $seenAttrs{'HREF'};
  if ($href ne '') {
    $seenAllTags{'A'.$nameSep.'HREF'}++;
    undef @refreshHTML if @refreshHTML && &NormalizeURL($href) eq $refreshHTML[1];
  }
  my $name = $seenAttrs{'NAME'};
  if ($name ne '') {
    &Whine($., 'fragment-id-whitespace', $tag, $name) if $name =~ /\s/o;
    my $id = $seenAttrs{'ID'};
    my $same = 0;
    if ($htmlVer >= 4 && $id ne '') {
      if ($name eq $id) {
        $same = $.;
      } else {
        &Whine($., 'diff-id-link', $tag, $name, $id);
      }
    }
    my $uname = uc($name);
    if ($seenAnchors{$name}) {
      &Whine($., 'existing-fragment-id', $tag, $name, $seenAnchors{$name});
      $seenAnchors{$name} = $. unless $same;
      $same = 0;
    } else {
      $seenAnchors{$name} = $.;
      if ($seenAnchorsU{$uname}) {
        &Whine($., 'case-insensitive-fragment-id', $tag, $name, $seenAnchorsU{$uname});
      }
    }
    $seenAnchorsU{$uname} = $.;
    $seenAnchorsID{$uname} = $same;
  }
  undef @imgAlt;
}
sub CheckTagLABEL
{
  @seenLabel = ($., $seenAttrs{'FOR'}, $seenAttrs{'ACCESSKEY'});
  push(@seenLabels, [@seenLabel]);
}
sub CheckTagSELECT
{
  @seenSelect = ($., $seenAttrs{'MULTIPLE'});
}
sub CheckTagOPTION
{
  $selOptions++;
  if ($rule =~ /^imode/) {
    &Whine($., 'over-select-options', $tag, 20) if $selOptions == 21;
    &Whine($., 'option-value-length', $tag, 'VALUE', 10)
      if length($seenAttrs{'VALUE'}) > 10;
  }
}
sub CheckTagINPUT
{
  if ($seenAttrs{'NAME'} eq '' &&
      $seenAttrs{'TYPE'} !~ /^(?:IMAGE|SUBMIT|RESET|BUTTON)$/oi) {
    &Whine($., 'required-attribute', $tag, 'NAME');
    &::PushStat('RequiredAttr', $tag.' NAME') if $opt_stat;
  }
  if ($rule =~ /^imode/) {
    my ($size, $maxlen);
    if ($seenAttrs{'TYPE'} eq 'TEXT') {
      $size = 14;
      $maxlen = 256;
    } elsif ($seenAttrs{'TYPE'} eq 'PASSWORD') {
      $size = 14;
      $maxlen = 20;
    }
    local $attr = 'SIZE';
    local $value = $seenAttrs{$attr};
    &WhineAttributeFormat('<='.$size) if $size && $value > $size;
    $attr = 'MAXLENGTH';
    $value = $seenAttrs{$attr};
    &WhineAttributeFormat('<='.$maxlen) if $maxlen && $value > $maxlen;
  }
}
sub CheckTagTEXTAREA
{
  if ($rule =~ /^imode/) {
    local $attr = 'COLS';
    local $value = $seenAttrs{$attr};
    &WhineAttributeFormat('<=10') if $value > 10;
    $attr = 'ROWS';
    $value = $seenAttrs{$attr};
    &WhineAttributeFormat('<=6') if $value > 6;
  }
}
sub CheckTagTR
{
  $tableCell = 0;
  while ($tableInfo[$tableCell][0]) {
    $tableInfo[$tableCell++][0]--;
  }
}
sub CheckTagTHTD
{
  my $row = $seenAttrs{'ROWSPAN'}-1; $row = 0 if $row < 0;
  my $col = $seenAttrs{'COLSPAN'}-1; $col = 0 if $col < 0;
  foreach (0..$col) {
    if ($tableInfo[$tableCell][0] && $tableInfo[$tableCell][1] == 0) {
      &Whine($., 'overlap-cells', $tag, $tableInfo[$tableCell][2],
                                        $tableInfo[$tableCell][3]);
    }
    $tableInfo[$tableCell++] = [$row, $_, $., $tag];
  }
  while ($tableInfo[$tableCell][0]) {
    $tableInfo[$tableCell++][0]--;
  }
}
sub CheckTagBR
{
  if ($lastTag ne 'BR') {
    $contBRs = 0;
  } elsif ($contBRs++ == 1) {
    &Whine($., 'continuous-brs');
  }
}
sub CheckTagPRE
{
  $seenPre = $.;
}
sub CheckTagAPPLET
{
  push(@seenObject, [0, $., $seenAttrs{'ALT'}]);
  &CheckAttrNAME_ID;
}
sub CheckTagOBJECT
{
  push(@seenObject, [0, $., $seenAttrs{'ALT'}]);
}
sub CheckTagXML
{
  &Whine($., 'unsupported-tag', $tag);
  &Whine($., 'excluded-element', $tag, $tag, $xml) if $xml;
  $xml = $.;
}

##################################################
# 終了タグを処理する
# この終了タグに対応すると思われる開始タグは $tag である
# これは $tagsNest[$#tagsNest][0] と等しい
# 終了タグの処理をしたとき 1 が返る
# $tag に対応する終了タグを処理しなかったときは 0 が返る

sub ReadEndTag
{
  my $end = &GetTag;
  if ($end =~ m#^/(.*)#o) {
    my $id = $1;
    unless ($xml) {
      if ($id !~ /^(?:$pairTags)$/) {
        # 不明の終了タグ
        &WhineUnknownElement($end);
        &Whine($., 'closing-attribute', $tag, $id) if &AdvanceCloseTag($end, $.);
        return 0;
      }
      if ($id =~ /^(?:$emptyTags)$/) {
        # 空要素タグには終了タグはない
        &Whine($., 'illegal-closing', $tag, $id);
        &::PushStat('IllegalClosing', $id) if $opt_stat;
        &Whine($., 'closing-attribute', $tag, $id) if &AdvanceCloseTag($end, $.);
        return 0;
      }
    }
    if ($tag eq $id) {
      # 正しい終了タグ
      if ($tag =~ /^(?:$::cuddleContainers)$/) {
        &Whine($., 'container-whitespace', $tag, '末尾') if $token =~ /^\s/o;
      }
      &Whine($., 'closing-attribute', $tag, $id) if &AdvanceCloseTag($end, $.);
    } else {
      my $omit = &OmitEndTag($#tagsNest, $id);
      if ($omit) {
        # 終了タグは省略できる
        &UnGetToken;
        &WhineOmitEndTag($tag, $end, $omit);
      } else {
        my $oid = $#tagsNest;
        foreach (reverse 0..$#tagsNest-1) {
          if ($id eq $tagsNest[$_][0]) {
            if ($_ > 1 && !$xml) { # いちばん外側は除く
              if ($tagsNest[$_][0] =~ /^(?:$omitEndTags)$/ &&
                  $tagsNest[$_][0] =~ $tagsElements{$id}) {
                &Whine($., 'required-end-tag', $tag);
                &::PushStat('OmitEndTag', $tag) if $opt_stat;
              } else {
                # タグの入れ子がおかしい可能性あり
                &Whine($., 'element-overlap', $tag, $id, $tagsNest[$oid][1],
                                                         $tagsNest[$oid][0]);
                &Whine($., 'omit-end-tag', $tag, "</$id>".' の前に');
                &::PushStat('ElementOverlap', $id.' '.$tag) if $opt_stat;
              # &::PushStat('OmitEndTag', $tag) 統計上これは出力してはならない
              }
            } else {
              # 終了タグがない可能性
              &Whine($., 'unclosed-element', $tag, $tagsNest[$#tagsNest][1]);
              &::PushStat('UnclosedElement', $tag) if !$xml && $opt_stat;
            }
            &UnGetToken;
            return 1;
          }
          $oid = $_ if $tagsNest[$_][0] =~ /^(?:$omitEndTags)$/;
        }
        # おかしな終了タグ
        ($atag =~ /^(?:$pairTags)$/)? &Whine($., 'mis-match', $tag, $id):
                                      &Whine($., 'unknown-element', $end);
        &Whine($., 'closing-attribute', $tag, $id) if &AdvanceCloseTag($end, $.);
        return 0;
      }
    }
  } else {
    # 終了タグが現れなかったとき
    &UnGetToken;
    my $omit = &OmitEndTag($#tagsNest);
    if ($omit) {
      # 終了タグは省略できる
      &WhineOmitEndTag($tag, $end, $omit);
    } else {
      # 終了タグがない可能性
      if ($tag eq 'HTML' && !$reacheof) {
        # 途中で </HTML> は省略されないようにする
        # そのために、<BODY> がまだ現われていないとして処理する
        # この判定は、今では不要かも知れない
        my $rest = $..$nameSep.$line; # 無限ループを防ぐための細工
        if ($omit_html ne $rest) {
          $omit_html = $rest;
          undef $seenTags{'BODY'};
          return 0;
        }
      }
      &Whine($., 'unclosed-element', $tag, $tagsNest[$#tagsNest][1]);
      &::PushStat('UnclosedElement', $tag) if !$xml && $opt_stat;
    }
  }
  1;
}

##################################################
# 終了タグが省略できるか調べる
#    <A>
#    <B> -- <D> が禁止されている $tagsNest[$pn][0]
#    <C>
#    <D> -- これが現在のタグ $tag
# 現在のタグが終了タグならば第２引数にそれがセットされている (除/)
# そのとき $tag はそれに対応すると予想される開始タグ
# <D> が空要素タグでなく、省略によって直前のタグ <C> の要素が空にならず、
# </C> </B> が省略可で、<A> 内に <D> が書けるとき、
# </C> が省略できるとする
# また、<C> <D> が順序タグのひとつのときは、省略できそうならできるとする
# 省略できないときは 0 が返る

sub OmitEndTag
{
  my ($pn, $end, $whine) = @_;
  return 0 if $pn < 0 || $xml;
  my $last = $tagsNest[$#tagsNest][0];
  # まだテキストがあるときは </HTML> を省略できない
  return 0 if $last eq 'HTML' && !$reacheof;
  return 1 if $#tagsNest == 0;
  # 空要素タグか直前のタグが省略不可のときは省略できない
  return 0 if $tag =~ /^(?:$emptyTags)$/ || $last !~ /^(?:$omitEndTags)$/;
  # 前の開始タグが省略されて要素が空のときは省略できない
  # $pn > 1 というのは <HEAD></HEAD> 等の対処
  return 0 if $pn == $#tagsNest && $pn > 1 && !$innerTags && $lastOmitTag;
  my $last1 = $tagsNest[$#tagsNest-1][0];
  if ($pn) {
    # 省略したときこのタグが書けるかどうか調べる
    my $ext = &ExpandInternalElements($tagsElements{$tagsNest[$pn-1][0]});
    if ($tag ne $tagsNest[$pn-1][0] && $tag !~ /^(?:$ext)$/) {
      my $omit = 0;
      # 開始タグを省略したときのことも考慮する (とりあえず1段のみ)
      foreach (split(/\|/o, $ext)) {
        if (/^($omitStartTags)$/) {
          my $oext = &ExpandInternalElements($tagsElements{$_});
          if ($tag =~ /^(?:$oext)$/) {
            $omit++;
            last;
          }
        }
      }
      return 0 unless $omit;
    }
  }
  if (!$end && $last1 =~ /^(?:$sequencialTags)$/) {
    # 順序タグのひとつのとき
#   return 1 if $last =~ /^(?:$omitEndTags)$/;
    my $ext = &ExpandInternalElements($onceonlyTags{$last1});
    # 次の判定はあまり正確じゃない
    if ($tag =~ /^(?:$ext)$/ && $last !~ /^(?:$ext)$/) {
      $ext = &ExpandInternalElements($tagsElements{$last1});
      return 1 if $tag =~ /^(?:$ext)$/;
    }
  }
# return 0 if $last eq $lastTag; # 直前のタグが空
  foreach (reverse $pn..$#tagsNest-1) {
    # 途中のタグが省略可かどうか調べる
    return 0 unless $tagsNest[$_][0] =~ /^(?:$omitEndTags)$/;
  }
  if ($end) {
    # 現れたのが終了タグのとき
    foreach (reverse 0..$#tagsNest-1) {
      # 対応する開始タグが存在するか調べる
      if ($end eq $tagsNest[$_][0]) {
        undef $end;
        last;
      }
      next if $_ >= $pn; # すでに次はチェック済み
      # 存在するならそこまでのタグが全部省略可か調べる
      return 0 unless $tagsNest[$_][0] =~ /^(?:$omitEndTags)$/;
    }
    return 0 if $end;
  }
  2;
}

##################################################
# #NNN 形式の内部要素を展開する

sub ExpandInternalElement
{
  my $elem = shift;
  &ExpandInternalElements($tagsElements{$elem});
# &ExpandInternalElements($tagsElements{shift}); だとうまくいかない
}

sub ExpandInternalElements
{
  my $elem = shift;
  $elem =~ s/($internalElem)/&ExpandInternalElement($1)/oge;
  $elem;
}

##################################################
# 属性値を調べる
# 不明な属性のとき 0 が返る

sub CheckAttribute
{
  my ($tag, $attr) = @_;
  my $avals = $tagsAttributes{$tag}->{$attr};
  if ($avals eq '') {
    &WhineUnknownAttribute($tag, $attr);
    $quot = '';
    return 0;
  }
  if (StrLength($value) > 1024) {
    &Whine($., 'attribute-length', $tag, $attr, 1024);
  }
  my $icase = '(?i)';  # 大文字小文字を区別しない
  if ($avals =~ /^%(.*)/o) {
    $icase = ''; # このときは大文字小文字を区別する
    $avals = $refParams{$1};
  } elsif ($avals !~ /^(?:$charData)$/oi) {
    # 候補値の列挙 (大文字小文字を区別しない)
    if ($value eq '') {
      &Whine($., 'empty-value', $tag, $attr);
    } else {
      &WhineWhiteSpaceInValue;
      if ($value =~ /^(?:$avals)$/i) {
        if ($attr =~ /^(?:$avals)$/i) {
          &Whine($., 'minimized-attribute', $tag, $attr);
          &::PushStat('MinimizedAttribute', $tag.' '.$attr) if $opt_stat;
        }
        my $dvals = $deprecatedVals{$tag.$nameSep.$attr};
        if ($dvals && $value =~ /^(?:$dvals)$/i) {
          &Whine($., 'deprecated-value', $tag, $attr, $value);
        }
      } else {
        &WhineAttributeFormat(($attr =~ /^(?:$avals)$/i)? '': $avals);
      }
    }
    $quot = '';
    return 1;
  }
  if ($avals =~ /^&/o) {
    eval $avals;
  } elsif ($avals eq 'CDATA') {
    &CDATA;
  } elsif ($avals eq 'CDATA+') {
    if ($value eq '') {
      &Whine($., 'empty-value', $tag, $attr);
    } else {
      &CDATA;
    }
  } else {
    &WhineWhiteSpaceInValue;
    my $tvals = $tokenizedType{$avals} || $avals;
    if ($value =~ /^(?:$icase$tvals)$/) {
      if ($avals eq 'ID') {
        my $uval = uc($value);
        &Whine($., 'repeated-id', $tag, $attr, $value, $iddef{$uval}) if $iddef{$uval};
        $iddef{$uval} = $.;
      } elsif ($avals eq 'IDREF') {
        my $uval = uc($value);
        $idref{$uval} = $..$nameSep.$tag.$nameSep.$attr;
      } elsif ($avals eq 'IDREFS') {
        foreach (split(/\s*,\s*|\s+/o, $value)) {
          my $uval = uc;
          $idref{$uval} = $..$nameSep.$tag.$nameSep.$attr;
        }
      }
    } elsif ($value eq '') {
      &Whine($., 'empty-value', $tag, $attr);
    } else {
      &WhineAttributeFormat($avals);
    }
  }
  $quot = '';
  1;
}

##################################################
# テキストの文字コードが日本語かどうか調べる

sub CheckLanguageCode
{
  if ($textcode =~ /^(?:jis|euc|sjis)$/ &&
      ${$lang}[0] ne '' && ${$lang}[0] !~ /^ja(?:-JP)?$/oi) {
    my $text = shift;
    my $code = &Jgetcode(\$text);
    return $japanesesets{$code} ne '';
  }
  0;
}
sub WhineLanguageCode
{
  my ($ln, $whine, $tag, $attr) = @_;
  &Whine($ln, $whine, $tag, $attr, ${$lang}[0],
         ${$lang}[1]? ${$lang}[1].'行目で': 'HTTPレスポンスヘッダに');
}

##################################################
# 必要な属性を付けるよう促がす警告を表示する

sub WhineRecommendedAttribute
{
  my ($ln, $attr, $recommended, $whine) = @_;
  if ($tag =~ /^(?:$recommended)$/ &&
      $tagsAttributes{$tag}->{$attr} ne '' && $seenAttrs{$attr} eq '' &&
      # <INPUT TYPE=HIDDEN> は除く
      ($tag ne 'INPUT' || uc($seenAttrs{'TYPE'}) ne 'HIDDEN')) {
    &Whine($ln, $whine, $tag);
  }
}

##################################################
# 正しくない属性に関する警告を表示する

sub WhineAttributeFormat
{
  my $avals = shift;
  my $cdata ='';
  if ($avals =~ /^($charData)$/oi) {
    $cdata = $1;
    $cdata = ($avals =~ /^CDATA/oi)? '': "($cdata)";
    $avals = ($avals =~ /^ID/oi)? '英字から始まる名前文字列':
             ($avals =~ /^NUMBER/oi)? '数値':
             ($avals =~ /^NAME/oi)? '英字から始まる名前文字列':
             ($avals =~ /^NMTOKEN/oi)? '名前文字列':
             ($avals =~ /^NUTOKEN/oi)? '数字から始まる名前文字列':
             '';
  } else {
    $avals = ($avals =~ /#\[0-9A-F\]\{6\}/oi)? '#XXXXXX の形式か決められた色の名前':
             ($avals eq '\d+')? '数値':
             ($avals eq '\d+%?')? '数値か %付きの数値':
             ($avals eq '(\d+(\.\d+)?(\*|%)?|\*)')? '数値か %付きの数値か *付きの数値':
             ($avals =~ /^\[(\d+)-(\d+)\]$/o)? $1.'～'.$2.' ':
             ($avals =~ /^<=(\d+)$/o)? $1.'以下':
             ($avals eq '[+|-]?[1-7]')? '±1～±7 ':
             ($avals eq '[\x20-\x7E]')? 'ASCII１文字':
             ($avals eq '[0-9#\*]')? '0～9 # * ':
             ($avals =~ /^$tokenStr(?:\|$tokenStr)+$/)? &FormatAttrGuide($avals, '%s '):
             '';
  }
  $avals .= ($avals ne '')? $cdata.'でなければなりません。': $cdata;
  &Whine($., 'attribute-format', $tag, $attr, $value, $avals);
}

##################################################
# 空白が含まれる属性値の警告を表示する
# 警告後 $value の先行後行する空白は捨てられる
# 空の場合は除く

sub WhineWhiteSpaceInValue
{
  if ($value =~ /^\s|\s$/o) {
    &Whine($., 'whitespace-attribute-value', $tag, $attr, $value);
    $value =~ s/^\s+//o;
    $value =~ s/\s+$//o;
  }
}

##################################################
# <LI TYPE=> の属性を評価する

sub LIStyle
{
# &CDATA;
  &CheckAttribute($tagsNest[$#tagsNest][0], $attr);
}

##################################################
# <OL TYPE=> の属性を評価する

sub OLStyle
{
  &CDATA;
  if ($value eq '') {
     &Whine($., 'empty-value', $tag, $attr);
  } else {
    &WhineWhiteSpaceInValue;
    my $OLStyle = ($rule =~ /^imode/)? '1|a|A': '1|a|A|i|I';
    &WhineAttributeFormat($OLStyle) unless $value =~ /^(?:$OLStyle)$/;
  }
}

##################################################
# URL 属性を評価する
# 属性は $value に入っており、結果もそこに入る

sub URL
{
  &CDATA;
  $seenURL = $. if $tag ne 'BASE';
  &CheckURL($value);
}

sub CheckURL
{
  my $value = shift;
  if ($value =~ /^\s*$/o) {
    &Whine($., 'empty-url', $tag, $attr);
  } else {
    my ($scheme, $url) = &SplitFragmentID($value);
    if ($scheme ne '') {
      if ($scheme =~ /^(?:$::allSchemes)$/oi ||
          $scheme =~ /^(?:${$::doctypes{$rule}}{scheme})$/i) {
        &Whine($., 'upper-protocol', $tag, $attr, $scheme) if $scheme ne lc($scheme);
      } elsif ($scheme =~ /^(?:$RFC2396::scheme)$/o) {
        &Whine($., 'upper-protocol', $tag, $attr, $scheme) if $scheme ne lc($scheme);
        &Whine($., 'unknown-protocol', $tag, $attr, $scheme);
        &::PushStat('UnknownProtocol', $scheme) if $opt_stat;
      } else {
        &Whine($., 'illegal-protocol', $tag, $attr, $scheme);
      }
      $scheme =~ tr/A-Z/a-z/;
      if ($scheme eq 'javascript') {
        &Whine($., 'javascript-url', $tag, $attr, $scheme);
      }
    }
    my $whine = 0;
    my $illchar = 0;
    my $ok = 1;
    my $urlorg = $url;
    my $http   = $scheme =~ /^(?:$::httpSchemes)?$/o; # 空のときも http
    my $syntax = \&{'RFC2396::URL_'.($http? 'http': $scheme)};
    my $chkurl = ($opt_base ne '' && defined(&::AskHTML) && $http &&
                 ($enabled{'cant-get-url'} > 0.0 || $opt_pedantic));
    if ($http || defined(&$syntax)) {
      &Whine($., 'url-whitespace', $tag, $attr, $url), $whine++ if $url =~ /\s/o;
      &Whine($., 'url-backslash',  $tag, $attr, $url), $whine++ if $url =~ /\\/o;
      if ($url =~ /$RFC2396::control/o) {
        &Whine($., 'no-corresponding-url', $tag, $attr, $url);
        &Whine($., 'illegal-format-url', $tag, $attr, $url);
        $whine++;
      }
      if ($ok = !$whine) {
        # URL 中の実体参照をチェックしてデコードする (このチェック不完全)
        my $urlscan = $url;
        my $exurl = '';
        while ($urlscan =~ /^([^&]*)(&.*)/o) {
          my ($scanned, $c) = ($1);
          ($urlscan, $c) = &CheckRefEntities($2, 1);
          $exurl .= $scanned.$c;
          $illchar += &CheckCharURL($scanned, $url);
        }
        $illchar += &CheckCharURL($urlscan, $url);
        $url = $exurl.$urlscan;
        $ok = !$whine;
      }
      if ($ok) {
        if ($scheme eq '') {
          $ok = $url =~ /^$RFC2396::relativeURI$/o if $url ne '';
        } else {
          # URL中のスキームを小文字にする
          substr($url, 0, length($scheme)) = $scheme;
          if ($http) {
            $ok = $url =~ /^$RFC2396::URL_http$/o;
            if ($ok) {
              my ($path) = $url =~ m#^\w+://(?:[^/]+)(.*)$#o;
              if (!$chkurl) {
                &Whine($., 'trailing-slash', $tag, $attr, $urlorg)
                  if $path =~ m#^/(?:~|%7E)[^/]+$#oi;
              }
              # index.html の省略を調べる
              my $urlxquery = $1 if $url =~ /^([^?]*)[?]/o;
              my $filespec = &NormalizeURL($urlxquery);
              if ($filespec =~ m#^(.*?)/$#o) {
                &Whine($., 'conflict-directory', $tag, $attr, $urlorg,
                       $indexhtml{$1}[0], $indexhtml{$1}[1]) if $indexhtml{$1};
                foreach (keys %indexhtml) {
                  if (m#^$filespec$::INDEXHTML$#i) {
                    &Whine($., 'index-html', $tag, $attr, $urlorg,
                           $indexhtml{$_}[0], $indexhtml{$_}[1]);
                    last;
                  }
                }
              } else {
                my $dir = $filespec.'/';
                &Whine($., 'conflict-directory', $tag, $attr, $urlorg,
                       $indexhtml{$dir}[0], $indexhtml{$dir}[1]) if $indexhtml{$dir};
                if ($filespec =~ m#(?:^|/)($::INDEXHTML)$#oi) {
                  substr($dir = $filespec, -length($1)) = '';
                  &Whine($., 'index-html', $tag, $attr, $urlorg,
                         $indexhtml{$dir}[0], $indexhtml{$dir}[1]) if $indexhtml{$dir};
                }
              }
              $indexhtml{$filespec} = [ $., $urlxquery ];
            }
          } elsif (defined(&$syntax)) {
            if ($ok) {
              $ok = $url =~ /^$RFC2396::absoluteURI$/o && &$syntax($url);
            }
            if ($scheme eq 'file') {
              # file:/// まで見た方がいいかも
              &Whine($., 'local-protocol', $tag, $attr, $urlorg) unless $opt_local;
            }
          }
        }
      }
    } else {
#     $ok = $url =~ /^$RFC2396::absoluteURI$/o;
      # 知らないスキームはチェックしない方がよい
      # 例えば javascript: などはネットワーク上を流れないので
      # RFC の守備範囲外かも知れず、どんな文字でも書けそうだ
      # 現に javascript:document.write("xxxx") などと普通に使われるだろう
    }
    if ($ok) {
      # URL が実存するか調べる (いつもチェックすると時間がかかる)
      if ($chkurl) {
        defined($stathtml{$url}) or ($stathtml{$url} = &::AskHTML($opt_base, $url));
        my ($stat, $rurl, $ctype, $length) = @{$stathtml{$url}};
        &Whine($., 'cant-get-url', $tag, $attr, $url, ($stat > 0)? "($stat)": '')
          if !($stat >= 200 && $stat < 600 &&
               $stat != 403 && $stat != 404 && $stat != 410);
        &Whine($., 'trailing-slash', $tag, $attr, $url)
          if $stat == 200 && $rurl =~ m#$url/$#i &&
             $url !~ m#^\w+://[^/]+$#o; # ドメイン名だけの場合は除く
        if ($tag eq 'IMG') {
          if ($attr eq 'SRC' && $rule =~ /^imode/) {
            &Whine($., 'unsupported-image', $tag, $attr, $url,
              ${$::doctypes{$rule}}{guide}) if $ctype ne '' && $ctype ne 'image/gif';
            $readsize += $length;
          }
        } elsif ($tag eq 'FRAME') {
          if ($attr eq 'SRC') {
            &Whine($., 'frame-image', $tag, $attr)
              if $ctype ne '' && $ctype !~ m#^\s*text/html( |;|$)#oi;
          }
        }
      }
    } elsif (!$whine) {
      &Whine($., 'illegal-format-url', $tag, $attr, $urlorg);
      &::PushStat('IllegalFormatURL', $urlorg) if !$illchar && $opt_stat;
    }
  }
}

# 使えない文字をチェックする
sub CheckCharURL
{
  my ($urlscan, $url, $nowhine) = @_;
  my $whine = 0;
  while ($urlscan =~ /($RFC2396::delimunwise|$unsafeuri)(.*)/o) {
    $urlscan = $2;
    my $c = substr($1, 0, 1);
    next if $1 eq '\\'; # すでに警告済み
    next if $1 eq '%' && $urlscan =~ /^$RFC2396::hex2/o;
    unless ($nowhine) {
      my $x = sprintf('%%%02X', ord($c));
      &Whine($., ($c =~ /$unsafeuri/o)? 'unsafe-url': 'excluded-url',
                 $tag, $attr, $url, $c, $x);
      $whine++;
    }
  }
  $whine;
}

##################################################
# URL を正規化する (httpのみ)

sub NormalizeURL
{
  my $url = shift;
  my ($domain, $filespec) = $url =~ m@^(\w+://[^/]+)?([^#\?]*)$@o;
  $domain =~ s#^(\w+://)#\L$1\E#o;
  $filespec = &NormalizeDots($filespec);
  if ($filespec eq '' || ($domain eq '' && $filespec =~ m#^[^/.]#)) {
    $filespec = './'.$filespec;
  }
  $domain.$filespec;
}

##################################################
# URL からアンカー名を分離する

sub SplitFragmentID
{
  my $url = shift;
  my ($scheme) = $url =~ /^($RFC2396::scheme):/o;
  my $frgid;
  if ($scheme =~ /^(?:$::httpSchemes)?$/oi) {
    my $cref = ($htmlVer >= 4)? '\d|x[0-9A-F]': '\d';
    my $sp;
    ($url, $sp, $frgid) =
      split(/((?=^|[^&])#|(?=&)#(?!$cref)|&#23;?(?!\d))/i, $url, 2);
    $frgid = '#'.$frgid if $sp ne '';
  }
  ($scheme, $url, $frgid);
}

##################################################
# CDATA 属性を評価する
# 属性は $value に入っており、結果もそこに入る

sub CDATA
{
  unless ($quot) {
    while ($value =~ /([<&>])(.*)$/o) {
      if ($1 eq '&') {
        ($value) = &CheckRefEntities($1.$2);
      } else {
        $value = $2;
        &WhineRefEntities($1);
      }
    }
  }
}

##################################################
# CDATA/RCDATA を読む
# CDATA/RCDATA の終了は、本来 </ であるがそうはしていない
# 読まれた文字列は捨てられる

sub ReadCDATA
{
  my $type = shift; # CDATA or RCDATA
  my $tag = $tagsNest[$#tagsNest][0];
  my ($start, $last);
  if (&GetLine =~ /^(<!--)($allc*)/) {
    ($start, $line) = ($1, $2);
  }
  my $elem = 0;
  while (&GetLine ne '') {
    my ($etag, $rest) = ('', '');
    ($line, $etag, $rest) = split(m#(</)#o, $line, 3) if $line =~ m#</#o;
    if ($line =~ /\S/o) {
      $elem++;
      $last = $line;
      if ($type eq 'RCDATA') {
        while ($line =~ /(&$allc*)/o) {
          ($line) = &CheckRefEntities($1);
        }
      }
    }
    if ($etag) {
      if ($rest =~ m#$tag[\s>]#i) {
        # 終わり
        $line = $etag.$rest;
        last;
      }
      &Whine($., 'etago-in-cdata', $tag) if $type eq 'CDATA';
    }
    $line = $rest;
  }
  if ($elem && $tag =~ /^(?:$::commentedElement)$/oi) {
    &Whine($., 'comment-element', $tag)
      unless $start =~ /^<!--/o && $last =~ /--\s*>\s*$/o;
  }
}

##################################################
# #PCDATA を読む
# 読まれた文字列は $pcdata にセットされる

sub ReadPCDATA
{
  $pcdata = '';
  my ($ln, $lnja);
  while () {
    if ($seenPre && $pretab && $ln != $.) {
      &Whine($ln = $., 'tab-in-pre', 'PRE', $seenPre);
    }
    $pretab = 0;
    $pcdata .= ' ' if $line =~ /^\s+/o;
    &SkipComment;
    last if $line eq '';
    if ($line =~ /^([^<&">]*)([<&">])($allc*)/o) {
      my ($pre, $delim, $rest) = ($1, $2, $3);
      $line = $delim.$rest;
      if ($delim eq '<' && $pre =~ /\S/o && $p_isnot_br != $. && 'P' =~ /^(?:$pairTags)$/) {
        my $chlin = uc($line);
        chomp($chlin);
        if ($chlin eq '<P>') {
          &Whine($., 'p-isnot-br');
          $p_isnot_br = $.;
        }
      }
      if ($lnja != $. && &CheckLanguageCode($pre)) {
        &WhineLanguageCode($., 'lang-pcdata');
        $lnja = $.;
      }
      $pcdata .= $pre;
      if ($delim eq '&') {
        $pcdata .= $line;
        ($line) = &CheckRefEntities($line);
        substr($pcdata, -length($line)) = '';
      } else {
        last if $delim ne '"' && &CheckTag ne '';
        &WhineRefEntities($delim);
        $pcdata .= $delim;
        $line = $rest;
      }
    } else {
      if ($lnja != $. && &CheckLanguageCode($line)) {
        &WhineLanguageCode($., 'lang-pcdata');
        $lnja = $.;
      }
      $pcdata .= $line;
      $line = '';
    }
    $pretab++ if $pcdata =~ /\t/o;
  }
  if ($pcdata =~ /^(.*?)(\s+)$/o) {
    # 後行する空白は戻す
    $line = $2.$line;
    $pcdata = $1;
  }
}

##################################################
# 開きタグかどうかチェックする
# $line が開きタグなら < から始まる文字列が返る

sub CheckTag
{
  my $tag = '';
  if ($line =~ m#^(<(?:(\s*)/?($nameStr)|!(?:$nameStr)?))#) {
    $tag = $1;
    # 空白が含まれているときは正しいタグのみ通す
    $tag = '' if $2 ne '' && $3 !~ /^(?:$emptyTags|$pairTags)$/i;
  }
  $tag;
}

##################################################
# 開きタグを得る
# $token に < を含む文字列が求まる
# < と空白を取り除いて大文字にした文字列が返る
# 次のトークンが開きタグでない場合は空文字列

sub GetTag
{
  my $tag = '';
  my $leadingspace = &SkipComment;
  if (($token = &CheckTag) =~ /^<(.*)/o) {
    my $id = $1;
    $tag = uc($id);
    &Whine($., 'leading-whitespace', $tag) if $tag =~ s/\s+//og;
    &CheckCase($id, 0) unless $tag =~ /!/o;
    $line = substr($line, length($token));
  }
  $token = ' '.$token if $leadingspace;
  $tag;
}

##################################################
# $token を $line に戻す

sub UnGetToken
{
  $line = $token.$line;
}

##################################################
# 閉じタグ > まで読み飛ばす
# 途中に何か文字があれば 1 が返る

sub AdvanceCloseTag
{
  my ($tag, $ln) = @_;
  if (&GetLine =~ /^>($allc*)/o) {
    $line = $1;
    return 0;
  }
  my $ret = $line ne '';
  if ($ret) {
    while (&GetLine ne '') {
      if ($line =~ /([<>])($allc*)/o) {
        if ($1 eq '<') {
          &Whine($., 'unexpected-open', $tag);
        } else {
          $line = $2;
        }
        return 1;
      }
      $line = '';
    }
  }
  &Whine($., 'unclosed-tag', $tag, $ln);
  $ret;
}

##################################################
# 文字数を勘定する

sub StrLength
{
  my $str = shift;
  my $len = 0;
  my $dbcs;
  foreach (unpack('C*', $str)) {
    if ($dbcs) {
      undef $dbcs;
    } else {
      $len++;
      $dbcs = $_ >= 0x0080; # sjis/euc の DBCS を想定
    }
  }
  $len;
}

##################################################
# 大文字小文字をチェックする

sub CheckCase
{
  my ($id, $typ) = @_;
  if    ($id eq lc($id)) { $lcase[$typ]++; $lcaseln[$typ] = $.; }
  elsif ($id eq uc($id)) { $ucase[$typ]++; $ucaseln[$typ] = $.; }
  else                   { $xcase[$typ]++; $xcaseln[$typ] = $.; }
}

##################################################
# $tag の属性名を $token と $attr に得る

sub GetAttrName
{
  $token = $attr = $subattr = '';
  my $leadingspace = $line =~ /^(?:\s|$)/o;
  while (&GetLine ne '') {
    if ($line =~ /^($nameStr|>)($allc*)/) {
      ($token, $line) = ($1, $2);
      if ($token ne '>') {
        &CheckCase($token, 1);
        $attr = uc($token);
        &Whine($., 'leading-space-attribute', $tag, $attr) unless $leadingspace;
        if ($attr =~ /^([^:]+:)(.*)/o) {
          # IE5 の XMLNS:namespace 対応
          my ($xmlns, $suffix) = ($1, $2);
          foreach (keys %tagsAttributes) {
            if ($tagsAttributes{$_}->{$xmlns} ne '') {
              &Whine($., 'unsupported-attribute', $tag, $attr);
              ($attr, $subattr) = ($xmlns, $suffix);
              push(@xmlns, $subattr);
              last;
            }
          }
        }
      }
      last;
    }
    chomp($line);
    my $rest;
    if ($line =~ /^([^\s\x21-\x2F\x3A-\x3F]*)([\s\x21-\x2F\x3A-\x3F])($allc*)/o) {
      ($rest, $line) = ($1, $3);
      if ($2 =~ /([<\s>])/o) {
        $line = $1.$line;
      } else {
        $rest .= $1;
      }
      if ($line =~ /^</o) {
        &Whine($., 'unexpected-open', $tag);
        $line = '>'.$line;
      } else {
        &Whine($., 'illegal-attribute', $tag, $rest);
      }
    } else {
      $rest = $line;
      $line = '';
      &Whine($., 'illegal-attribute', $tag, $rest);
    }
  }
  $attr;
}

##################################################
# $tag の属性 $attr の属性値を $token に得る
# $quot に引用符の種類が入る

sub
GetAttrValue
{
  $quot = '';
  $token = '';
  if (&GetLine =~ /^(["'])($allc*)/o) {
    ($quot, $line) = ($1, $2);
    my $quotregexp = "[<$quot>]";
    my $notquotregexp = "[^<$quot>]";
    my $across = 0;
    while () {
      if ($line =~ /^($notquotregexp*)($quotregexp)($allc*)/) {
        if ($2 eq $quot) {
          $token .= $1;
          $line = $3;
#         if ($token eq '') {
#           &Whine($., 'empty-value', $tag, $attr);
#         }
          if ($quot eq "'") {
            ($quot = $token) =~ s/"/&quot;/og;
            &Whine($., 'attribute-delimiter', $tag, $attr, $token, $quot);
          }
          last;
        } elsif ($2 eq '>') {
          $token .= $1;
          $line = $3;
#         if ($line =~ /^([^<"'>]*)$quot/) {
#           後続に引用符があり、< も > もそれ以前に現われないときは
#           引用符が閉じられているとみなしてもよい
#           $token .= '>';
#           &WhineRefEntities('>');
#         } else {
            $line = '>'.$line;
            &Whine($., 'unclosed-quotes', $tag, $attr);
            last;
#         }
        } else {
          $token .= $1.$2;
          $line = $3;
          &WhineRefEntities($2);
        }
      } else {
        chomp($line);
        $token .= $line.' ';
        $line = '';
        if (&GetLine eq '') {
          &Whine($., 'unclosed-quotes', $tag, $attr);
          last;
        }
        $across++;
      }
    }
    &Whine($., 'across-lines-attribute', $tag, $attr) if $across;
  } else {
    $line =~ /^([^<\s>]+)($allc*)/o;
    ($token, $line) = ($1, $2);
    &Whine($., ($token eq '')? 'no-attribute-value':
               ($token !~ /^$tokenStr$/ || &StrLength($token) > 72)?
                 'quote-attribute-value':
               ($token !~ /^$stdTokenStr$/)?
                 'recommend-quote-attribute-value': 'bare-attribute-value',
                 $tag, $attr, $token)
  }
  $token;
}

##################################################
# コメント <!-- --> を読み飛ばす
# <!SGML...> 等の SGML宣言/DTD宣言も読み飛ばす
# <?...> 等の XML宣言も読み飛ばす

sub SkipComment
{
  my $leadingspace = $line =~ /^\s/o;
  while (&GetLine ne '') {
    if ($line =~ /^(<!(-{0,3}(\s*)!?)>)($allc*)/o) {
      &Whine($., ($2 eq '')? 'empty-comment': 'illegal-comment', $1);
      &Whine($., 'space-in-closed-comment') if $3 ne '';
      $line = $4;
      next;
    }
    if ($line =~ /^<(![A-Za-z]+|\?)($allc*)/o) {
      my $token = uc($1);
      if ($token ne '!DOCTYPE') {
        $line = $2;
        if ($token =~ /^\?/o) {
          &Whine($., 'xml');
        } else {
          &Whine($., 'ignore-declaration', '', $token);
#         &::PushStat('IgnoreDeclaration', $token) if $opt_stat;
        }
        while (&GetLine ne '') {
          if ($line =~ />($allc*)/o) {
            $line = $1;
            return &SkipComment;
          }
          $line = '';
        }
      }
    }
    last if $line =~ /^(?:[^<]|<[^!]|<![A-Za-z])/o;
    my $ln = $.;
    my ($whine_hyphens, $whine_markup);
    my ($markup, $hyphen, $closed);
    $line =~ /^(<!-{0,2})($allc*)/o;
    $line = $2;
    my $ill = $1 eq '<!';
    &Whine($., 'illegal-comment', $1) if $1 ne '<!--';
    while (&GetLine ne '') {
      unless ($line =~ /(<|--|-?>)($allc*)/o) {
        $line = '';
        next;
      }
      $line = $2;
      if ($1 eq '--') {
        if ($line =~ /^(!?)(\s*)>($allc*)/o) {
          $line = $3;
          &Whine($., 'space-in-closed-comment') if $2 ne '';
          &Whine($., 'illegal-closed-comment', '--!>') if $1 ne '';
          $closed = 1;
          $leadingspace++ if $line =~ /^\s/o;
          last;
        }
        $line = '--'.$1 if $line =~ /^-+($allc*)/o;
        &Whine($., 'w-hyphens-in-comment') if !$whine_hyphens && $. != $hyphen;
        $whine_hyphens = $hyphen = $.;
      } elsif ($1 eq '->') {
        &Whine($., 'illegal-closed-comment', $1);
        $closed = 1;
        last;
      } elsif ($ill && $1 =~ />$/o) {
        $closed = 1;
        last;
      } else {
        &Whine($., 'markup-in-comment') if !$whine_markup && $. != $markup;
        $whine_markup = $markup = $.;
      }
    }
    &Whine($., 'unclosed-comment', $ln) unless $closed;
  }
  $leadingspace;
}

##################################################
# <!DOCTYPE...>

sub Doctype
{
  my ($type, @whines, $tag, $lwspace, $doctypeline);
  my ($guide1, $guide2, $guide3, $guide4);
  if ($line eq '') {
    $line = <HTML>;
    $readsize += length($line);
  }
  my $firstline = $line;
  &SkipComment;
  if ($line =~ /^<(!DOCTYPE)($allc*)/oi) {
    $tag = uc($1);
    $line = $2;
    while (&GetLine ne '') {
      if ($line =~ /^([^<>]*)([<>])($allc*)/o) {
        $line = $2.$3;
        $doctypeline = &Join(' ', $doctypeline, $1);
        last;
      }
      chomp($line);
      $doctypeline = &Join(' ', $doctypeline, $line);
      $line = '';
    }
    foreach (keys %::doctypes) {
      my $doctype = ${$::doctypes{$_}}{doctype};
      if ($doctype ne '' && $doctypeline =~ /^\s*(?:$doctype)/i) {
        $type = $_;
        $guide1 = ${$::doctypes{$_}}{expired};
        last;
      }
    }
    unless ($type) {
      foreach (keys %::xdoctypes) {
        my $doctype = ${$::xdoctypes{$_}}{doctype};
        if ($doctype ne '' && $doctypeline =~ /^\s*(?:$doctype)/i) {
          $type = ${$::xdoctypes{$_}}{subst};
          $guide4 = ${$::xdoctypes{$_}}{guide};
          last;
        }
      }
      if ($type) {
        $guide1 = ${$::doctypes{$type}}{expired};
        $guide3 = ${$::doctypes{$type}}{abbr}.' とみなします。';
        push(@whines, 'unsupported-doctype');
      } else {
        unless ($opt_igndoctype) {
          foreach (keys %::xdoctypes) {
            my $doctype = ${$::xdoctypes{$_}}{guess};
            if ($doctype ne '' && $doctypeline =~ /(?:$doctype)/i) {
              $type = ${$::xdoctypes{$_}}{subst};
              last;
            }
          }
          unless ($type) {
            foreach (keys %::doctypes) {
              my $doctype = ${$::doctypes{$_}}{guess};
              if ($doctype ne '' && $doctypeline =~ /(?:$doctype)/i) {
                $type = $_;
                last;
              }
            }
          }
          if ($type) {
            $guide1 = ${$::doctypes{$type}}{expired};
            $guide3 = ${$::doctypes{$type}}{abbr}.' とみなします。';
          }
        }
        push(@whines, 'unknown-doctype');
        &::PushStat('UnknownDoctype', $doctypeline) if $opt_stat;
      }
    }
  } else {
    push(@whines, 'required-doctype');
    &UnGetToken;
  }
  if ($opt_x) {
    foreach (keys %::doctypes) {
      if ($opt_x =~ /^(?:${$::doctypes{$_}}{name})$/i) {
        $rule = $_;
        $guide3 = '';
        last;
      }
    }
    print '規則ファイル '.$opt_x.' は登録されていません。'."\n" unless $rule;
  }
  $rule = $type if !$opt_igndoctype && $type;
  my $mismatch = !@whines && $rule && $type ne $rule;
  if ($mismatch) {
    my $superset = ${$::doctypes{$rule}}{superset};
    foreach (split(/\|/o, $superset)) {
      my $doctype = ${$::doctypes{$_}}{doctype};
      if ($doctype ne '' && $doctypeline =~ /^\s*(?:$doctype)/i) {
        $mismatch = 0;
        last;
      }
    }
  }
  push(@whines, 'expired-doctype') if $guide1;
  $rule = $type    unless $rule;
  $rule = 'html20' unless $rule;
  # 各 DOCTYPE に対応した規則
  my $file = $rule.'.rul';
  if ($file ne $rulefile && !&ReadRule($file)) {
    print '指定された DOCTYPE に対応する規則ファイルが見つかりません。'."\n";
    $rule = ($rule eq $type)? '': $type;
    $rule = 'html20' unless $rule;
    $file = $rule.'.rul';
    $mismatch = 0;
    return 1 unless &ReadRule($file);
  }
  push(@whines, 'doctype-mismatch') if $mismatch;
  print STDERR "$htmlfile\n" if $opt_echoname;
  $guide2 = ${$::doctypes{$rule}}{guide};
  print $htmlfile.' を '.$guide2.' としてチェックします。'."\n" if $opt_banner;
  foreach (@whines) { &Whine($., $_, $guide1, $guide2, $guide3, $guide4); }
  &AdvanceCloseTag($tag, $.) if $tag ne '';
  # HTML4 では名前文字に _ と : が追加されている
  $htmlVer = ${$::doctypes{$rule}}{version};
  $nameChr    = ($htmlVer >= 4)? '[A-Za-z0-9\.\-_:]': $stdNameChr;
  $nameStr    = '[A-Za-z]'.$nameChr.'*';
  $tokenStr   = $nameChr.'+';
  $nutokenStr = '\d'.$nameChr.'*';
  %tokenizedType = (
    NAME     => $nameStr,
    NAMES    => $nameStr.'(\s+'.$nameStr.')*',
    NMTOKEN  => $tokenStr,
    NMTOKENS => $tokenStr.'(\s+'.$tokenStr.')*',
    NUTOKEN  => $nutokenStr,
    NUTOKENS => $nutokenStr.'(\s+'.$nutokenStr.')*',
    NUMBER   => $digits,
    NUMBERS  => $digits.'(\s+'.$digits.')*',
    ENTITY   => $nameStr,
    ENTITIES => $nameStr.'(\s+'.$nameStr.')*',
    ID       => $nameStr,
    IDREF    => $nameStr,
    IDREFS   => $nameStr.'(\s+'.$nameStr.')*',
  );
  if ($rule =~ /^jpo/) {
    &Whine($., 'jpo-no-html', '', ${$::doctypes{$rule}}{guide})
      unless $firstline =~ /^<\s*HTML\s*>/oi;
  }
  0;
}

##################################################
# 行を $line に読む。EOF なら空文字列が返る。

sub GetLine
{
  for (;;) {
    # 先行空白を捨てる
    $line =~ s/^(\s+)//o;
    $pretab += $1 =~ /\t/o;
    last if $line ne '';
    $line = <HTML>;
    $readsize += length($line);
    if ($line eq '' && eof) {
      unless ($reacheof) {
        $.++;
        $reacheof = 1;
      }
      last;
    }
    if (!defined($textcode)) {
      # 日本語のときのみ $textcode が設定される
      if (!defined($charset) || $jcharcode) {
        $textcode = ($jcharcode eq 'utf8')? 'utf8': &Jgetcode(\$line);
        if ($textcode !~ /^(?:jis|euc|sjis|utf8)$/) {
          undef $textcode;
        } elsif (defined(&::AskHTML)) {
          # 注意 : CGIからの呼び出しのとき
          $::TXTCODE = $textcode;
        }
      } else {
        $textcode = '';
      }
    }
    if (!$metaCharset && 'META' =~ /^(?:$emptyTags|$pairTags)$/ &&
        $line =~ /[^\x09\x0A\x0D\x20-\x7E]/o) {
      &Whine($., 'non-ascii-early') if $nonAsciiEarly++ == 0; # 一度にしないと悲惨
    }
    if (!$opt_igncharset) {
      if (($charset eq 'usascii' || $textcode eq 'jis') && $line =~ /[\x7F-\xFF]/o) {
        &Whine($., 'non-ascii');
      }
      if ($textcode eq 'jis' && $line =~ /\e\(I/o) {
        &Whine($., (${$::doctypes{$rule}}{restrict} & 2)?
                                'han-katakana-0': 'han-katakana');
      } elsif ($textcode eq 'sjis' && $line =~ /[\xA0-\xDF]/o) {
        my $esc = 0;
        foreach (unpack('C*', $line)) {
          $esc = 2 if $esc <= 0 && ((0x0081 <= $_ && $_ <= 0x009F) ||
                                    (0x00E0 <= $_ && $_ <= 0x00FC));
          if ($esc-- <= 0) {
            if (0x00A0 <= $_ && $_ <= 0x00DF) {
              &Whine($., (${$::doctypes{$rule}}{restrict} & 2)?
                                'han-katakana-0': 'han-katakana');
              last;
            }
          }
        }
      }
      my $deesc = $line;
      if ($textcode && $escapeseq{$textcode}) {
        $deesc =~ s/$escapeseq{$textcode}//og;
      }
      if ($deesc =~ /([\x00-\x08\x0B\x0C\x0E-\x1F])/) {
        &Whine($., 'ctrl-character', '', $1); # 代表一文字でよかろう
      }
    }
    &Jconvert(\$line, $myCODE, $textcode);
    if ($textcode =~ /^(?:jis|euc|sjis)$/ && $line =~ /[\x80-\xFF]/o) {
      my $bad = '';
      if ($myCODE eq 'euc') {
        # G3 は考慮しない
        my $c = 0;
        foreach (unpack('C*', $line)) {
          if ($c) {
            if (0x00A1 <= $_ && $_ <= 0x00FE && $c != 0x008E) {
              my $n = ($c<<8)|$_;
              if ($rule =~ /^jpo/ && $n == 0xA2A3) {
                &Whine($., 'jpo-bad-char', '', ${$::doctypes{$rule}}{guide}, '■');
              }
              unless (($n < 0xB0A1)?
                        ($n < 0xA4A1)?
                          ($n < 0xA3B0)?
                            ($n < 0xA2DC)?
                              ($n < 0xA2BA)? (0xA1A1 <= $n && $n <= 0xA2AE):
                              ($n < 0xA2CA)? ($n <= 0xA2C1):
                                             ($n <= 0xA2D0):
                              ($n < 0xA2F2)? ($n <= 0xA2EA):
                                             ($n <= 0xA2F9 || $n == 0xA2FE):
                            ($n < 0xA3C1)? ($n <= 0xA3B9): # 数字
                            ($n < 0xA3E1)? ($n <= 0xA3DA): # 英大文字
                                           ($n <= 0xA3FA): # 英小文字
                          ($n < 0xA6A1)?
                            ($n < 0xA5A1)? ($n <= 0xA4F3): # ひらがな
                                           ($n <= 0xA5F6): # カタカナ
                            ($n < 0xA7A1)?
                              ($n < 0xA6C1)? ($n <= 0xA6B8): # ギリシャ大文字
                                             ($n <= 0xA6D8): # ギリシャ小文字
                              ($n < 0xA8A1)?
                                ($n < 0xA7D1)? ($n <= 0xA7C1): # ロシア大文字
                                               ($n <= 0xA7F1): # ロシア小文字
                                               ($n <= 0xA8C0): # 罫線素片
                        ($n < 0xD0A1)? ($n <= 0xCFD3):   # 第一水準漢字
                                       ($n <= 0xF4A6)) { # 第二水準漢字
                $c = pack('CC', $c, $_);
                foreach (keys %{${$::doctypes{$rule}}{alloweuc}}) {
                  if ($n >= $_ && $n <= ${$::doctypes{$rule}}{alloweuc}{$_}) {
                    $c = '';
                    last;
                  }
                }
                if ($c ne '') {
                  $bad .= ($c = pack('CC', $c, $_));
                  &::PushStat('BadJISX0208', $c) if $opt_stat;
                }
              }
            }
            $c = 0;
          } elsif ((0x00A1 <= $_ && $_ <= 0x00FE) || $_ == 0x008E) {
            $c = $_;
          }
        }
      } elsif ($myCODE eq 'sjis') {
        my $c = 0;
        foreach (unpack('C*', $line)) {
          if ($c) {
            if ((0x0040 <= $_ && $_ <= 0x007E) ||
                (0x0080 <= $_ && $_ <= 0x00FC)) {
              my $n = ($c<<8)|$_;
              if ($rule =~ /^jpo/ && $n == 0x81A1) {
                &Whine($., 'jpo-bad-char', '', ${$::doctypes{$rule}}{guide}, '■');
              }
              unless (($n < 0x889F)?
                        ($n < 0x829F)?
                          ($n < 0x824F)?
                            ($n < 0x81DA)?
                              ($n < 0x81B8)? (0x8140 <= $n && $n <= 0x81AC):
                              ($n < 0x81C8)? ($n <= 0x81BF):
                                             ($n <= 0x81CE):
                              ($n < 0x81F0)? ($n <= 0x81E8):
                                             ($n <= 0x81F7 || $n == 0x81FC):
                            ($n < 0x8260)? ($n <= 0x8258): # 数字
                            ($n < 0x8281)? ($n <= 0x8279): # 英大文字
                                           ($n <= 0x829A): # 英小文字
                          ($n < 0x839F)?
                            ($n < 0x8340)? ($n <= 0x82F1): # ひらがな
                                           ($n <= 0x8396): # カタカナ
                            ($n < 0x8440)?
                              ($n < 0x83BF)? ($n <= 0x83B6): # ギリシャ大文字
                                             ($n <= 0x83D6): # ギリシャ小文字
                              ($n < 0x849F)?
                                ($n < 0x8470)? ($n <= 0x8460): # ロシア大文字
                                               ($n <= 0x8491): # ロシア小文字
                                               ($n <= 0x84BE): # 罫線素片
                        ($n < 0x989F)? ($n <= 0x9872):   # 第一水準漢字
                                       ($n <= 0xEAA4)) { # 第二水準漢字
                $c = pack('CC', $c, $_);
                foreach (keys %{${$::doctypes{$rule}}{allowsjis}}) {
                  if ($n >= $_ && $n <= ${$::doctypes{$rule}}{allowsjis}{$_}) {
                    $c = '';
                    last;
                  }
                }
                if ($c ne '') {
                  $bad .= ($c = pack('CC', $c, $_));
                  &::PushStat('BadJISX0208', $c) if $opt_stat;
                }
              }
              $c = 0;
            } else {
              $c = ((0x0081 <= $_ && $_ <= 0x009F) ||
                    (0x00E0 <= $_ && $_ <= 0x00FC))? $_: 0;
            }
          } elsif ((0x0081 <= $_ && $_ <= 0x009F) ||
                   (0x00E0 <= $_ && $_ <= 0x00FC)) {
            $c = $_;
          }
        }
      }
      &Whine($., 'bad-jis-x0208', '', $bad) if $bad ne '';
    }
  }
  $line;
}

##################################################
# 文字列を連結する
# join() では空文字列も連結してしまうがこれは空文字列は捨てる

sub Join
{
  my $sep = shift;
  my $str = '';
  foreach (@_) { $str = ($str ne '')? $str.$sep.$_: $_ if $_ ne ''; }
  $str;
}

##################################################
# 警告に付加するタグ列/属性値列のガイド文字列を作る

sub FormatGuide
{
  my ($s, $e, $aval, $format, $limit) = @_;
  my $msg = '';
  if ($aval ne '') {
    my @v = split(/\|/o, $aval);
    my $x = ($s ne '' && $e ne '')? '': ',';
    if ($limit && $limit <= $#v) {
      splice(@v, $limit);
      $msg = join(',', map { ($_ eq '#PCDATA')? '普通のテキスト': "$s$_$e" } @v);
      $msg =~ s/,($s[^$s$e$x]+$e)$/ や $1/;
      $msg .= ' など';
    } else {
      $msg = join(',', map { ($_ eq '#PCDATA')? '普通のテキスト': "$s$_$e" } @v);
      $msg =~ s/,($s[^$s$e$x]+$e)$/ または $1/;
    }
    $msg =~ s/,/、/og;
    $msg = sprintf($format, $msg) if $format ne '';
  }
  $msg;
}

sub FormatTagGuide
{
  &FormatGuide('<', '>', @_);
}

sub FormatAttrGuide
{
  &FormatGuide('`', '`', @_);
}

sub FormatOtherHTMLsGuide
{
# if ($#_ > 4) {
#   &FormatGuide('', '', '他のHTML');
# } else {
    my @htmls;
    my $last;
    foreach (sort {${$::doctypes{$a}}{order} <=> ${$::doctypes{$b}}{order}} @_) {
      my $html = (${$::doctypes{$rule}}{group} eq ${$::doctypes{$_}}{group})?
                  ${$::doctypes{$_}}{abbr}: ${$::doctypes{$_}}{group};
      push(@htmls, $last = $html) if $last ne $html;
    }
    ' '.&FormatGuide('', '', join('|', @htmls)).' ';
# }
}

##################################################
# 実体参照をチェックする
# & で始まる文字列を調べ、適当に警告を発して調べた次の文字列と
# デコードした実体参照をリストで返す

sub CheckRefEntities
{
  my ($line, $urichk) = @_;
  my $pcode;
  if ($line =~ /^&($nameStr|#\d+)($allc*)/ ||
      # HTML4 では 16進の文字参照が可能
      ($htmlVer >= 4 && $line =~ /^&(#x[0-9A-Fa-z]+)($allc*)/o)) {
    $line = $2;
    my $ref = $1;
    my $code;
    if ($ref =~ /^#(.*)/o) {
      $code = $1;
      $code = hex($1) if $code =~ /^x(.*)/oi;
      if ($line =~ /^;($allc*)/o) {
        $line = $1;
        $ref .= ';';
      } else {
        &Whine($., 'required-semicolon', '&'.$ref); # unless $urichk;
      }
#     unless ($urichk) {
        my $limit = ${$::doctypes{$rule}}{charref};
        if (defined($limit) && $code >= $limit) {
          $limit--;
          $limit = sprintf('x%lX', $limit) if $ref =~ /^#x/oi;
          &Whine($., 'over-ref-charset', '&'.$ref, '&#'.$limit.';');
        }
#     }
    } else {
      if ($code = $refEntities{$ref}) {
        if ($line =~ /^;($allc*)/o) {
          $line = $1;
          $ref .= ';';
        } else {
          &Whine($., 'required-semicolon', '&'.$ref); # unless $urichk;
        }
        $code =~ /^&#(.*)/o;
        $code = $1;
      } else {
        my $cand;
        foreach (keys %refEntities) {
          if (lc($ref) eq lc) {
            # 大文字小文字が違うだけのケース
            $cand = $_;
            last;
          } elsif ($ref =~ /^$_/i) {
            # 先頭一致するケース
            $cand = $_;
          }
        }
        if ($line =~ /^;($allc*)/o) {
          $line = $1;
          $ref .= ';';
        }
#       unless ($urichk) {
          &Whine($., 'bad-entity',
                     '&'.$ref, $cand? '&'.$cand.'; なら正しいのですが。': '');
#         &::PushStat('BadEntity', '&'.$ref) if $opt_stat;
#       }
      }
    }
    if ($code ne '') {
      $pcode = chr($code);
      if ($urichk && $pcode =~ /($RFC2396::spdelimunwise)/o) {
        &Whine($., 'excluded-url-ref', $tag, $attr, '&'.$ref, $1);
        &::PushStat('ExcludedURLRef', '&'.$ref) if $opt_stat;
      }
    }
  } else {
    $line = substr($line, 1);
    &WhineRefEntities($pcode = '&'); # unless $urichk;
  }
  ($line, $pcode);
}

##################################################
# 実体参照に関する警告を表示する

sub WhineRefEntities
{
  my $c = shift;
  &Whine($., 'literal-metacharacter', '&', '&amp;'), return if $c eq '&';
  &Whine($., 'literal-metacharacter', '<', '&lt;') , return if $c eq '<';
  &Whine($., 'literal-metacharacter', '>', '&gt;') , return if $c eq '>';
  if ($quot eq '') {
    &Whine($., 'double-quote-in-text',  '"', '&quot;'), return if $c eq '"';
  } elsif ($quot eq '"') {
    &Whine($., 'literal-metacharacter', '"', '&quot;'), return if $c eq '"';
  }
}

##################################################
# 書けないタグに関する警告を表示する

sub WhineExcludedElement
{
  unless ($xml) {
    my ($tag, $parent, $pln, $msg) = @_;
    my $inhead;
    if ($headElements && $tag =~ /^(?:$thisTagElements)$/) {
      $inhead = '<HEAD>～</HEAD> 内では、';
      $msg = '';
    }
    ($tag eq '#PCDATA')?
      &Whine($., 'unexpected-pcdata', '', $parent, $inhead):
      &Whine($., 'excluded-element', $tag, $parent, $pln, $msg, $inhead);
  }
}

##################################################
# 不正なタグに関する警告を表示する

sub WhineUnknownElement
{
  my $tag = shift;
  my $id = ($tag =~ m#^/(.*)#o)? $1: $tag;
  if (!$xml) {
    if ($tag !~ /^(?:[^:]+):/o) { # IE5 の XMLNS:namespace 対応
      my @htmls = grep($id =~ /^(?:$pairTags{$_})$/, keys %pairTags);
      if ($id eq $tag) {
        push(@htmls, grep($id =~ /^(?:$emptyTags{$_})$/, keys %emptyTags));
      }
      if (@htmls) {
        &Whine($., 'other-html-element', $tag, &FormatOtherHTMLsGuide(@htmls));
        return 1;
      }
    }
    if ($tag ne $id && $id !~ /^(?:$pairTags)$/ && $id =~ /^(?:$emptyTags)$/) {
      &Whine($., 'illegal-closing', $tag, $id);
      &::PushStat('IllegalClosing', $id) if $opt_stat && !$xml;
    } else {
      &Whine($., 'unknown-element', $tag);
      &::PushStat('UnknownElement', $tag) if $opt_stat && !$xml;
    }
  }
  0;
}

##################################################
# 不正な属性に関する警告を表示する

sub WhineUnknownAttribute
{
  my ($tag, $attr) = @_;
  if ($xml) {
    return if $tag !~ /^(?:$emptyTags|$pairTags)$/;
  }
  my @htmls = grep { $attr =~ /^(?:$attributes{$_}->{$tag})$/ } keys %attributes;
  if (@htmls) {
    &Whine($., 'other-html-attribute', $tag, $attr, &FormatOtherHTMLsGuide(@htmls))
      if $unknownTag != 2;
  } else {
    &Whine($., 'unknown-attribute', $tag, $attr);
    &::PushStat('UnknownAttribute', $tag.' '.$attr) if $opt_stat;
  }
}

##################################################
# 終了タグの省略に関する警告を表示する
# 第3引数は &OmitEndTag の結果で != 0

sub WhineOmitEndTag
{
  my ($tag, $end, $omit) = @_;
  my $whine = 0;
  if ($tag eq $lastTag && $tag !~ /^(?:$maybeEmpty)$/) {
    # 要素が空なら警告を出す
    $whine = 1;
  } elsif ($omit == 1) {
    # 順序タグのとき
    my $last = &ExpandInternalElements($onceonlyTags{$tagsNest[$#tagsNest-1][0]});
    $whine = 1 if $#tagsNest == 0 || ($tag =~ /^(?:$last)$/ &&
                                      $tag !~ /^(?:$omitStartTags)$/);
  } elsif ($tag ne $end) { # <P>～<P> のようなときは省略が自明とみなす
    if ($tag =~ /^(?:HTML|HEAD|BODY)$/) {
      $whine = 1;
    } elsif ($omit == 2) {
      # 要素に $tag が含まれていて
      # #PCDATA が含まれていないときは、普通は省略される終了タグだとみなす
      my $last = &ExpandInternalElements($tagsElements{$tagsNest[$#tagsNest-1][0]});
      $whine = 1 unless $tag =~ /^(?:$last)$/ && '#PCDATA' !~ /^(?:$last)$/;
    }
  }
  &Whine($., $whine? ($tag !~ /^($omitEndTags)$/)?
             'required-end-tag': 'omit-end-tag': 'omit-end-tag-trivial',
             $tag, $end? "<$end>".' の前に': 'ここに');
  &::PushStat('OmitEndTag', $tag) if $opt_stat && $whine;
}

##################################################
# 警告メッセージを表示する

sub Whine
{
  unless (defined(%messages)) { # デバグ用
    print @_, "\n";
    return;
  }
  my ($ln, $id, @argv) = @_;
  if ($analizing && $argv[0] eq 'INPUT' && $seenAttrs{'TYPE'} ne '') {
    $argv[0] = qq|INPUT TYPE="\U$seenAttrs{'TYPE'}"|;
  }
  my $oid = $id;
  my $msg = ${$messages{$id}}[0];
  my $pnt = $enabled{$id};
  unless ($msg) {
    $oid = $alias_messages{$id};
    $msg = ${$messages{$oid}}[0];
    $pnt = -$pnt if $enabled{$oid} < 0.0;
  }
  if ($msg) {
    $::whinesStat{$id}++;
    return if (!$opt_religious     && $religious{$oid}) ||
              (!$opt_accessibility && $accessibility{$oid});
    if ($pnt >= 0.1) {
      $uniquewhine{$id}? ($upenalty += $pnt): ($penalty += $pnt);
      $pwhinescnt++;
    } elsif ($pnt < -0.01 && $opt_pedantic) {
      $uniquewhine{$id}? ($upenalty -= $pnt): ($penalty -= $pnt);
      $pwhinescnt++;
    }
    return unless $pnt > 0.0 || $opt_pedantic;
  } else {
    $pnt = 1; # 加算量は適当
    $penalty += $pnt;
    $msg = '不明なメッセージ要求 : '.$id;
  }
  if ($opt_warnings) {
    my $file = $htmlfile;
#   $file =~ s#/#\\#og if $WIN;
    $file =~ s/\\/\\\\/og;
    $file =~ s/\$/\\\$/og;
    $file =~ s/\@/\\\@/og;
    $file =~ s/\%/\\\%/og;
    if ($opt_w eq 'long') {
      $msg = "$ln: $id: $msg";
    } elsif ($opt_w eq 'short') {
      $msg = "$ln: $msg";
    } elsif ($opt_w eq 'verbose') {
      $msg = "$file: $ln: $oid: $msg";
    } elsif ($opt_w eq 'terse') {
      $msg = "$file:$ln:$oid";
    } else { # 'lint'
      $msg = "$file($ln): $msg";
    }
    if ($pnt < 0.1) {
      return if $::whinesStat{$id} > $opt_omit;
      if ($::whinesStat{$id} == $opt_omit) {
        my $addmsg = 'これ以降この警告は表示しません。';
        $addmsg =~ s/\\/\\\\/og;
        $msg .= $addmsg;
      }
    }
    $msg = eval qq|"$msg"|;
    unless (defined(&::AskHTML)) {
      # CGIからの呼び出しのときはエスケープ処理はCGI側で行なう
      $msg =~ s/([\x00-\x08\x0B\x0C\x0E-\x1F])/'^'.chr(ord($1)+0x40)/eog;
    }
    print "$msg\n";
  }
  $whinescnt++;
}

##################################################
# 警告の有効無効を設定する

sub EnableWarning
{
   my ($id, $en) = @_;
   $id = $shortid{$id} if $shortid{$id};
   if (${$messages{$id}}[0]) {
     my $n = $enabled{$id};
     $n = -$n if $n < 0.0;
     $enabled{$id} = $en? $n: -$n if $n < 100;
     return 1;
   }
   print "$configfile: $.: " if $configfile ne '';
   print "Unknown warning id `$id`.\n";
   0;
}

##################################################
# タグセットを読み込む
# &ReadRule よりも一部を読む方が速い

sub ReadTagsSet
{
  local $/ = ';';
  local *RULE;
  foreach $file (keys %::doctypes) {
    if (open(RULE, $ruledir.$file.'.rul')) {
      my ($line, $appear);
      while ($line = <RULE>) {
        if ($line =~ /\$emptyTags/o) {
          eval $line;
          $emptyTags{$file} = $emptyTags;
          $appear |= 1;
        } elsif ($line =~ /\$pairTags/o) {
          eval $line;
          $pairTags{$file} = $pairTags;
          $appear |= 2;
        } elsif ($line =~ /\%tagsAttributes/o) {
          local %tagsAttributes;
          eval $line;
          foreach (keys %tagsAttributes) {
            $attributes{$file}->{$_} = &Join('|', keys %{$tagsAttributes{$_}});
          }
          $appear |= 4;
        }
        last if $appear == 7;
      }
      close(RULE);
    }
  }
}

##################################################
# 規則ファイルを読み込む
# require ではだめ

sub ReadRule
{
  my $file = shift;
  $file = $ruledir.$file;
  return 0 unless -f $file;
  do $file;
  $rulefile = $file;
  1;
}

##################################################
# 設定ファイルを読み込む

sub ReadConfigFile
{
  my $configfile = '';
  if ($opt_f) {
    $configfile = $opt_f;
  } elsif ($ENV{'HTMLLINTRC'} && -f $ENV{'HTMLLINTRC'}) {
    $configfile = $ENV{'HTMLLINTRC'};
  } elsif ($::HTMLLINTRC ne '') {
    if ($::HTMLLINTRC !~ /^\./o) {
      $configfile = $PROGDIR.$::HTMLLINTRC if -e $PROGDIR.$::HTMLLINTRC;
    } elsif ($UNIX) {
      my $user = eval 'getlogin() || (getpwuid($<))[0]' || $ENV{'USER'};
      my $home = eval '(getpwnam($user))[7]' || $ENV{'HOME'} || '/';
      $home .= '/' unless $home =~ m#/$#;
      $configfile = $home.$::HTMLLINTRC if -e $home.$::HTMLLINTRC;
    }
  }
  if ($configfile ne '') {
    local *CONFIG;
    local ($cnf_style, $cnf_html, $cnf_limit, $cnf_omit,
           $cnf_banner, $cnf_score, $cnf_local, $cnf_pedantic, $cnf_religious,
           $cnf_echoname, $cnf_accessibility, $cnf_warnings, $cnf_prune,
           $cnf_igndoctype, $cnf_igncharset);
    my ($keyword, $arglist);
    open(CONFIG, "<$configfile") || die "Can't open config file `$configfile`.\n";
    while (<CONFIG>) {
      chomp;
      s/#.*$//o;
      next if /^\s*$/o;
      if (/^\s*(\S+)(?:\s+(.+))?$/oi) {
        local @ARGV = ("-$1");
        push(@ARGV, $2) if $2 ne '';
        &GetOptions('disable=s'         => \&cnf_ed,
                    'enable=s'          => \&cnf_ed,
                    'style=s'           => \$cnf_style,
                    'html=s'            => \$cnf_html,
                    'limit=i'           => \$cnf_limit,
                    'omit=i'            => \$cnf_omit,
                    'pedantic'          => \$cnf_pedantic,
                    'nopedantic:i'      => \$cnf_pedantic,
                    'banner'            => \$cnf_banner,
                    'nobanner:i'        => \$cnf_banner,
                    'echoname'          => \$cnf_echoname,
                    'noechoname:i'      => \$cnf_echoname,
                    'score'             => \$cnf_score,
                    'noscore:i'         => \$cnf_score,
                    'local'             => \$cnf_local,
                    'nolocal:i'         => \$cnf_local,
                    'religious'         => \$cnf_religious,
                    'noreligious:i'     => \$cnf_religious,
                    'accessibility'     => \$cnf_accessibility,
                    'noaccessibility:i' => \$cnf_accessibility,
                    'warnings'          => \$cnf_warnings,
                    'nowarnings:i'      => \$cnf_warnings,
                    'prune'             => \$cnf_prune,
                    'noprune:i'         => \$cnf_prune,
                    'igndoctype'        => \$cnf_igndoctype,
                    'usedoctype:i'      => \$cnf_igndoctype,
                    'igncharset'        => \$cnf_igncharset,
                    'usecharset:i'      => \$cnf_igncharset);
      } else {
        print "$configfile: $.: Illegal line.\n";
      }
    }
    close(CONFIG);
    $opt_w             = $cnf_style         if !defined($opt_w);
    $opt_x             = $cnf_html          if !defined($opt_x);
    $opt_limit         = $cnf_limit         if !defined($opt_limit);
    $opt_omit          = $cnf_omit          if !defined($opt_omit);
    $opt_pedantic      = $cnf_pedantic      if !defined($opt_pedantic);
    $opt_banner        = $cnf_banner        if !defined($opt_banner);
    $opt_echoname      = $cnf_echoname      if !defined($opt_echoname);
    $opt_score         = $cnf_score         if !defined($opt_score);
    $opt_local         = $cnf_local         if !defined($opt_local);
    $opt_religious     = $cnf_religious     if !defined($opt_religious);
    $opt_accessibility = $cnf_accessibility if !defined($opt_accessibility);
    $opt_warnings      = $cnf_warnings      if !defined($opt_warnings);
    $opt_prune         = $cnf_prune         if !defined($opt_prune);
    $opt_igndoctype    = $cnf_igndoctype    if !defined($opt_igndoctype);
    $opt_igncharset    = $cnf_igncharset    if !defined($opt_igncharset);
  }
}

  sub cnf_ed
  {
    my ($ed, $ids) = @_;
    while ($ids =~ /^\s*(\S+)(.*)/o) {
      $ids = $2;
      my $id = $shortid{$1}? $shortid{$1}: $1;
      $cnf_e{$id} = $ed =~ /^e/oi;
    }
  }

##################################################
# 起動時オプションを読み込む

  sub opt_ed
  {
    my ($ed, $ids) = @_;
    foreach (split(/,/o, $ids)) {
      my $id = $shortid{$_}? $shortid{$_}: $_;
      $opt_e{$id} = $ed =~ /^e/oi;
    }
  }

sub ReadOptions
{
  local (%cnf_e, %opt_e, $opt_r, $opt_listwarnings, $opt_version, $opt_help);
  &ReadWarnings();
  $stdio = "\tstdio\t";
  grep(s/^-$/$stdio/, @ARGV); # ファイル名 '-' (stdin/out) を GetOptions の評価から守る
  # オプションの増減に伴なって HTMLlint() にある local $opt_xxx の調整もすること
  &GetOptions('d=s'               => \&opt_ed,
              'e=s'               => \&opt_ed,
              'w=s'               => \$opt_w,
              'f=s'               => \$opt_f,
              'x=s'               => \$opt_x,
              'r=s'               => \$opt_r,
              'stat=s'            => \$opt_stat,    # CGI用
              'lang=s'            => \$opt_lang,    # CGI用
              'charset=s'         => \$opt_charset, # CGI用
              'base=s'            => \$opt_base,    # CGI用
              'limit=i'           => \$opt_limit,
              'omit=i'            => \$opt_omit,
              'help|u'            => \$opt_help,
              'version|v'         => \$opt_version,
              'listwarnings'      => \$opt_listwarnings,
              'pedantic',         => \$opt_pedantic,
              'nopedantic:i'      => \$opt_pedantic,
              'banner',           => \$opt_banner,
              'nobanner:i'        => \$opt_banner,
              'echoname'          => \$opt_echoname,
              'noechoname:i'      => \$opt_echoname,
              'score'             => \$opt_score,
              'noscore:i'         => \$opt_score,
              'local'             => \$opt_local,
              'nolocal:i'         => \$opt_local,
              'religious'         => \$opt_religious,
              'noreligious:i'     => \$opt_religious,
              'accessibility'     => \$opt_accessibility,
              'noaccessibility:i' => \$opt_accessibility,
              'warnings'          => \$opt_warnings,
              'nowarnings:i'      => \$opt_warnings,
              'prune'             => \$opt_prune,
              'noprune:i'         => \$opt_prune,
              'igndoctype'        => \$opt_igndoctype,
              'usedoctype:i'      => \$opt_igndoctype,
              'igncharset'        => \$opt_igncharset,
              'usecharset:i'      => \$opt_igncharset,
#             'j=s'               => \$opt_j,       # 未使用
#             'cr',               => \$opt_cr,      # 未使用
              'dbg'               => \$opt_dbg)
            || die '使い方は -U オプションを指定すると表示されます。'."\n";
  &ReadConfigFile();
  $opt_charset = '' if $opt_igncharset;
  $opt_limit = 999       if !defined($opt_limit); # 打ち切り限界警告数
  $opt_omit  = 20        if !defined($opt_omit);  # 無減点同一警告の省略
  $opt_banner = 1        if !defined($opt_banner);
  $opt_score = 1         if !defined($opt_score);
  $opt_local = 1         if !defined($opt_local);
  $opt_warnings = 1      if !defined($opt_warnings);
  $opt_religious = 1     if !defined($opt_religious);
  $opt_accessibility = 1 if !defined($opt_accessibility);
  $opt_igndoctype = 1    if !defined($opt_igndoctype) && defined($opt_x);
  $opt_stat = ''         if !defined(&::TakeStatistics);
  foreach (keys %cnf_e) { &EnableWarning($_, $cnf_e{$_}); }
  foreach (keys %opt_e) { &EnableWarning($_, $opt_e{$_}); }
  if ($opt_listwarnings) {
    &ListWarnings();
    return 1;
  }
  if ($opt_v || $opt_version) {
    print $version;
    return 1;
  }
  if ($opt_u || $opt_help || !@ARGV) {
    print $version, $usage;
    return 1;
  }
  $opt_w =~ tr/A-Z/a-z/;
  $ruledir = $::RULEDIR;
  if ($opt_r) {
    $ruledir = $opt_r;
    $ruledir .= $SEP unless $ruledir =~ m#$SEP$#o;
  }
  $ruledir = $PROGDIR.$ruledir if $ruledir eq '' || $ruledir =~ /^\./o;
  0;
}

##################################################
# 全警告を表示する

sub ListWarnings(;\@)
{
  &ReadWarnings unless defined(%messages);
  my $aref = shift;
  my %msgshort, $id;
  foreach $id (keys %shortid) { $msgshort{$shortid{$id}} = $id; }
  foreach $id (sort keys %messages) {
    my $msg = ${$messages{$id}}[0];
    $msg =~ s#<\$argv\[\d+\]>#<TAG>#og;
    $msg =~ s#</\$argv\[\d+\]>#</TAG>#og;
    $msg =~ s#\$argv\[\d+\] 属性#ATTR 属性#og;
    $msg =~ s#\$argv\[\d+\] の属性値#ATTR の属性値#og;
    $msg =~ s#\$argv\[\d+\]行目#NN行目#og;
    $msg =~ s#\$argv\[\d+\]#XXXX#og;
    $msg =~ s#\\"#"#og;
    $msg =~ s#\\\\#\\#og;
    my $n = $enabled{$id};
    $n = -$n if $n < 0.0;
    $n = 0   if $n < 0.1;
    my $str = $id.' '.($msgshort{$id}? $msgshort{$id}: '-').
                  ' '.(($enabled{$id} > 0.0)? 'ENABLED': 'DISABLED').
                  ' '.$n;
    foreach (keys %alias_messages) {
      if ($alias_messages{$_} eq $id) {
        $n = $enabled{$_};
        $n = 0 if $n < 0.1;
        $str .= " $_ $n";
      }
    }
    if (defined($aref)) {
      push(@$aref, $str);
    } else {
      print "$str\n$msg\n";
    }
  }
}

##################################################
# 組み込み警告メッセージと既定値を読み込む

sub ReadWarnings
{
# return if defined(%messages);
  my (@elem, $rel, $acc, $id, $default, $msg, $alias, $n, $nalias);
  my $i = 0;
  while (<DATA>) {
    chomp;
    s/^\s*//o;
    s/\s*$//o;
    next if !$_ || /^#/o;
    push(@elem, $_);
    next unless @elem == 3;
    ($id, $default, $msg) = @elem;
    $id = $1 if $rel = $id =~ /^\*(.*)/;
    $id = $1 if $acc = $id =~ /^\@(.*)/;
    ($id, $alias) = split(' ', $id);
    if ($id =~ /^([^:]+):(.*)/) {
      $id = $1;
      die "Already used short name '$2'.\n" if $shortid{$2};
      $shortid{$2} = $id;
    }
    ($default, $n, $nalias) = split(' ', $default);
    $religious{$id} = 1 if $rel;
    $accessibility{$id} = 1 if $acc;
    if ($n =~ /^\*(.*)/o) {
      $n = $1;
      $uniquewhine{$id}++;
    }
    $enabled{$id} = ($default =~ /^(?:E|ON|1)/oi)? $n: -$n;
    $msg =~ s/\\/\\\\/og;
    $msg =~ s/"/\\"/og;
    ${$messages{$id}}[0] and die "Already used message id '$id'.\n";
    ${$messages{$id}}[0] = $msg;
    ${$messages{$id}}[1] = $i++;
    if ($alias) {
      $alias_messages{$alias} = $id;
      $enabled{$alias} = $nalias? $nalias: $n;
    }
    undef @elem;
  }
}

1;

__DATA__

# 点数は 0 より大きいこと。0.1未満の点数は加算されない。100以上は DISABLE にできない。
# 警告には、同一メッセージで点数の異なる別名を(今のところひとつ)指定できる。
# 名前と点数を空白で区切って並べればよい。
# 名前の頭の * は宗教的なもの、@ は必須でないアクセス性に関するものを示す。
# 点数頭の * は、その点数がそのまま減点される (0.1以上のとき)。
# そうでない場合は、だいたい 1/タグ数 されて減点される。

# 警告の増減に対して以下の調整を行なう
#     htmllint.html のチェックを調整する
#     explain.html の解説を調整する
#     htmllintrc を調整する
#     stat-whines.dat を調整する (optional)

over-limit-whines
  ENABLE 100
  エラーの数が $argv[0]個を超えたのでチェックを打ち切ります。
cant-get-url:u
  DISABLE 5
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` はインタネット上に存在しないかアクセスできません。$argv[3]
required-doctype:qd
  ENABLE *0.01
  最初の記述が DOCTYPE宣言ではありません。
unknown-doctype:ud
  ENABLE *5
  不明な DOCTYPE宣言です。$argv[2]
unsupported-doctype:usd
  ENABLE *1
  $argv[3] は Another HTML-lint ではサポートされていない DOCTYPE宣言です。$argv[2]
expired-doctype:xd
  ENABLE *10
  $argv[0] はすでに廃棄されたHTMLです。使わないようにしましょう。
doctype-mismatch:dm
  ENABLE *0.01
  指定されている $argv[1] は DOCTYPE宣言と一致しません。DOCTYPE宣言を無視します。
misplaced-doctype:md
  ENABLE *7
  DOCTYPE宣言はファイルの先頭でなければなりません。
ignore-declaration:id
  ENABLE 1
  SGML宣言や DTD宣言などと思われる `<!$argv[1] ～>` は無視します。
xml
  ENABLE 0.01
  XML処理命令 `<?～>` は理解できません。
w-hyphens-in-comment:hy
  ENABLE 2
  コメント中に `--` は書かない方が安全です。
*empty-comment:ecm
  ENABLE 1
  空のコメント `<!>` は書かない方が安全です。
illegal-comment:icm
  ENABLE 8
  このコメントのような記述 `$argv[0]` は正しくありません。
*markup-in-comment:mk
  ENABLE 0.01
  コメント中に `<` や `>` を書くと、いくつかのブラウザを混乱させることがあります。
*space-in-closed-comment:sc
  ENABLE 2
  閉じコメントの `--` と `>` の間には空白を入れないようにしましょう。
illegal-closed-comment:icc
  ENABLE 8
  閉じコメントは `$argv[0]` ではなく `-->` です。
unclosed-comment:ucc
  ENABLE *9
  $argv[0]行目のコメントが閉じられていません。
unclosed-tag:ut
  ENABLE *9
  $argv[1]行目の <$argv[0]> が閉じられていません。
leading-whitespace:lw
  ENABLE 9
  `<` と `$argv[0]` の間には空白を入れてはいけません。
unexpected-open:uo
  ENABLE 9
  予期せぬ `<` が <$argv[0]> 内にあります。閉じられていないタグの可能性があります。
excluded-element:xe
  ENABLE 7
  $argv[4]<$argv[0]> を $argv[2]行目の <$argv[1]>～</$argv[1]> 内に書くことはできません。$argv[3]
deprecated-element:de
  DISABLE 0.01
  $argv[1]を $argv[3]行目の <$argv[2]>～</$argv[2]> 内に書くことはあまり薦められません。
#misplaced-element:me
#  ENABLE 8
#  <$argv[0]> を <$argv[1]>～</$argv[1]> の外に書くことはできません。
once-only:oo
  ENABLE 8
  <$argv[0]> は <$argv[1]>～</$argv[1]> 内に1度しか書けません。$argv[2]行目にもありました。
once-only-group:oog
  ENABLE 8
  <$argv[0]> は $argv[2]行目の <$argv[3]> と同時に <$argv[1]>～</$argv[1]> 内に書くことはできません。
must-follow:mf
  ENABLE 8
  <$argv[0]> は $argv[1] の直後に続かなければなりません。
must-follow-slight:mfs
  ENABLE 1
  <$argv[0]> は $argv[1] の直後に続かなければなりません。
required:q
  ENABLE 9
  <$argv[0]>～</$argv[0]> 内には $argv[1]が必要です。
*empty-container:ec
  ENABLE 1
  <$argv[0]> と </$argv[0]> の間が空です。
unknown-element:ue
  ENABLE 8
  <$argv[0]> は不明なタグです。
other-html-element:he
  ENABLE 0.7
  <$argv[0]> は$argv[1]用のタグです。
deprecated-tag:dt deprecated-tag-0
  ENABLE 1        0.01
  <$argv[0]> はあまり薦められないタグです。$argv[1]
deprecated-tag-css:dtc
  ENABLE 0.01
  <$argv[0]> はあまり薦められないタグです。スタイルシートを使いましょう。
unsupported-tag:ust
  ENABLE 0.01
  <$argv[0]> は Another HTML-lint では正確な評価はできません。
should-not-use:snu
  ENABLE 1
  <$argv[0]> は使うべきでありません。
required-start-tag:qst
  ENABLE 9
  ここには <$argv[0]> が必要です。
omit-start-tag:os
  ENABLE 4
  ここに <$argv[0]> が省略されているようです。省略しないようにしましょう。
omit-start-tag-trivial:ost
  DISABLE 0.01
  ここに <$argv[0]> が省略されているようです。
required-end-tag:qet
  ENABLE 9
  ここには </$argv[0]> が必要です。
omit-end-tag:oe
  ENABLE 0.2
  $argv[1] </$argv[0]> が省略されているとみなします。
omit-end-tag-trivial:oet
  DISABLE 0.01
  $argv[1] </$argv[0]> が省略されているとみなします。
closing-attribute:ca
  ENABLE 9
  終了タグ </$argv[1]> には属性を指定することはできません。
illegal-closing:ic
  ENABLE 7
  <$argv[1]> には終了タグ </$argv[1]> はありません。
*container-whitespace:cw
  ENABLE 0.01
  <$argv[0]>～</$argv[0]> 内の$argv[1]に空白文字があります。
mis-match:m
  ENABLE 6
  </$argv[1]> に対応する開始タグ <$argv[1]> が見つかりません。
element-overlap:eo
  ENABLE 7
  </$argv[1]> は $argv[2]行目の <$argv[3]> と重なり合っているようです。
tags-nest:tn
  ENABLE 9
  <$argv[0]> タグの入れ子が深過ぎます。
unclosed-element:uce
  ENABLE 7
  $argv[1]行目の <$argv[0]> に対応する終了タグ </$argv[0]> が見つかりません。
unexpected-pcdata:xp
  ENABLE 5
  $argv[2]<$argv[1]>～</$argv[1]> 内に普通のテキストを書くことはできません。
illegal-attribute:ia
  ENABLE 8
  <$argv[0]> におかしな文字列 `$argv[1]` があります。
*mixed-case:mx
  DISABLE 0.01
  $argv[0]の大文字小文字を統一するようにしましょう。
unknown-attribute:ua
  ENABLE 6
  <$argv[0]> に不明な属性 `$argv[1]` が指定されています。
other-html-attribute:oa
  ENABLE 0.5
  <$argv[0]> に$argv[2]用の属性 `$argv[1]` が指定されています。
deprecated-attribute:da deprecated-attribute-0
  ENABLE 1              0.01
  <$argv[0]> の属性 `$argv[1]` はあまり薦められない属性です。
deprecated-attribute-css:dac
  ENABLE 0.01
  <$argv[0]> の属性 `$argv[1]` はあまり薦められない属性です。スタイルシートを使いましょう。
unsupported-attribute:usa
  ENABLE 0.01
  <$argv[0]> の属性 `$argv[1]` は Another HTML-lint では正確な評価はできません。
leading-space-attribute:la
  ENABLE 1
  <$argv[0]> の $argv[1] 属性の前には空白を入れましょう。
repeated-attribute:ra
  ENABLE 7
  <$argv[0]> で $argv[1] 属性の指定が繰り返されています。
required-attribute:qa
  ENABLE 6
  <$argv[0]> には $argv[1] 属性が必要です。
required-value:qv
  ENABLE 5
  <$argv[0]> の $argv[1] 属性には属性値が必要です。
no-attribute-value:nv
  ENABLE 7
  <$argv[0]> の $argv[1] の属性値が指定されていません。
*across-lines-attribute:xl
  ENABLE 0.01
  <$argv[0]> の $argv[1] の属性値が複数行に渡っています。
*space-around-equal:sq
  DISABLE 0.01
  <$argv[0]> の $argv[1] の属性値区切りの = 前後に空白が含まれています。
unclosed-quotes:uq
  ENABLE 9
  <$argv[0]> の $argv[1] の属性値の引用符が閉じられていません。
*attribute-delimiter:ad
  DISABLE 0.01
  <$argv[0]> の $argv[1] の属性値が '$argv[2]' と書かれていますが、"$argv[3]" の方が安全です。
quote-attribute-value:qu
  ENABLE 4
  <$argv[0]> の $argv[1] の属性値 `$argv[2]` は引用符で囲まなければなりません。
recommend-quote-attribute-value:rq
  ENABLE 1
  <$argv[0]> の $argv[1] の属性値 `$argv[2]` は引用符で囲んだ方が安全です。
*bare-attribute-value:bv
  DISABLE 0.01
  <$argv[0]> の $argv[1] の属性値 `$argv[2]` が引用符で囲まれていません。
*whitespace-attribute-value:wv
  ENABLE 1
  <$argv[0]> の $argv[1] の属性値 `$argv[2]` は空白文字が先行または後行しています。
deprecated-value:dv deprecated-value-0
  ENABLE 1          0.01
  <$argv[0]> の $argv[1] の属性値 `$argv[2]` はあまり薦められない値です。
empty-value:ev
  ENABLE 5
  <$argv[0]> の $argv[1] の属性値に空の値を指定することはできません。
attribute-length:al
  ENABLE 6
  <$argv[0]> の $argv[1] の属性値が $argv[2]文字を超えています。
attribute-format:af
  ENABLE 6
  <$argv[0]> の $argv[1] の属性値 `$argv[2]` は正しくありません。$argv[3]
minimized-attribute:ma
  ENABLE 2
  <$argv[0]> の $argv[1] は属性名と属性値が同一です。属性名を省略して属性値だけの指定にしましょう。
omit-attribute-name:on
  ENABLE 3
  <$argv[0]> の `$argv[2]` は属性名 $argv[1] が省略されていますが、うまく評価されないかも知れません。
required-semicolon:qs
  ENABLE 1
  実体参照 `$argv[0]` の後ろには `;` を書きましょう。
bad-entity:be
  ENABLE 3
  `$argv[0]` は不明な実体参照です。$argv[1]
over-ref-charset:orc
  ENABLE 2
  文字参照 `$argv[0]` は限界を超えた文字コードです。参照できるのは `$argv[1]` までです。
literal-metacharacter:lm
  ENABLE 5
  メタ文字 `$argv[0]` は `$argv[1]` と書かなければなりません。
*double-quote-in-text:dq
  DISABLE 0.01
  テキスト中の `$argv[0]` は `$argv[1]` と書きましょう。
@html-lang:hl
  ENABLE 1
  <$argv[0]> には LANG 属性を指定するようにしましょう。
lang-attribute:laa
  ENABLE 3
  $argv[3]指定されている LANG 属性は `$argv[2]` ですが、<$argv[0]> の $argv[1] の属性値が日本語のようです。
lang-pcdata:lap
  ENABLE 3
  $argv[3]指定されている LANG 属性は `$argv[2]` ですが、テキストが日本語のようです。
*mailto-link:ml
  ENABLE *0.01
  <HEAD>～</HEAD> 内に <LINK REV="MADE" HREF="mailto:～"> が含まれていません。
@navigation-link:nl
  ENABLE *0.01
  <HEAD>～</HEAD> 内に <LINK REL="NEXT" HREF="～"> などのナヴィゲーション用のリンクが含まれていません。
mistype-links:mtl
  ENABLE 0.1
  <$argv[0]> の $argv[1] の属性値 `$argv[2]` は `$argv[3]` の誤りだと思われます。
#robots-upper:rou
#  ENABLE 0.1
#  <META NAME="$argv[1]"> は大文字で `ROBOTS` でなければなりません。
robots-content:roc
  ENABLE 0.01
  <META NAME="ROBOTS"> に指定されている CONTENT 属性の値 `$argv[1]` は正しくありません。
content-type:ct
  ENABLE *4
  <HEAD>～</HEAD> 内に <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="～"> が含まれていません。
no-registered-charset:rc no-registered-charset-ex
  ENABLE 1               0.01
  $argv[1]指定されている CHARSET `$argv[2]` は IANA に登録されていません。$argv[3]
no-charset:nc
  ENABLE 3
  <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="～"> に CHARSET を指定するようにしましょう。
non-ascii-early:nae
  ENABLE *39
  <META HTTP-EQUIV="CONTENT-TYPE" CONTENT="～"> で CHARSET が指定されるより前に非ASCII文字が含まれています。
non-ascii:na
  ENABLE 0.9
  非ASCII文字が含まれています。
ctrl-character:ctl
  ENABLE 0.8
  制御文字 `$argv[1]` が含まれています。
han-katakana:hk han-katakana-0
  ENABLE 0.7    0.01
  半角カタカナが含まれています。
bad-jis-x0208:jx
  ENABLE 1
  機種依存全角文字 `$argv[1]` が含まれています。
charset-mismatch:cm
  ENABLE *66
  $argv[2]指定されている CHARSET は `$argv[0]` ですが、実際のコードは $argv[1] です。
conflict-charset:cc
  ENABLE *11
  HTTPレスポンスヘッダに指定されている CHARSET は `$argv[1]` ですが、<META> に指定されているのは `$argv[2]` です。
no-text-html:th
  ENABLE *4
  <META> に指定されている CONTENT-TYPE が text/html ではありません。
existing-content-type:xc
  ENABLE 4
  <META HTTP-EQUIV="$argv[1]"> は $argv[2]行目にもありました。
content-xxxx-type:cxt
  ENABLE *1
  <$argv[2]> を使うときは <HEAD>～</HEAD> 内に <META HTTP-EQUIV="$argv[1]" CONTENT="～"> を指定するようにしましょう。
need-content-xxxx-type:nxt
  ENABLE 2
  $argv[2] 属性を使うときは <HEAD>～</HEAD> 内に <META HTTP-EQUIV="$argv[1]" CONTENT="～"> を指定しなければなりません。
refresh:r
  ENABLE *2
  <META HTTP-EQUIV="REFRESH"> を利用しての自動的なページ更新は避けましょう。
refresh-link:rl
  ENABLE *3
  <META HTTP-EQUIV="REFRESH" CONTENT="～"> を利用するときは同等のリンクも用意しましょう。
comment-element:ce
  ENABLE 3
  <$argv[0]>～</$argv[0]> 内の要素はすべてコメントで囲んだ方が安全です。
etago-in-cdata:et
  ENABLE *7
  <$argv[0]>～</$argv[0]> 内に `</` を直接書くことはできません。
@no-noscript:ns
  DISABLE 0.01
  <$argv[0]> タグがありますが、<$argv[1]> タグがありません。
title-length:tl
  ENABLE 1
  <$argv[0]> の内容は $argv[1]文字以内に収めるようにしましょう。
body-color:bc
  ENABLE 1
  <$argv[0]> での色指定が不完全です。$argv[1] 属性も含めるようにしましょう。
background:bg
  ENABLE 1
  <$argv[0]> で $argv[1] 属性を指定したときは $argv[2] 属性も指定するようにしましょう。
same-bgcolor:sbg
  ENABLE 3
  <$argv[0]> の $argv[1] 属性の色指定が <BODY BGCOLOR> の色と同じです。
near-bgcolor:nbg
  ENABLE 0.3
  <$argv[0]> の $argv[1] 属性の色指定が <BODY BGCOLOR> の色と似ています。
repeated-id:ri
  ENABLE 7
  <$argv[0]> の $argv[1] 属性の値 `$argv[2]` は $argv[3]行目ですでに使われています。
undef-id:ui
  ENABLE 7
  $argv[3]行目で参照されている <$argv[0]> の $argv[1] 属性の ID `$argv[2]` は定義されていません。
repeated-name:rn
  ENABLE 1
  <$argv[0]> の $argv[1] 属性の値 `$argv[2]` は $argv[3]行目ですでに使われています。
multiple-checked:mc
  ENABLE 4
  <$argv[0]> に CHECKED 属性が指定されていますが、$argv[1]行目ですでに指定されています。
multiple-selected:ms
  ENABLE 4
  <$argv[0]> に SELECTED 属性が指定されていますが、$argv[1]行目ですでに指定されています。$argv[2]
over-select-options:oso
  ENABLE 4
  ひとつの <SELECT> 中に指定できる <$argv[0]> は $argv[1]件までです。
option-value-length:ovl
  ENABLE 4
  <$argv[0]> の $argv[1] 属性の値は半角換算で $argv[2]文字以内でなければなりません。
@default-text:dtx
  ENABLE 0.1
  <$argv[0]> には$argv[1]初期値となるテキストを指定しておきましょう。
button-usemap:bu
  ENABLE 6
  <$argv[0]> に用いる <$argv[1]> には $argv[2] 属性を指定することはできません。
label-control:lc
  ENABLE 5
  <$argv[0]> をここに書くことはできません。$argv[1]行目の <LABEL>～</LABEL> 内には $argv[2]行目に <$argv[3]> が含まれています。
label-no-control:lnc
  ENABLE 5
  FOR 属性の含まれない <$argv[0]>～</$argv[0]> 内にはフォームコントロールを指定しなければなりません。
label-for-control:lfc
  ENABLE 1
  <$argv[0]> の$argv[3] ID 属性の値と $argv[1]行目の <$argv[2]> の FOR 属性の値が食い違っています。
@form-tabindex:tb
  ENABLE 0.01
  <$argv[0]> には TABINDEX 属性を指定するようにしましょう。
@form-accesskey:fak
  ENABLE 0.01
  <$argv[0]> には ACCESSKEY 属性を指定するようにしましょう。
@recommended-title:t
  ENABLE 0.01
  <$argv[0]> には TITLE 属性$argv[1]を指定するようにしましょう。
object-text-equivalent:oq
  ENABLE 3
  <$argv[0]> には等価な内容を書くようにしましょう。
applet-text-equivalent:aq
  ENABLE 1
  <$argv[0]> に $argv[1] 属性と等価な内容の両方を書くことは薦められていません。
@alt-spaces:as
  ENABLE 2
  <$argv[0]> の $argv[1] 属性に空白だけの文字列を指定することは薦められていません。
img-alt:a
  ENABLE 7
  <$argv[0]> には ALT 属性を指定するようにしましょう。
*img-size:z
  ENABLE 2
  <$argv[0]> には WIDTH と HEIGHT 属性を指定するようにしましょう。
server-side-image-map:sm
  ENABLE 5
  <$argv[0] $argv[1]> でのサーバサイドイメージマップは使わず、クライアントサイドイメージマップを使いましょう。
@table-summary:su
  ENABLE 1
  <$argv[0]> には SUMMARY 属性を指定するようにしましょう。
@abbr-header-label:ab
  ENABLE 0.01
  <$argv[0]> には ABBR 属性を指定するようにしましょう。
overlap-cells:oc
  ENABLE 8
  <$argv[0]> の COLSPAN 属性の指定と、$argv[1]行目の <$argv[2]> の ROWSPAN 属性の指定が重なり合っています。
no-noframes:nf
  ENABLE 6
  <$argv[0]> タグがありますが、<$argv[1]> タグがありません。
same-document-frameset:sd
  ENABLE 8
  <$argv[0]> の $argv[1] 属性に自分自身を指す URL `$argv[2]` を指定することはできません。
frame-image:fi
  ENABLE 6
  <$argv[0]> の $argv[1] 属性で直接イメージなどを指定することは薦められていません。
frame-title:ft
  ENABLE 4
  <$argv[0]> には TITLE 属性を指定するようにしましょう。
existing-target-name:xt
  ENABLE 5
  <$argv[0]> の $argv[1] 属性のフレームターゲット名 `$argv[2]` は $argv[3]行目ですでに指定されています。
reserved-target-name:rt
  ENABLE 4
  <$argv[0]> の $argv[1] 属性のフレームターゲット名 `$argv[2]` は予約されています。
illegal-target-name:it
  ENABLE 4
  <$argv[0]> の $argv[1] 属性のフレームターゲット名 `$argv[2]` は正しくありません。
@physical-font:pf
  ENABLE 0.01
  <$argv[0]> は物理的フォントタグです。論理的タグを使うようにしましょう。$argv[1]
p-isnot-br:p
  ENABLE 6
  <P> は段落のためのタグです。改行するタグは <BR> です。
*continuous-brs:brs
  DISABLE 0.01
  <BR> が多数連続しています。
tab-in-pre:tp
  ENABLE 3
  $argv[1]行目の <$argv[0]> 内にはタブ文字を書かないようにしましょう。
heading-order:ho
  ENABLE 2
  <$argv[0]> が $argv[2]行目の <$argv[1]> に続いていますが好ましくありません。
@link-accesskey:ak
  DISABLE 0.01
  <$argv[0]> には ACCESSKEY 属性を指定するようにしましょう。
@link-separation:ls
  ENABLE 0.9
  リンクとリンクの間は適当な文字で区切りましょう。
@link-text-equivalent:lq
  ENABLE 2
  リンクイメージの <$argv[0]> の $argv[1] 属性には何か説明を書きましょう。
@here-anchor:h
  ENABLE 1
  <$argv[0]> のアンカーとして `$argv[1]` などを使うのは好ましくありません。
fragment-id-whitespace:fw
  ENABLE 1
  <$argv[0]> のアンカー名 `$argv[1]` 中に空白文字が含まれています。
unsafe-fragment-id:uf
  ENABLE 1
  <$argv[0]> のアンカー名 `$argv[1]` 中に安全でない文字が含まれています。
empty-fragment-id:ef
  ENABLE 5
  <$argv[0]> のアンカー名が空です。
existing-fragment-id:xf
  ENABLE 5
  <$argv[0]> のアンカー名 `$argv[1]` は $argv[2]行目にもありました。
case-insensitive-fragment-id:cf
  ENABLE 2
  <$argv[0]> のアンカー名 `$argv[1]` は $argv[2]行目にもありました。大文字小文字は区別されない可能性があります。
same-fragment-id:sf
  ENABLE 5
  <$argv[0]> のアンカー名 `$argv[1]` は $argv[2]行目で ID 属性としても指定されています。
id-link:il
  ENABLE 0.1
  <$argv[0]> のアンカー名 `$argv[1]` は $argv[2]行目で ID 属性として定義されています。
diff-id-link:dil
  ENABLE 4
  <$argv[0]> のアンカー名 `$argv[1]` と ID 属性の値 `$argv[2]` は、同一タグ中では同じでなければなりません。
bad-link:bl
  ENABLE 6
  <$argv[0]> のアンカー名 `$argv[1]` が見つかりませんでした。
*unref-link:ul
  DISABLE 0.01
  <$argv[0]> のアンカー名 `$argv[1]` は参照されていません。
empty-url:eu
  ENABLE 5
  <$argv[0]> の $argv[1] 属性の URL が空です。
url-whitespace:uw
  ENABLE 3
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` 中に空白文字が含まれています。
url-backslash:ub
  ENABLE 3
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` 中に `\` が含まれています。パスの区切りは `/` でなければなりません。
*unsafe-url:uu
  DISABLE 0.01
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` 中に `$argv[3]` が含まれています。$argv[4] と書いた方が安全です。
excluded-url:xu
  ENABLE 1
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` 中に使用できない文字 `$argv[3]` が含まれています。$argv[4] と書かなければなりません。
excluded-url-ref:xur
  ENABLE 1
  <$argv[0]> の $argv[1] 属性の URL 中の実体参照 `$argv[2]` は使用できない文字 `$argv[3]` です。
no-corresponding-url:nu
  ENABLE 7
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` 中にASCII以外の文字が含まれています。
illegal-protocol:ip
  ENABLE 7
  <$argv[0]> の $argv[1] 属性の URL に指定されているスキーム名 `$argv[2]` は正しくありません。
upper-protocol:upp
  ENABLE 0.3
  <$argv[0]> の $argv[1] 属性の URL のスキーム名 `$argv[2]` は小文字で指定しましょう。
unknown-protocol:up
  ENABLE 1
  <$argv[0]> の $argv[1] 属性の URL に不明のスキーム名 `$argv[2]` が指定されています。
local-protocol:lp
  ENABLE 5
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` はインタネット上から参照できないかも知れません。
@javascript-url:js
  ENABLE 0.01
  <$argv[0]> の $argv[1] 属性の URL に指定されているスキーム `$argv[2]` の利用は薦められていません。
illegal-format-url:if
  ENABLE 4
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` は正しくない書式です。
trailing-slash:ts
  ENABLE 3
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` は `/` で終わらせるようにしましょう。
*conflict-directory:cd
  DISABLE 0.01
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` は $argv[3]行目で `$argv[4]` と指定されています。
*index-html:ih
  ENABLE 1
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` は $argv[3]行目で `$argv[4]` と指定されています。
later-base:lb
  ENABLE 5
  <$argv[0]> の $argv[1] 属性で指定するより前に $argv[2]行目で URL が指定されています。
absolute-base-url:abu
  ENABLE 6
  <$argv[0]> の $argv[1] 属性の URL は絶対位置で指定しなければなりません。
unexpected-end-of-html:xh
  ENABLE *9
  </HTML> の後にまだ何かテキストがあります。
over-file-size:ofs
  ENABLE *9
  $argv[1] では、HTML文書は $argv[2]Kバイト以内でなければなりません。
unsupported-image:uim
  ENABLE 5
  <$argv[0]> の $argv[1] 属性の URL `$argv[2]` は GIF ではありません。$argv[3] ではイメージは GIF でなければなりません。
jpo-no-html:jnh
  ENABLE *9
  $argv[1] は <HTML> から始まらなければなりません。
jpo-shift-jis:jsj
  ENABLE *9
  $argv[1] は $argv[2] で記述しなければなりません。
jpo-bad-char:jbc
  ENABLE 1
  $argv[1] では `$argv[2]` を使うことはできません。
</style></file></warn></endofusage></endofversion;></body></html>