## check-html-g.pkg
#
# This implements a tree walk over an HTML file to check for
# errors, such as violations of exclusions.
# Compiled by:
# src/lib/html/html.libstipulate
package has = html_abstract_syntax; # html_abstract_syntax is from src/lib/html/html-abstract-syntax.pkgherein
generic package check_html_g (err: Html_Error ) # Html_Error is from src/lib/html/html-error.api : (weak)
api {
Context = { file: Null_Or( String ), line: Int };
check: Context -> has::Html -> Void;
}
{
Context = err::Context;
fun check context (has::HTML { body=>has::BODY { content, ... }, ... } )
=
check_body_content { in_form=>FALSE } content
where
fun error (element, ctx)
=
err::syntax_error context
(sfprintf::sprintf' "unexpected %s element in %s" [
sfprintf::STRING element, sfprintf::STRING ctx
]);
fun content_error ctx
=
err::syntax_error context
(sfprintf::sprintf' "unexpected element in %s" [sfprintf::STRING ctx]);
fun form_error element
=
err::syntax_error context
(sfprintf::sprintf' "unexpected %s element not in FORM" [
sfprintf::STRING element
]);
fun attribute_error attribute
=
err::missing_attribute context attribute;
fun check_body_content { in_form } b
=
case b
has::HN { n, align, content }
=>
check_text { in_anchor=>FALSE, in_form, in_pre=>FALSE, in_applet=>FALSE } content;
has::ADDRESS block
=>
check_address { in_form } block;
has::BLOCK_LIST bl
=>
list::apply (check_body_content { in_form } ) bl;
block =>
check_block { in_form } block;
esac
also
fun check_address { in_form } blk
=
case blk
has::BLOCK_LIST bl
=>
list::apply (check_address { in_form } ) bl;
has::TEXTABLOCK txt
=>
check_text { in_anchor=>FALSE, in_form, in_pre=>FALSE, in_applet => FALSE } txt;
has::PP { content, ... }
=>
check_text { in_anchor=>FALSE, in_form, in_pre=>FALSE, in_applet => FALSE } content;
_ =>
content_error "ADDRESS";
esac
also
fun check_block { in_form } blk
=
case blk
has::BLOCK_LIST bl
=>
list::apply (check_block { in_form } ) bl;
has::TEXTABLOCK txt
=>
check_text { in_anchor=>FALSE, in_form, in_pre=>FALSE, in_applet => FALSE } txt;
has::PP { content, ... }
=>
check_text { in_anchor=>FALSE, in_form, in_pre=>FALSE, in_applet => FALSE } content;
has::UL { content, ... }
=>
check_items { in_form, in_dir_or_menu=>FALSE } content;
has::OL { content, ... }
=>
check_items { in_form, in_dir_or_menu=>FALSE } content;
has::DIR { content, ... }
=>
check_items { in_form, in_dir_or_menu=>TRUE } content;
has::MENU { content, ... }
=>
check_items { in_form, in_dir_or_menu=>TRUE } content;
has::DL { content, ... }
=>
check_dlitems { in_form } content;
has::PRE { content, ... }
=>
check_text { in_anchor=>FALSE, in_form, in_pre=>TRUE, in_applet => FALSE } content;
has::DIV { content, ... }
=>
check_body_content { in_form } content;
has::CENTER content
=>
check_body_content { in_form } content;
has::BLOCKQUOTE content
=>
check_body_content { in_form } content;
has::FORM { content, ... }
=>
{ if in_form error("FORM", "FORM"); fi;
check_body_content { in_form=>TRUE } content;
};
has::ISINDEX _ => ();
has::HR _ => ();
has::TABLE { caption=>THE (has::CAPTION { content=>caption, ... } ), content, ... }
=>
{ check_text {
in_anchor=>FALSE, in_form, in_pre=>FALSE,
in_applet => FALSE
} caption;
check_rows { in_form } content;
};
has::TABLE { content, ... }
=>
check_rows { in_form } content;
has::HN _ => error ("HN", "block");
has::ADDRESS _ => error ("ADDRESS", "block");
esac
also
fun check_items { in_form, in_dir_or_menu } items
=
list::apply check items
where
fun check_blk (has::BLOCK_LIST bl) => list::apply check_blk bl;
check_blk (has::TEXTABLOCK txt) => ();
check_blk (has::PP _) => ();
check_blk _ => error ("block", "DIR/MENU");
end;
check
=
if in_dir_or_menu
\\ (has::LI { content, ... } )
=
{ check_blk content;
check_block { in_form } content;
};
else
\\ (has::LI { content, ... } )
=
check_block { in_form } content;
fi;
end
also
fun check_dlitems { in_form } items
=
list::apply check items
where
fun check { dt, dd }
=
{
list::apply
(check_text {
in_anchor=>FALSE, in_form, in_pre=>FALSE, in_applet=>FALSE
} )
dt;
check_block { in_form } dd;
};
end
also
fun check_rows { in_form } rows
=
list::apply check_row rows
where
fun check_cell (has::TH { content, ... } )
=>
check_body_content { in_form } content;
check_cell (has::TD { content, ... } )
=>
check_body_content { in_form } content;
end;
fun check_row (has::TR { content, ... } )
=
list::apply check_cell content;
end
also
fun check_text { in_anchor, in_form, in_pre, in_applet }
=
check
where
fun check txt
=
case txt
has::TEXT_LIST tl => list::apply check tl;
has::PCDATA _ => ();
has::TT txt => check txt;
has::IX txt => check txt;
has::BX txt => check txt;
has::UX txt => check txt;
has::STRIKE txt => check txt;
has::EM txt => check txt;
has::STRONG txt => check txt;
has::DFN txt => check txt;
has::CODE txt => check txt;
has::SAMP txt => check txt;
has::KBD txt => check txt;
has::VAR txt => check txt;
has::CITE txt => check txt;
has::BIG txt => { if in_pre error("BIG", "PRE"); fi; check txt; };
has::SMALL txt => { if in_pre error("SMALL", "PRE"); fi; check txt; };
has::SUB txt => { if in_pre error("SUB", "PRE"); fi; check txt; };
has::SUP txt => { if in_pre error("SUP", "PRE"); fi; check txt; };
has::AX { content, ... }
=>
{ if in_anchor error("anchor", "anchor"); fi;
check_text {
in_anchor=>TRUE, in_form, in_pre,
in_applet
} content;
};
has::IMG _ =>
if in_pre error("IMG", "PRE"); fi;
has::APPLET { content, ... } => check_text {
in_anchor=>FALSE, in_form, in_pre,
in_applet=>TRUE
} content;
has::PARAM _ => if in_applet error ("parameter", "applet"); fi;
has::FONT { content, ... } => if in_pre error("FONT", "PRE" ); fi;
has::BASEFONT { content, ... } => if in_pre error("BASEFONT", "PRE" ); fi;
has::BR _ => ();
has::MAP _ => ();
has::INPUT { type, name, value, ... }
=>
{
if (not in_form) form_error "INPUT"; fi;
if ((name == NULL)
and (type != THE has::input_type::submit)
and (type != THE has::input_type::reset))
attribute_error "NAME";
fi;
if ((value == NULL)
and ((type == THE has::input_type::radio)
or (type == THE has::input_type::checkbox)))
attribute_error "VALUE";
fi;
};
has::SELECT _ => if (not in_form) form_error "SELECT"; fi;
has::TEXTAREA _ => if (not in_form) form_error "TEXTAREA"; fi;
has::SCRIPT _ => ();
esac;
end; # fun check_text
end; # fun check
};
end;
## COPYRIGHT (c) 1996 AT&T Research.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.