← Back to branch summary

~ubuntu-branches/ubuntu/trusty/pxp/trusty

« back to all changes in this revision

Viewing changes to tools/src/odoc/chtml_ocaml4.ml

  • Committer: Package Import Robot
  • Author(s): Stéphane Glondu
  • Date: 2013-07-11 11:21:26 UTC
  • mfrom: (6.1.3 sid)
  • Revision ID: package-import@ubuntu.com-20130711112126-5wysiuf0cgjo376r
Tags: 1.2.4-1
* Team upload
* New upstream release
* Update Vcs-*

Show diffs side-by-side

added added

removed removed

Lines of Context:
tools/src/odoc/chtml_ocaml4.ml
 
1
(* Our custom HTML generator *)
 
2
 
 
3
(* Define
 
4
 
 
5
     {picture file.png Caption Text}
 
6
 
 
7
     so images can be easily included into ocamldoc documentation
 
8
 
 
9
   Define
 
10
 
 
11
     {directinclude <true>|<false>}
 
12
 
 
13
     changing the bahviour of "include Module". If direct include is enabled,
 
14
     the included stuff is directly shown.
 
15
 
 
16
   Define
 
17
 
 
18
     {fixpxpcoretypes <true>|<false>}
 
19
 
 
20
     If enabled, this mode changes all clickable references 
 
21
     - of Pxp_core_types.I.<id> into Pxp_types.<id>, and
 
22
     - of Pxp_core_types.S.<id> into Pxp_types.<id>
 
23
 
 
24
   Define
 
25
     {knowntype identifier}
 
26
     {knownclass identifier}
 
27
 
 
28
     to enter additional names into the tables of type and class names
 
29
     for which links are generated
 
30
 
 
31
 *)
 
32
 
 
33
open Printf
 
34
open Odoc_info
 
35
open Module
 
36
 
 
37
module StringSet = Odoc_html.StringSet
 
38
 
 
39
 
 
40
let word_re = Str.regexp "[ \t\r\n]+"
 
41
 
 
42
let split_args t =
 
43
  match t with
 
44
    | [] -> []
 
45
    | [Odoc_info.Raw arg] -> Str.split word_re arg
 
46
    | _ ->
 
47
        failwith "Argument too complicated"
 
48
 
 
49
 
 
50
 
 
51
module Generator (G : Odoc_html.Html_generator) = struct
 
52
  class html =
 
53
  object(self)
 
54
    inherit G.html as super
 
55
 
 
56
    method private html_of_picture b t = 
 
57
      let (file, caption) =
 
58
        match split_args t with
 
59
          | [] ->
 
60
              failwith "{picture ...} needs at least one argument"
 
61
          | w ->
 
62
              ( match w with
 
63
                  | file :: args ->
 
64
                      (file, String.concat " " args)
 
65
                  | [] ->
 
66
                      failwith "{picture ...} needs a simple word as first argument"
 
67
              ) in
 
68
      bprintf b
 
69
        "<div class=\"picture\">\
 
70
         <div class=\"picture-caption\">%s</div>\
 
71
         <img src=\"%s\">\
 
72
         </div>"
 
73
        (self#escape caption)
 
74
        file
 
75
 
 
76
    val mutable enable_direct_include = false
 
77
 
 
78
    method private html_of_direct_include b t =
 
79
      match split_args t with
 
80
        | ["true"] ->
 
81
            enable_direct_include <- true
 
82
        | ["false"] ->
 
83
            enable_direct_include <- false
 
84
        | _ ->
 
85
            failwith "{directinclude ...} needs one bool argument"
 
86
              
 
87
 
 
88
    method html_of_included_module b im =   (* overridden! *)
 
89
      super # html_of_included_module b im;
 
90
      if enable_direct_include then (
 
91
        match im.im_module with
 
92
          | None -> ()    (* case module is unknown *)
 
93
          | Some (Mod m) ->
 
94
              bprintf b "<div class=\"included-module\">\n";
 
95
              List.iter
 
96
                (self#html_of_module_element b (Name.father m.m_name))
 
97
                (Module.module_elements m);
 
98
              bprintf b "</div>\n"
 
99
          | Some (Modtype mt) ->
 
100
              bprintf b "<div class=\"included-module-type\">\n";
 
101
              List.iter
 
102
                (self#html_of_module_element b (Name.father mt.mt_name))
 
103
                (Module.module_type_elements mt);
 
104
              bprintf b "</div>\n"
 
105
      )
 
106
 
 
107
 
 
108
    val mutable enable_fix_pxp_core_types = false
 
109
 
 
110
    method private html_of_fix_pxp_core_types b t =
 
111
      match split_args t with
 
112
        | ["true"] ->
 
113
            enable_fix_pxp_core_types <- true
 
114
        | ["false"] ->
 
115
            enable_fix_pxp_core_types <- false
 
116
        | _ ->
 
117
            failwith "{fixpxpcoretypes ...} needs one bool argument"
 
118
              
 
119
              
 
120
    val pxp_core_types_re = Str.regexp "Pxp_core_types\\.[SI]\\."
 
121
      
 
122
    method create_fully_qualified_idents_links m_name s =
 
123
      let s' =
 
124
        if enable_fix_pxp_core_types then (
 
125
          Str.global_replace pxp_core_types_re "Pxp_types." s 
 
126
        )
 
127
        else
 
128
          s in
 
129
      super # create_fully_qualified_idents_links m_name s'
 
130
        
 
131
    method html_of_Ref b name ref_opt =
 
132
      let name' =
 
133
        if enable_fix_pxp_core_types then (
 
134
          (* prerr_endline ("Ref: " ^ name); *)
 
135
          Str.global_replace pxp_core_types_re "Pxp_types." name
 
136
        )
 
137
        else
 
138
          name in
 
139
      super # html_of_Ref b name' ref_opt
 
140
        
 
141
    method html_of_custom_text b s t =
 
142
      let add_known_type t =
 
143
        List.iter
 
144
          (fun s ->
 
145
             known_types_names <- StringSet.add s known_types_names
 
146
          )
 
147
          (split_args t) in
 
148
        
 
149
      let add_known_class t =
 
150
        List.iter
 
151
          (fun s ->
 
152
             known_classes_names <- StringSet.add s known_classes_names
 
153
          )
 
154
          (split_args t) in
 
155
 
 
156
      match s with
 
157
        | "picture" -> self#html_of_picture b t
 
158
        | "directinclude" -> self#html_of_direct_include b t
 
159
        | "fixpxpcoretypes" -> self#html_of_fix_pxp_core_types b t
 
160
        | "knowntype" -> add_known_type t
 
161
        | "knownclass" -> add_known_class t
 
162
        | _ -> ()
 
163
  end
 
164
end
 
165
 
 
166
let _ = 
 
167
  Odoc_args.extend_html_generator (module Generator : Odoc_gen.Html_functor)