← Back to branch summary

~ubuntu-branches/ubuntu/wily/coq-doc/wily

« back to all changes in this revision

Viewing changes to contrib/xml/xml.ml4

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu, Stéphane Glondu, Samuel Mimram
  • Date: 2010-01-07 22:50:39 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20100107225039-n3cq82589u0qt0s2
Tags: 8.2pl1-1
http://bugs.debian.org/563669
http://bugs.debian.org/543545
[ Stéphane Glondu ]
* New upstream release (Closes: #563669)
  - remove patches
* Packaging overhaul:
  - use git, advertise it in Vcs-* fields of debian/control
  - use debhelper 7 and dh with override
  - use source format 3.0 (quilt)
* debian/control:
  - set Maintainer to d-o-m, set Uploaders to Sam and myself
  - add Homepage field
  - bump Standards-Version to 3.8.3
* Register PDF documentation into doc-base
* Add debian/watch
* Update debian/copyright

[ Samuel Mimram ]
* Change coq-doc's description to mention that it provides documentation in
  pdf format, not postscript, closes: #543545.

Show diffs side-by-side

added added

removed removed

Lines of Context:
contrib/xml/xml.ml4
 
1
(************************************************************************)
 
2
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
 
3
(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
 
4
(*   \VV/  **************************************************************)
 
5
(*    //   *   The HELM Project         /   The EU MoWGLI Project       *)
 
6
(*         *   University of Bologna                                    *)
 
7
(************************************************************************)
 
8
(*          This file is distributed under the terms of the             *)
 
9
(*           GNU Lesser General Public License Version 2.1              *)
 
10
(*                                                                      *)
 
11
(*                 Copyright (C) 2000-2004, HELM Team.                  *)
 
12
(*                       http://helm.cs.unibo.it                        *)
 
13
(************************************************************************)
 
14
 
 
15
(* the type token for XML cdata, empty elements and not-empty elements *)
 
16
(* Usage:                                                                *)
 
17
(*  Str cdata                                                            *)
 
18
(*  Empty (element_name, [attrname1, value1 ; ... ; attrnamen, valuen]   *)
 
19
(*  NEmpty (element_name, [attrname1, value2 ; ... ; attrnamen, valuen], *)
 
20
(*          content                                                      *)
 
21
type token = Str of string
 
22
           | Empty of string * (string * string) list
 
23
           | NEmpty of string * (string * string) list * token Stream.t
 
24
;;
 
25
 
 
26
(* currified versions of the constructors make the code more readable *)
 
27
let xml_empty name attrs = [< 'Empty(name,attrs) >]
 
28
let xml_nempty name attrs content = [< 'NEmpty(name,attrs,content) >]
 
29
let xml_cdata str = [< 'Str str >]
 
30
 
 
31
(* Usage:                                                                   *)
 
32
(*  pp tokens None     pretty prints the output on stdout                   *)
 
33
(*  pp tokens (Some filename) pretty prints the output on the file filename *)
 
34
let pp_ch strm channel =
 
35
 let rec pp_r m =
 
36
  parser
 
37
    [< 'Str a ; s >] ->
 
38
      print_spaces m ;
 
39
      fprint_string (a ^ "\n") ;
 
40
      pp_r m s
 
41
  | [< 'Empty(n,l) ; s >] ->
 
42
      print_spaces m ;
 
43
      fprint_string ("<" ^ n) ;
 
44
      List.iter (function (n,v) -> fprint_string (" " ^ n ^ "=\"" ^ v ^ "\"")) l;
 
45
      fprint_string "/>\n" ;
 
46
      pp_r m s
 
47
  | [< 'NEmpty(n,l,c) ; s >] ->
 
48
      print_spaces m ;
 
49
      fprint_string ("<" ^ n) ;
 
50
      List.iter (function (n,v) -> fprint_string (" " ^ n ^ "=\"" ^ v ^ "\"")) l;
 
51
      fprint_string ">\n" ;
 
52
      pp_r (m+1) c ;
 
53
      print_spaces m ;
 
54
      fprint_string ("</" ^ n ^ ">\n") ;
 
55
      pp_r m s
 
56
  | [< >] -> ()
 
57
 and print_spaces m =
 
58
  for i = 1 to m do fprint_string "  " done
 
59
 and fprint_string str =
 
60
  output_string channel str
 
61
 in
 
62
  pp_r 0 strm
 
63
;;
 
64
 
 
65
 
 
66
let pp strm fn =
 
67
  match fn with
 
68
     Some filename ->
 
69
      let filename = filename ^ ".xml" in
 
70
      let ch = open_out filename in
 
71
       pp_ch strm ch;
 
72
       close_out ch ;
 
73
       print_string ("\nWriting on file \"" ^ filename ^ "\" was succesful\n");
 
74
       flush stdout
 
75
   | None ->
 
76
       pp_ch strm stdout
 
77
;;
 
78