ocamldoc/odoc_text.ml

   1 (***********************************************************************)
   2 (*                             OCamldoc                                *)
   3 (*                                                                     *)
   4 (*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
   5 (*                                                                     *)
   6 (*  Copyright 2001 Institut National de Recherche en Informatique et   *)
   7 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   8 (*  under the terms of the Q Public License version 1.0.               *)
   9 (*                                                                     *)
  10 (***********************************************************************)
  11
  12 (* $Id$ *)
  13
  14 exception Text_syntax of int * int * string (* line, char, string *)
  15
  16 open Odoc_types
  17
  18 module Texter =
  19   struct
  20     (* builds a text structure from a string. *)
  21     let text_of_string s =
  22       let lexbuf = Lexing.from_string s in
  23       try
  24         Odoc_text_lexer.init ();
  25         Odoc_text_parser.main Odoc_text_lexer.main lexbuf
  26       with
  27         _ ->
  28           raise (Text_syntax (!Odoc_text_lexer.line_number,
  29                               !Odoc_text_lexer.char_number,
  30                               s)
  31                 )
  32
  33     let count s c =
  34       let count = ref 0 in
  35       for i = 0 to String.length s - 1 do
  36         if s.[i] = c then incr count
  37       done;
  38       !count
  39
  40     let escape_n s c n =
  41       let remain = ref n in
  42       let len = String.length s in
  43       let b = Buffer.create (len + n) in
  44       for i = 0 to len - 1 do
  45         if s.[i] = c && !remain > 0 then
  46           (
  47            Printf.bprintf b "\\%c" c;
  48            decr remain
  49           )
  50         else
  51           Buffer.add_char b s.[i]
  52       done;
  53       Buffer.contents b
  54
  55     let escape_code s =
  56       let open_brackets = count s '[' in
  57       let close_brackets = count s ']' in
  58       if open_brackets > close_brackets then
  59         escape_n s '[' (open_brackets - close_brackets)
  60       else
  61         if close_brackets > open_brackets then
  62           escape_n s ']' (close_brackets - open_brackets)
  63         else
  64           s
  65
  66     let escape_raw s =
  67       let len = String.length s in
  68       let b = Buffer.create len in
  69       for i = 0 to len - 1 do
  70         match s.[i] with
  71           '[' | ']' | '{' | '}' ->
  72             Printf.bprintf b "\\%c" s.[i]
  73         | c ->
  74             Buffer.add_char b c
  75       done;
  76       Buffer.contents b
  77
  78     let p = Printf.bprintf
  79
  80     let rec p_text b t =
  81       List.iter (p_text_element b) t
  82
  83     and p_list b l =
  84       List.iter
  85         (fun t -> p b "{- " ; p_text b t ; p b "}\n")
  86         l
  87
  88     and p_text_element b = function
  89       | Raw s -> p b "%s" (escape_raw s)
  90       | Code s -> p b "[%s]" (escape_code s)
  91       | CodePre s -> p b "{[%s]}" s
  92       | Verbatim s -> p b "{v %s v}" s
  93       | Bold t -> p b "{b " ; p_text b t ; p b "}"
  94       | Italic t -> p b "{i " ; p_text b t ; p b "}"
  95       | Emphasize t -> p b "{e " ; p_text b t ; p b "}"
  96       | Center t -> p b "{C " ; p_text b t ; p b "}"
  97       | Left t -> p b "{L " ; p_text b t ; p b "}"
  98       | Right t -> p b "{R " ; p_text b t ; p b "}"
  99       | List l -> p b "{ul\n"; p_list b l; p b "}"
 100       | Enum l -> p b "{ol\n"; p_list b l; p b "}"
 101       | Newline -> p b "\n"
 102       | Block  t -> p_text b t
 103       | Title (n, l_opt, t) ->
 104           p b "{%d%s "
 105             n
 106             (match l_opt with
 107               None -> ""
 108             | Some s -> ":"^s
 109             );
 110           p_text b t ;
 111           p b "}"
 112       | Latex s -> p b "{%% %s%%}" s
 113       | Link (s,t) ->
 114           p b "{{:%s}" s;
 115           p_text b t ;
 116           p b "}"
 117       | Ref (s,None) ->
 118           p b "{!%s}" s
 119       | Ref (s, Some k) ->
 120           (
 121            let sk = match k with
 122              RK_module -> "module"
 123            | RK_module_type -> "modtype"
 124            | RK_class -> "class"
 125            | RK_class_type -> "classtype"
 126            | RK_value -> "val"
 127            | RK_type -> "type"
 128            | RK_exception -> "exception"
 129            | RK_attribute -> "attribute"
 130            | RK_method -> "method"
 131            | RK_section _ -> "section"
 132            in
 133            p b "{!%s:%s}" sk s
 134           )
 135       | Superscript t -> p b "{^" ; p_text b t ; p b "}"
 136       | Subscript t -> p b "{_" ; p_text b t ; p b "}"
 137       | Module_list l ->
 138           p b "{!modules:";
 139           List.iter (fun s -> p b " %s" s) l;
 140           p b "}"
 141       | Index_list ->
 142           p b "{!indexlist}"
 143       | Custom (s,t) ->
 144           p b "{%s " s;
 145           p_text b t;
 146           p b "}"
 147
 148     let string_of_text s =
 149       let b = Buffer.create 256 in
 150       p_text b s;
 151       Buffer.contents b
 152
 153   end