← Back to branch summary

~ubuntu-branches/ubuntu/karmic/ocamlnet/karmic

« back to all changes in this revision

Viewing changes to src/netstring/nethtml.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stefano Zacchiroli
  • Date: 2005-04-15 08:47:01 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 hoary)
  • Revision ID: james.westby@ubuntu.com-20050415084701-3sxqut7h5ftfm3jp
Tags: 1.0-1
* New upstream release
* Urgency set to medium (rational: bug fix/consolidation release)

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/netstring/nethtml.ml
1
 
(* $Id: nethtml.ml,v 2.6 2003/03/02 13:09:28 stolpmann Exp $
 
1
(* $Id: nethtml.ml,v 2.9 2005/01/22 10:58:26 stolpmann Exp $
2
2
 * ----------------------------------------------------------------------
3
3
 *
4
4
 *)
130
130
    "dl",                 (`Block, `Elements ["dt"; "dd"]);
131
131
    "div",                (`Block, `Flow);
132
132
    "noscript",           (`Block, `Flow);
133
 
    "blockquote",         (`Block, (`Block |. `Elements ["script"]));
 
133
    "blockquote",         (`Block, (`Flow |. `Elements ["script"]));
 
134
                          (* strict DTD has `Block here *)
134
135
    "form",               (`Block, `Sub_exclusions( ["form"],
135
 
                                                    `Block |. 
 
136
                                                    `Flow |. 
136
137
                                                       `Elements ["script"]));
 
138
                          (* strict DTD has `Block here *)
137
139
    "hr",                 (`Block, `Empty);
138
140
    "table",              (`Block, `Elements ["caption"; "col"; "colgroup";
139
141
                                              "thead"; "tfoot"; "tbody"; "tr"]);
145
147
    "isindex",            (`Block, `Empty);
146
148
    (* ------------ OTHER ELEMENTS ----------*)
147
149
    "body",               (`None, (`Flow |. `Elements ["script"]));
 
150
                          (* strict DTD has `Block here *)
148
151
    "area",               (`None, `Empty);
149
152
    "link",               (`None, `Empty);
150
153
    "param",              (`None, `Empty);
364
367
    let backup_excl = !current_excl in
365
368
    try
366
369
      while not (is_possible_subelement !current_name !current_excl sub_name) do
 
370
        (* Maybe we are not allowed to end the current element: *)
 
371
        let (current_class, _) = model_of !current_name in
 
372
        if current_class = `Essential_block then raise Stack.Empty;
367
373
        (* End the current element and remove it from the stack: *)
368
374
        let grant_parent = Stack.pop stack in
369
375
        Stack.push grant_parent backup;        (* Save it; may we need it *)
371
377
        (* If gp_name is an essential element, we are not allowed to close
372
378
         * it implicitly, even if that violates the DTD.
373
379
         *)
374
 
        let (gp_class, _) = model_of gp_name in
375
 
        if gp_class = `Essential_block then raise Stack.Empty;
376
380
        let current = Element (!current_name, !current_atts, 
377
381
                               List.rev !current_subs) in
378
382
        current_name := gp_name;
706
710
  write_ ~dtd (ch # output_string) doc
707
711
 
708
712
 
709
 
module Deprecated = struct
710
 
let parse_string ?dtd ?return_declarations ?return_pis ?return_comments s =
711
 
  let buf = Lexing.from_string s in
712
 
  parse_document ?dtd ?return_declarations ?return_comments ?return_pis buf
713
 
;;
714
 
 
715
 
 
716
 
let parse_file ?dtd ?return_declarations ?return_pis ?return_comments fd =
717
 
  let buf = Lexing.from_channel fd in
718
 
  parse_document ?dtd ?return_declarations ?return_comments ?return_pis buf
719
 
;;
720
 
 
721
 
let write ?(dtd = html40_dtd) os doc =
722
 
  let write_os =
723
 
    match os with
724
 
        `Out_buffer b ->
725
 
          (fun s -> Buffer.add_string b s)
726
 
      | `Out_channel ch ->
727
 
          (fun s -> output_string ch s)
728
 
      | `Out_function f ->
729
 
          (fun s -> f s 0 (String.length s))
730
 
  in
731
 
  write_ ~dtd write_os doc
732
 
 
733
 
end
734
 
 
735
713
(* ======================================================================
736
714
 * History:
737
715
 * 
738
716
 * $Log: nethtml.ml,v $
 
717
 * Revision 2.9  2005/01/22 10:58:26  stolpmann
 
718
 * Error: FORM, BLOCKQUOTE: Content is "flow" in the transitional DTD, not
 
719
 * "block" as in the strict DTD.
 
720
 *
 
721
 * Revision 2.8  2004/07/08 23:04:25  stolpmann
 
722
 *      ocamldoc
 
723
 *
 
724
 * Revision 2.7  2004/06/23 21:47:52  stolpmann
 
725
 *      Handling of essential blocks was wrong when the block was
 
726
 * the direct parent of the element to add. The block was implicitly
 
727
 * closed in this case although this is not allowed (e.g.
 
728
 * <ul><li>x</li><ol><li>y</li></ol></ul>: When <ol> is found, the
 
729
 * ul element must not be closed).
 
730
 *      This is now fixed.
 
731
 *
739
732
 * Revision 2.6  2003/03/02 13:09:28  stolpmann
740
733
 *      Fixed dl model
741
734
 *