1(**************************************************************************) 2(* *) 3(* OCaml *) 4(* *) 5(* Maxence Guesdon, projet Cristal, INRIA Rocquencourt *) 6(* *) 7(* Copyright 2001 Institut National de Recherche en Informatique et *) 8(* en Automatique. *) 9(* *) 10(* All rights reserved. This file is distributed under the terms of *) 11(* the GNU Lesser General Public License version 2.1, with the *) 12(* special exception on linking described in the file LICENSE. *) 13(* *) 14(**************************************************************************) 15 16(** The man pages generator. *) 17open Odoc_info 18open Value 19open Type 20open Extension 21open Exception 22open Class 23open Module 24open Search 25 26let man_suffix = ref Odoc_messages.default_man_suffix 27let man_section = ref Odoc_messages.default_man_section 28 29let man_mini = ref false 30 31let new_buf () = Buffer.create 1024 32let bp = Printf.bprintf 33let bs = Buffer.add_string 34 35let linebreak = "\n.sp\n";; 36 37(** A class used to get a [text] for info structures. *) 38class virtual info = 39 object (self) 40 (** The list of pairs [(tag, f)] where [f] is a function taking 41 the [text] associated to [tag] and returning man code. 42 Add a pair here to handle a tag.*) 43 val mutable tag_functions = ([] : (string * (Odoc_info.text -> string)) list) 44 45 (** Return man code for a [text]. *) 46 method virtual man_of_text : Buffer.t -> Odoc_info.text -> unit 47 48 method str_man_of_text t = 49 let b = Buffer.create 256 in 50 self#man_of_text b t ; 51 Buffer.contents b 52 53 (** Print groff string for an author list. *) 54 method str_man_of_author_list l = 55 match l with 56 [] -> "" 57 | _ -> 58 let b = Buffer.create 256 in 59 bs b ".B \""; 60 bs b Odoc_messages.authors; 61 bs b "\"\n:\n"; 62 bs b (String.concat ", " l); 63 bs b "\n"; 64 (*bs b "\n.sp\n"*) 65 Buffer.contents b 66 67 (** Print groff string for the given optional version information.*) 68 method str_man_of_version_opt v_opt = 69 match v_opt with 70 None -> "" 71 | Some v -> 72 let b = Buffer.create 256 in 73 bs b ".B \""; 74 bs b Odoc_messages.version; 75 bs b "\"\n:\n"; 76 bs b v; 77 bs b "\n"; 78 (*".sp\n"*) 79 Buffer.contents b 80 81 (** Printf groff string for the \@before information. *) 82 method str_man_of_before = function 83 [] -> "" 84 | l -> 85 let b = Buffer.create 256 in 86 let rec iter = function 87 [] -> () 88 | (v, text) :: q -> 89 bp b ".B \"%s" Odoc_messages.before; 90 bs b v; 91 bs b "\"\n"; 92 self#man_of_text b text; 93 bs b "\n"; 94 bs b "\n"; 95 match q with 96 [] -> () 97 | _ -> bs b linebreak ; iter q 98 in 99 iter l; 100 Buffer.contents b 101 102 (** Print groff string for the given optional since information.*) 103 method str_man_of_since_opt s_opt = 104 match s_opt with 105 None -> "" 106 | Some s -> 107 let b = Buffer.create 256 in 108 bs b ".B \""; 109 bs b Odoc_messages.since; 110 bs b "\"\n"; 111 bs b s; 112 bs b "\n";(*".sp\n"*) 113 Buffer.contents b 114 115 (** Print groff string for the given list of raised exceptions.*) 116 method str_man_of_raised_exceptions l = 117 match l with 118 [] -> "" 119 | _ -> 120 let b = Buffer.create 256 in 121 let rec iter = function 122 [] -> () 123 | (s, t) :: q -> 124 bs b ".B \""; 125 bs b Odoc_messages.raises; 126 bs b (" "^s^"\"\n"); 127 self#man_of_text b t; 128 bs b "\n"; 129 match q with 130 [] -> () 131 | _ -> bs b linebreak; iter q 132 in 133 iter l; 134 Buffer.contents b 135 136 (** Print groff string for the given "see also" reference. *) 137 method str_man_of_see (see_ref, t) = 138 let t_ref = 139 match see_ref with 140 Odoc_info.See_url s -> [ Odoc_info.Link (s, t) ] 141 | Odoc_info.See_file s -> (Odoc_info.Code s) :: (Odoc_info.Raw " ") :: t 142 | Odoc_info.See_doc s -> (Odoc_info.Italic [Odoc_info.Raw s]) :: (Odoc_info.Raw " ") :: t 143 in 144 self#str_man_of_text t_ref 145 146 (** Print groff string for the given list of "see also" references.*) 147 method str_man_of_sees l = 148 match l with 149 [] -> "" 150 | _ -> 151 let b = Buffer.create 256 in 152 let rec iter = function 153 [] -> () 154 | see :: q -> 155 bs b ".B \""; 156 bs b Odoc_messages.see_also; 157 bs b "\"\n"; 158 bs b (self#str_man_of_see see); 159 bs b "\n"; 160 match q with 161 [] -> () 162 | _ -> bs b linebreak; iter q 163 in 164 iter l; 165 Buffer.contents b 166 167 (** Print groff string for the given optional return information.*) 168 method str_man_of_return_opt return_opt = 169 match return_opt with 170 None -> "" 171 | Some s -> 172 let b = Buffer.create 256 in 173 bs b ".B "; 174 bs b Odoc_messages.returns; 175 bs b "\n"; 176 self#man_of_text b s; 177 bs b "\n"; 178 Buffer.contents b 179 180 (** Print man code for the given list of custom tagged texts. *) 181 method str_man_of_custom l = 182 List.fold_left 183 (fun acc (tag, text) -> 184 try 185 let f = List.assoc tag tag_functions in 186 let buf = Buffer.create 50 in 187 Buffer.add_string buf (f text); 188 (Buffer.contents buf) :: acc 189 with 190 Not_found -> 191 Odoc_info.warning (Odoc_messages.tag_not_handled tag); 192 acc 193 ) 194 [] l 195 196 (** Print the groff string to display an optional info structure. *) 197 method man_of_info ?margin:(_ :int option) b info_opt = 198 match info_opt with 199 None -> () 200 | Some info -> 201 let module M = Odoc_info in 202 let l = 203 ( 204 match info.M.i_deprecated with 205 None -> [] 206 | Some d -> 207 let b = Buffer.create 256 in 208 bs b ".B \""; 209 bs b Odoc_messages.deprecated; 210 bs b "\"\n"; 211 self#man_of_text b d; 212 bs b "\n"; 213 [ Buffer.contents b ] 214 ) @ 215 ( 216 match info.M.i_desc with 217 None -> [] 218 | Some d when d = [Odoc_info.Raw ""] -> [] 219 | Some d -> 220 [ (self#str_man_of_text d)^"\n" ] 221 ) @ 222 [ 223 self#str_man_of_author_list info.M.i_authors; 224 self#str_man_of_version_opt info.M.i_version; 225 self#str_man_of_before info.M.i_before; 226 self#str_man_of_since_opt info.M.i_since; 227 self#str_man_of_raised_exceptions info.M.i_raised_exceptions; 228 self#str_man_of_return_opt info.M.i_return_value; 229 self#str_man_of_sees info.M.i_sees; 230 ] @ 231 (self#str_man_of_custom info.M.i_custom) 232 in 233 let l = List.filter ((<>) "") l in 234 Buffer.add_string b (String.concat "\n.sp\n" l) 235 end 236 237module Generator = 238struct 239 240(** This class is used to create objects which can generate a simple html documentation. *) 241class man = 242 let re_slash = Str.regexp_string "/" in 243 object (self) 244 inherit info 245 246 (** Get a file name from a complete name. *) 247 method file_name name = 248 let s = Printf.sprintf "%s.%s" name !man_suffix in 249 Str.global_replace re_slash "slash" s 250 251 (** Escape special sequences of characters in a string. *) 252 method escape (s : string) = 253 let len = String.length s in 254 let b = Buffer.create len in 255 for i = 0 to len - 1 do 256 match s.[i] with 257 '\\' -> Buffer.add_string b "\\(rs" 258 | '.' -> Buffer.add_string b "\\&." 259 | '\'' -> Buffer.add_string b "\\&'" 260 | '-' -> Buffer.add_string b "\\-" 261 | c -> Buffer.add_char b c 262 done; 263 Buffer.contents b 264 265 (** Open a file for output. Add the target directory.*) 266 method open_out file = 267 let f = Filename.concat !Global.target_dir file in 268 open_out f 269 270 (** Print groff string for a text, without correction of blanks. *) 271 method private man_of_text2 b t = 272 List.iter (self#man_of_text_element b) t 273 274 (** Print the groff string for a text, with blanks corrected. *) 275 method man_of_text b t = 276 let b2 = new_buf () in 277 self#man_of_text2 b2 t ; 278 let s = Buffer.contents b2 in 279 let s2 = Str.global_replace (Str.regexp "\n[ ]*") "\n" s in 280 bs b (Str.global_replace (Str.regexp "\n\n") "\n" s2) 281 282 (** Return the given string without no newlines. *) 283 method remove_newlines s = 284 Str.global_replace (Str.regexp "[ ]*\n[ ]*") " " s 285 286 (** Print the groff string for a text element. *) 287 method man_of_text_element b txt = 288 match txt with 289 | Odoc_info.Raw s -> bs b (self#escape s) 290 | Odoc_info.Code s -> 291 bs b "\n.B "; 292 bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n") 293 | Odoc_info.CodePre s -> 294 bs b "\n.B "; 295 bs b ((Str.global_replace (Str.regexp "\n") "\n.B " (self#escape s))^"\n") 296 | Odoc_info.Verbatim s -> 297 bs b (self#escape s) 298 | Odoc_info.Bold t 299 | Odoc_info.Italic t 300 | Odoc_info.Emphasize t 301 | Odoc_info.Center t 302 | Odoc_info.Left t 303 | Odoc_info.Right t -> 304 self#man_of_text2 b t 305 | Odoc_info.List tl -> 306 List.iter 307 (fun t -> bs b "\n.sp\n \\-"; self#man_of_text2 b t; bs b "\n") 308 tl; 309 bs b "\n" 310 | Odoc_info.Enum tl -> 311 List.iter 312 (fun t -> bs b "\n.sp\n \\-"; self#man_of_text2 b t; bs b "\n") 313 tl; 314 bs b "\n" 315 | Odoc_info.Newline -> 316 bs b "\n.sp\n" 317 | Odoc_info.Block t -> 318 bs b "\n.sp\n"; 319 self#man_of_text2 b t; 320 bs b "\n.sp\n" 321 | Odoc_info.Title (_, _, t) -> 322 self#man_of_text2 b [Odoc_info.Code (Odoc_info.string_of_text t)] 323 | Odoc_info.Latex _ -> 324 (* don't care about LaTeX stuff in HTML. *) 325 () 326 | Odoc_info.Link (_, t) -> 327 self#man_of_text2 b t 328 | Odoc_info.Ref (name, _, _) -> 329 self#man_of_text_element b 330 (Odoc_info.Code (Odoc_info.use_hidden_modules name)) 331 | Odoc_info.Superscript t -> 332 bs b "^{"; self#man_of_text2 b t 333 | Odoc_info.Subscript t -> 334 bs b "_{"; self#man_of_text2 b t 335 | Odoc_info.Module_list _ -> 336 () 337 | Odoc_info.Index_list -> 338 () 339 | Odoc_info.Custom (s,t) -> self#man_of_custom_text b s t 340 | Odoc_info.Target (target, code) -> self#man_of_Target b ~target ~code 341 342 method man_of_custom_text _ _ _ = () 343 344 method man_of_Target b ~target ~code = 345 if String.lowercase_ascii target = "man" then bs b code else () 346 347 (** Print groff string to display code. *) 348 method man_of_code b s = self#man_of_text b [ Code s ] 349 350 (** Take a string and return the string where fully qualified idents 351 have been replaced by idents relative to the given module name.*) 352 method relative_idents m_name s = 353 let f str_t = 354 let match_s = Str.matched_string str_t in 355 Odoc_info.apply_if_equal 356 Odoc_info.use_hidden_modules 357 match_s 358 (Name.get_relative m_name match_s) 359 in 360 Str.global_substitute 361 (Str.regexp "\\([A-Z]\\([a-zA-Z_'0-9]\\)*\\.\\)+\\([a-z][a-zA-Z_'0-9]*\\)") 362 f 363 s 364 365 (** Print groff string to display a [Types.type_expr].*) 366 method man_of_type_expr b m_name t = 367 let s = String.concat "\n" 368 (Str.split (Str.regexp "\n") (Odoc_print.string_of_type_expr t)) 369 in 370 let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in 371 bs b "\n.B "; 372 bs b (self#relative_idents m_name s2); 373 bs b "\n" 374 375 (** Print groff string to display a [Types.class_type].*) 376 method man_of_class_type_expr b m_name t = 377 let s = String.concat "\n" 378 (Str.split (Str.regexp "\n") (Odoc_print.string_of_class_type t)) 379 in 380 let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in 381 bs b "\n.B "; 382 bs b (self#relative_idents m_name s2); 383 bs b "\n" 384 385 (** Print groff string to display a [Types.type_expr list].*) 386 method man_of_cstr_args ?par b m_name sep l = 387 match l with 388 | Cstr_tuple l -> 389 let s = Odoc_str.string_of_type_list ?par sep l in 390 let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in 391 bs b "\n.B "; 392 bs b (self#relative_idents m_name s2); 393 bs b "\n" 394 | Cstr_record l -> 395 self#man_of_record m_name b l 396 397 (** Print groff string to display the parameters of a type.*) 398 method man_of_type_expr_param_list b m_name t = 399 match t.ty_parameters with 400 [] -> () 401 | _ -> 402 let s = Odoc_str.string_of_type_param_list t in 403 let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in 404 bs b "\n.B "; 405 bs b (self#relative_idents m_name s2); 406 bs b "\n" 407 408 (** Print groff string to display a [Types.module_type]. *) 409 method man_of_module_type b m_name t = 410 let s = String.concat "\n" 411 (Str.split (Str.regexp "\n") (Odoc_print.string_of_module_type t)) 412 in 413 let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in 414 bs b "\n.B "; 415 bs b (self#relative_idents m_name s2); 416 bs b "\n" 417 418 (** Print groff string code for a value. *) 419 method man_of_value b v = 420 Odoc_info.reset_type_names () ; 421 bs b "\n.I val "; 422 bs b (Name.simple v.val_name); 423 bs b " \n: "; 424 self#man_of_type_expr b (Name.father v.val_name) v.val_type; 425 bs b ".sp\n"; 426 self#man_of_info b v.val_info; 427 bs b "\n.sp\n" 428 429 (** Print groff string code for a type extension. *) 430 method man_of_type_extension b m_name te = 431 Odoc_info.reset_type_names () ; 432 bs b ".I type "; 433 ( 434 match te.te_type_parameters with 435 [] -> () 436 | _ -> 437 let s = Odoc_str.string_of_type_extension_param_list te in 438 let s2 = Str.global_replace (Str.regexp "\n") "\n.B " s in 439 bs b "\n.B "; 440 bs b (self#relative_idents m_name s2); 441 bs b "\n"; 442 bs b ".I " 443 ); 444 bs b (self#relative_idents m_name te.te_type_name); 445 bs b " \n"; 446 bs b "+="; 447 if te.te_private = Asttypes.Private then bs b " private"; 448 bs b "\n "; 449 List.iter 450 (fun x -> 451 let father = Name.father x.xt_name in 452 bs b ("| "^(Name.simple x.xt_name)); 453 ( 454 match x.xt_args, x.xt_ret with 455 | Cstr_tuple [], None -> bs b "\n" 456 | l, None -> 457 bs b "\n.B of "; 458 self#man_of_cstr_args ~par: false b father " * " l; 459 | Cstr_tuple [], Some r -> 460 bs b "\n.B : "; 461 self#man_of_type_expr b father r; 462 | l, Some r -> 463 bs b "\n.B : "; 464 self#man_of_cstr_args ~par: false b father " * " l; 465 bs b ".B -> "; 466 self#man_of_type_expr b father r; 467 ); 468 ( 469 match x.xt_alias with 470 None -> () 471 | Some xa -> 472 bs b ".B = "; 473 bs b 474 ( 475 match xa.xa_xt with 476 None -> xa.xa_name 477 | Some x -> x.xt_name 478 ); 479 bs b "\n" 480 ); 481 ( 482 match x.xt_text with 483 None -> 484 bs b " " 485 | Some t -> 486 bs b ".I \" \"\n"; 487 bs b "(* "; 488 self#man_of_info b (Some t); 489 bs b " *)\n " 490 ) 491 ) 492 te.te_constructors; 493 bs b "\n.sp\n"; 494 self#man_of_info b te.te_info; 495 bs b "\n.sp\n" 496 497 (** Print groff string code for an exception. *) 498 method man_of_exception b e = 499 Odoc_info.reset_type_names () ; 500 bs b "\n.I exception "; 501 bs b (Name.simple e.ex_name); 502 bs b " \n"; 503 ( 504 match e.ex_args, e.ex_ret with 505 | Cstr_tuple [], None -> () 506 | _, None -> 507 bs b ".B of "; 508 self#man_of_cstr_args 509 ~par: false 510 b (Name.father e.ex_name) " * " e.ex_args 511 | Cstr_tuple [], Some r -> 512 bs b ".B : "; 513 self#man_of_type_expr b (Name.father e.ex_name) r 514 | l, Some r -> 515 bs b ".B : "; 516 self#man_of_cstr_args 517 ~par: false 518 b (Name.father e.ex_name) " * " l; 519 bs b ".B -> "; 520 self#man_of_type_expr b (Name.father e.ex_name) r 521 ); 522 ( 523 match e.ex_alias with 524 None -> () 525 | Some ea -> 526 bs b " = "; 527 bs b 528 ( 529 match ea.ea_ex with 530 None -> ea.ea_name 531 | Some e -> e.ex_name 532 ) 533 ); 534 bs b "\n.sp\n"; 535 self#man_of_info b e.ex_info; 536 bs b "\n.sp\n" 537 538 539 method field_comment b = function 540 | None -> () 541 | Some t -> 542 bs b " (* "; 543 self#man_of_info b (Some t); 544 bs b " *) " 545 546 (** Print groff string for a record type *) 547 method man_of_record father b l = 548 bs b "{"; 549 List.iter (fun r -> 550 bs b (if r.rf_mutable then "\n\n.B mutable \n" else "\n "); 551 bs b (r.rf_name^" : "); 552 self#man_of_type_expr b father r.rf_type; 553 bs b ";"; 554 self#field_comment b r.rf_text ; 555 ) l; 556 bs b "\n }\n" 557 558 559 (** Print groff string for a type. *) 560 method man_of_type b t = 561 Odoc_info.reset_type_names () ; 562 let father = Name.father t.ty_name in 563 bs b ".I type "; 564 self#man_of_type_expr_param_list b father t; 565 ( 566 match t.ty_parameters with 567 [] -> () 568 | _ -> bs b ".I " 569 ); 570 bs b (Name.simple t.ty_name); 571 bs b " \n"; 572 let priv = t.ty_private = Asttypes.Private in 573 ( 574 match t.ty_manifest with 575 None -> () 576 | Some (Object_type l) -> 577 bs b "= "; 578 if priv then bs b "private "; 579 bs b "<"; 580 List.iter (fun r -> 581 bs b (r.of_name^" : "); 582 self#man_of_type_expr b father r.of_type; 583 bs b ";"; 584 self#field_comment b r.of_text ; 585 ) l; 586 bs b "\n >\n" 587 | Some (Other typ) -> 588 bs b "= "; 589 if priv then bs b "private "; 590 self#man_of_type_expr b father typ 591 ); 592 ( 593 match t.ty_kind with 594 Type_abstract -> () 595 | Type_variant l -> 596 bs b "="; 597 if priv then bs b " private"; 598 bs b "\n "; 599 List.iter (fun constr -> 600 bs b ("| "^constr.vc_name); 601 let print_text t = 602 bs b " (* "; 603 self#man_of_info b (Some t); 604 bs b " *)\n " 605 in 606 match constr.vc_args, constr.vc_text,constr.vc_ret with 607 | Cstr_tuple [], None, None -> bs b "\n " 608 | Cstr_tuple [], (Some t), None -> 609 print_text t 610 | l, None, None -> 611 bs b "\n.B of "; 612 self#man_of_cstr_args ~par: false b father " * " l; 613 bs b " " 614 | l, (Some t), None -> 615 bs b "\n.B of "; 616 self#man_of_cstr_args ~par: false b father " * " l; 617 bs b ".I \" \"\n"; 618 print_text t 619 | Cstr_tuple [], None, Some r -> 620 bs b "\n.B : "; 621 self#man_of_type_expr b father r; 622 bs b " " 623 | Cstr_tuple [], (Some t), Some r -> 624 bs b "\n.B : "; 625 self#man_of_type_expr b father r; 626 bs b ".I \" \"\n"; 627 print_text t 628 | l, None, Some r -> 629 bs b "\n.B : "; 630 self#man_of_cstr_args ~par: false b father " * " l; 631 bs b ".B -> "; 632 self#man_of_type_expr b father r; 633 bs b " " 634 | l, (Some t), Some r -> 635 bs b "\n.B of "; 636 self#man_of_cstr_args ~par: false b father " * " l; 637 bs b ".B -> "; 638 self#man_of_type_expr b father r; 639 bs b ".I \" \"\n"; 640 print_text t 641 ) l 642 643 | Type_record l -> 644 bs b "= "; 645 if priv then bs b "private "; 646 self#man_of_record father b l 647 | Type_open -> 648 bs b "= .."; 649 bs b "\n" 650 ); 651 bs b "\n.sp\n"; 652 self#man_of_info b t.ty_info; 653 bs b "\n.sp\n" 654 655 (** Print groff string for a class attribute. *) 656 method man_of_attribute b a = 657 bs b ".I val "; 658 if a.att_virtual then bs b ("virtual "); 659 if a.att_mutable then bs b (Odoc_messages.mutab^" "); 660 bs b ((Name.simple a.att_value.val_name)^" : "); 661 self#man_of_type_expr b (Name.father a.att_value.val_name) a.att_value.val_type; 662 bs b "\n.sp\n"; 663 self#man_of_info b a.att_value.val_info; 664 bs b "\n.sp\n" 665 666 (** Print groff string for a class method. *) 667 method man_of_method b m = 668 bs b ".I method "; 669 if m.met_private then bs b "private "; 670 if m.met_virtual then bs b "virtual "; 671 bs b ((Name.simple m.met_value.val_name)^" : "); 672 self#man_of_type_expr b 673 (Name.father m.met_value.val_name) m.met_value.val_type; 674 bs b "\n.sp\n"; 675 self#man_of_info b m.met_value.val_info; 676 bs b "\n.sp\n" 677 678 (** Groff for a list of parameters. *) 679 method man_of_parameter_list b m_name l = 680 match l with 681 [] -> () 682 | _ -> 683 bs b "\n.B "; 684 bs b Odoc_messages.parameters; 685 bs b ": \n"; 686 List.iter 687 (fun p -> 688 bs b ".sp\n"; 689 bs b "\""; 690 bs b (Parameter.complete_name p); 691 bs b "\"\n"; 692 self#man_of_type_expr b m_name (Parameter.typ p); 693 bs b "\n"; 694 self#man_of_parameter_description b p; 695 bs b "\n" 696 ) 697 l; 698 bs b "\n" 699 700 (** Groff for the description of a function parameter. *) 701 method man_of_parameter_description b p = 702 match Parameter.names p with 703 [] -> () 704 | name :: [] -> 705 ( 706 (* Only one name, no need for label for the description. *) 707 match Parameter.desc_by_name p name with 708 None -> () 709 | Some t -> bs b "\n "; self#man_of_text b t 710 ) 711 | l -> 712 (* A list of names, we display those with a description. *) 713 List.iter 714 (fun n -> 715 match Parameter.desc_by_name p n with 716 None -> () 717 | Some t -> 718 self#man_of_code b (n^" : "); 719 self#man_of_text b t 720 ) 721 l 722 723 (** Print groff string for a list of module parameters. *) 724 method man_of_module_parameter_list b m_name l = 725 match l with 726 [] -> () 727 | _ -> 728 bs b ".B \""; 729 bs b Odoc_messages.parameters; 730 bs b ":\"\n"; 731 List.iter 732 (fun (p, desc_opt) -> 733 bs b ".sp\n"; 734 bs b ("\""^p.mp_name^"\"\n"); 735 Misc.may (self#man_of_module_type b m_name) p.mp_type; 736 bs b "\n"; 737 ( 738 match desc_opt with 739 None -> () 740 | Some t -> self#man_of_text b t 741 ); 742 bs b "\n" 743 ) 744 l; 745 bs b "\n\n" 746 747 (** Print groff string for a class. *) 748 method man_of_class b c = 749 Odoc_info.reset_type_names () ; 750 let father = Name.father c.cl_name in 751 bs b ".I class "; 752 if c.cl_virtual then bs b "virtual "; 753 ( 754 match c.cl_type_parameters with 755 [] -> () 756 | l -> 757 bs b (Odoc_str.string_of_class_type_param_list l); 758 bs b " " 759 ); 760 bs b (Name.simple c.cl_name); 761 bs b " : " ; 762 self#man_of_class_type_expr b father c.cl_type; 763 bs b "\n.sp\n"; 764 self#man_of_info b c.cl_info; 765 bs b "\n.sp\n" 766 767 (** Print groff string for a class type. *) 768 method man_of_class_type b ct = 769 Odoc_info.reset_type_names () ; 770 bs b ".I class type "; 771 if ct.clt_virtual then bs b "virtual " ; 772 ( 773 match ct.clt_type_parameters with 774 [] -> () 775 | l -> 776 bs b (Odoc_str.string_of_class_type_param_list l); 777 bs b " " 778 ); 779 bs b (Name.simple ct.clt_name); 780 bs b " = " ; 781 self#man_of_class_type_expr b (Name.father ct.clt_name) ct.clt_type; 782 bs b "\n.sp\n"; 783 self#man_of_info b ct.clt_info; 784 bs b "\n.sp\n" 785 786 (** Print groff string for a module. *) 787 method man_of_module b m = 788 bs b ".I module "; 789 bs b (Name.simple m.m_name); 790 bs b " : "; 791 self#man_of_module_type b (Name.father m.m_name) m.m_type; 792 bs b "\n.sp\n"; 793 self#man_of_info b m.m_info; 794 bs b "\n.sp\n" 795 796 (** Print groff string for a module type. *) 797 method man_of_modtype b mt = 798 bs b ".I module type "; 799 bs b (Name.simple mt.mt_name); 800 bs b " = "; 801 (match mt.mt_type with 802 None -> () 803 | Some t -> 804 self#man_of_module_type b (Name.father mt.mt_name) t 805 ); 806 bs b "\n.sp\n"; 807 self#man_of_info b mt.mt_info; 808 bs b "\n.sp\n" 809 810 (** Print groff string for a module comment.*) 811 method man_of_module_comment b text = 812 bs b "\n.PP\n"; 813 self#man_of_text b [Code ("=== "^(Odoc_misc.string_of_text text)^" ===")]; 814 bs b "\n.PP\n" 815 816 (** Print groff string for a class comment.*) 817 method man_of_class_comment b text = 818 bs b "\n.PP\n"; 819 self#man_of_text b [Code ("=== "^(Odoc_misc.string_of_text text)^" ===")]; 820 bs b "\n.PP\n" 821 822 method man_of_recfield b modname f = 823 bs b ".I "; 824 if f.rf_mutable then bs b (Odoc_messages.mutab^" "); 825 bs b (f.rf_name^" : "); 826 self#man_of_type_expr b modname f.rf_type; 827 bs b "\n.sp\n"; 828 self#man_of_info b f.rf_text; 829 bs b "\n.sp\n" 830 831 method man_of_const b modname c = 832 bs b ".I "; 833 bs b (c.vc_name^" "); 834 (match c.vc_args with 835 | Cstr_tuple [] -> () 836 | Cstr_tuple (h::q) -> 837 bs b "of "; 838 self#man_of_type_expr b modname h; 839 List.iter 840 (fun ty -> 841 bs b " * "; 842 self#man_of_type_expr b modname ty) 843 q 844 | Cstr_record r -> self#man_of_record c.vc_name b r 845 ); 846 bs b "\n.sp\n"; 847 self#man_of_info b c.vc_text; 848 bs b "\n.sp\n" 849 850 (** Print groff string for an included module. *) 851 method man_of_included_module b m_name im = 852 bs b ".I include "; 853 ( 854 match im.im_module with 855 None -> bs b im.im_name 856 | Some mmt -> 857 let name = 858 match mmt with 859 Mod m -> m.m_name 860 | Modtype mt -> mt.mt_name 861 in 862 bs b (self#relative_idents m_name name) 863 ); 864 bs b "\n.sp\n"; 865 self#man_of_info b im.im_info; 866 bs b "\n.sp\n" 867 868 (** Generate the man page for the given class.*) 869 method generate_for_class cl = 870 Odoc_info.reset_type_names () ; 871 let file = self#file_name cl.cl_name in 872 try 873 let chanout = self#open_out file in 874 let b = new_buf () in 875 bs b (".TH \""^cl.cl_name^"\" "); 876 bs b !man_section ; 877 bs b (" source: "^Odoc_misc.current_date^" "); 878 bs b "OCamldoc "; 879 bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n"); 880 881 let abstract = 882 match cl.cl_info with 883 None | Some { i_desc = None } -> "no description" 884 | Some { i_desc = Some t } -> 885 let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in 886 self#remove_newlines s 887 in 888 889 bs b ".SH NAME\n"; 890 bs b (cl.cl_name^" \\- "^abstract^"\n"); 891 bs b (".SH "^Odoc_messages.clas^"\n"); 892 bs b (Odoc_messages.clas^" "^cl.cl_name^"\n"); 893 bs b (".SH "^Odoc_messages.documentation^"\n"); 894 bs b ".sp\n"; 895 self#man_of_class b cl; 896 897 (* parameters *) 898 self#man_of_parameter_list b "" cl.cl_parameters; 899 (* a large blank *) 900 bs b "\n.sp\n.sp\n"; 901 902(* 903 (* class inheritance *) 904 self#generate_class_inheritance_info chanout cl; 905*) 906 (* the various elements *) 907 List.iter 908 (fun element -> 909 match element with 910 Class_attribute a -> 911 self#man_of_attribute b a 912 | Class_method m -> 913 self#man_of_method b m 914 | Class_comment t -> 915 self#man_of_class_comment b t 916 ) 917 (Class.class_elements cl); 918 919 Buffer.output_buffer chanout b; 920 close_out chanout 921 with 922 Sys_error s -> 923 incr Odoc_info.errors ; 924 prerr_endline s 925 926 (** Generate the man page for the given class type.*) 927 method generate_for_class_type ct = 928 Odoc_info.reset_type_names () ; 929 let file = self#file_name ct.clt_name in 930 try 931 let chanout = self#open_out file in 932 let b = new_buf () in 933 bs b (".TH \""^ct.clt_name^"\" "); 934 bs b !man_section ; 935 bs b (" source: "^Odoc_misc.current_date^" "); 936 bs b "OCamldoc "; 937 bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n"); 938 939 let abstract = 940 match ct.clt_info with 941 None | Some { i_desc = None } -> "no description" 942 | Some { i_desc = Some t } -> 943 let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in 944 self#remove_newlines s 945 in 946 947 bs b ".SH NAME\n"; 948 bs b (ct.clt_name^" \\- "^abstract^"\n"); 949 bs b (".SH "^Odoc_messages.class_type^"\n"); 950 bs b (Odoc_messages.class_type^" "^ct.clt_name^"\n"); 951 bs b (".SH "^Odoc_messages.documentation^"\n"); 952 bs b ".sp\n"; 953 954 self#man_of_class_type b ct; 955 956 (* a large blank *) 957 bs b "\n.sp\n.sp\n"; 958(* 959 (* class inheritance *) 960 self#generate_class_inheritance_info chanout cl; 961*) 962 (* the various elements *) 963 List.iter 964 (fun element -> 965 match element with 966 Class_attribute a -> 967 self#man_of_attribute b a 968 | Class_method m -> 969 self#man_of_method b m 970 | Class_comment t -> 971 self#man_of_class_comment b t 972 ) 973 (Class.class_type_elements ct); 974 975 Buffer.output_buffer chanout b; 976 close_out chanout 977 with 978 Sys_error s -> 979 incr Odoc_info.errors ; 980 prerr_endline s 981 982 method man_of_module_type_body b mt = 983 self#man_of_info b mt.mt_info; 984 bs b "\n.sp\n"; 985 986 (* parameters for functors *) 987 self#man_of_module_parameter_list b "" (Module.module_type_parameters mt); 988 (* a large blank *) 989 bs b "\n.sp\n.sp\n"; 990 991 (* module elements *) 992 List.iter 993 (fun ele -> 994 match ele with 995 Element_module m -> 996 self#man_of_module b m 997 | Element_module_type mt -> 998 self#man_of_modtype b mt 999 | Element_included_module im -> 1000 self#man_of_included_module b mt.mt_name im 1001 | Element_class c -> 1002 self#man_of_class b c 1003 | Element_class_type ct -> 1004 self#man_of_class_type b ct 1005 | Element_value v -> 1006 self#man_of_value b v 1007 | Element_type_extension te -> 1008 self#man_of_type_extension b mt.mt_name te 1009 | Element_exception e -> 1010 self#man_of_exception b e 1011 | Element_type t -> 1012 self#man_of_type b t 1013 | Element_module_comment text -> 1014 self#man_of_module_comment b text 1015 ) 1016 (Module.module_type_elements mt); 1017 1018 (** Generate the man file for the given module type. 1019 @raise Failure if an error occurs.*) 1020 method generate_for_module_type mt = 1021 let file = self#file_name mt.mt_name in 1022 try 1023 let chanout = self#open_out file in 1024 let b = new_buf () in 1025 bs b (".TH \""^mt.mt_name^"\" "); 1026 bs b !man_section ; 1027 bs b (" source: "^Odoc_misc.current_date^" "); 1028 bs b "OCamldoc "; 1029 bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n"); 1030 1031 let abstract = 1032 match mt.mt_info with 1033 None | Some { i_desc = None } -> "no description" 1034 | Some { i_desc = Some t } -> 1035 let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in 1036 self#remove_newlines s 1037 in 1038 bs b ".SH NAME\n"; 1039 bs b (mt.mt_name^" \\- "^abstract^"\n"); 1040 bs b (".SH "^Odoc_messages.module_type^"\n"); 1041 bs b (Odoc_messages.module_type^" "^mt.mt_name^"\n"); 1042 bs b (".SH "^Odoc_messages.documentation^"\n"); 1043 bs b ".sp\n"; 1044 bs b (Odoc_messages.module_type^"\n"); 1045 bs b (".BI \""^(Name.simple mt.mt_name)^"\"\n"); 1046 bs b " = "; 1047 ( 1048 match mt.mt_type with 1049 None -> () 1050 | Some t -> 1051 self#man_of_module_type b (Name.father mt.mt_name) t 1052 ); 1053 bs b "\n.sp\n"; 1054 self#man_of_module_type_body b mt; 1055 1056 Buffer.output_buffer chanout b; 1057 close_out chanout 1058 1059 with 1060 Sys_error s -> 1061 incr Odoc_info.errors ; 1062 prerr_endline s 1063 1064 method man_of_module_body b m = 1065 self#man_of_info b m.m_info; 1066 bs b "\n.sp\n"; 1067 1068 (* parameters for functors *) 1069 self#man_of_module_parameter_list b "" (Module.module_parameters m); 1070 (* a large blank *) 1071 bs b "\n.sp\n.sp\n"; 1072 1073 (* module elements *) 1074 List.iter 1075 (fun ele -> 1076 match ele with 1077 Element_module m -> 1078 self#man_of_module b m 1079 | Element_module_type mt -> 1080 self#man_of_modtype b mt 1081 | Element_included_module im -> 1082 self#man_of_included_module b m.m_name im 1083 | Element_class c -> 1084 self#man_of_class b c 1085 | Element_class_type ct -> 1086 self#man_of_class_type b ct 1087 | Element_value v -> 1088 self#man_of_value b v 1089 | Element_type_extension te -> 1090 self#man_of_type_extension b m.m_name te 1091 | Element_exception e -> 1092 self#man_of_exception b e 1093 | Element_type t -> 1094 self#man_of_type b t 1095 | Element_module_comment text -> 1096 self#man_of_module_comment b text 1097 ) 1098 (Module.module_elements m); 1099 1100 (** Generate the man file for the given module. 1101 @raise Failure if an error occurs.*) 1102 method generate_for_module m = 1103 let file = self#file_name m.m_name in 1104 try 1105 let chanout = self#open_out file in 1106 let b = new_buf () in 1107 bs b (".TH \""^m.m_name^"\" "); 1108 bs b !man_section ; 1109 bs b (" source: "^Odoc_misc.current_date^" "); 1110 bs b "OCamldoc "; 1111 bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n"); 1112 1113 let abstract = 1114 match m.m_info with 1115 None | Some { i_desc = None } -> "no description" 1116 | Some { i_desc = Some t } -> 1117 let s = Odoc_info.string_of_text (Odoc_info.first_sentence_of_text t) in 1118 self#remove_newlines s 1119 in 1120 1121 bs b ".SH NAME\n"; 1122 bs b (m.m_name^" \\- "^abstract^"\n"); 1123 bs b (".SH "^Odoc_messages.modul^"\n"); 1124 bs b (Odoc_messages.modul^" "^m.m_name^"\n"); 1125 bs b (".SH "^Odoc_messages.documentation^"\n"); 1126 bs b ".sp\n"; 1127 bs b (Odoc_messages.modul^"\n"); 1128 bs b (".BI \""^(Name.simple m.m_name)^"\"\n"); 1129 bs b " : "; 1130 self#man_of_module_type b (Name.father m.m_name) m.m_type; 1131 bs b "\n.sp\n"; 1132 self#man_of_module_body b m; 1133 Buffer.output_buffer chanout b; 1134 close_out chanout 1135 1136 with 1137 Sys_error s -> 1138 raise (Failure s) 1139 1140 (** Create the groups of elements to generate pages for. *) 1141 method create_groups mini module_list = 1142 let name res_ele = 1143 match res_ele with 1144 Res_module m -> m.m_name 1145 | Res_module_type mt -> mt.mt_name 1146 | Res_class c -> c.cl_name 1147 | Res_class_type ct -> ct.clt_name 1148 | Res_value v -> Name.simple v.val_name 1149 | Res_type t -> Name.simple t.ty_name 1150 | Res_extension x -> Name.simple x.xt_name 1151 | Res_exception e -> Name.simple e.ex_name 1152 | Res_attribute a -> Name.simple a.att_value.val_name 1153 | Res_method m -> Name.simple m.met_value.val_name 1154 | Res_section _ -> assert false 1155 | Res_recfield (_,f) -> f.rf_name 1156 | Res_const (_,f) -> f.vc_name 1157 in 1158 let all_items_pre = Odoc_info.Search.search_by_name module_list (Str.regexp ".*") in 1159 let all_items = List.filter 1160 (fun r -> 1161 match r with 1162 Res_section _ -> false 1163 | Res_module _ | Res_module_type _ 1164 | Res_class _ | Res_class_type _ -> true 1165 | _ -> not mini 1166 ) 1167 all_items_pre 1168 in 1169 let sorted_items = List.sort (fun e1 -> fun e2 -> compare (name e1) (name e2)) all_items in 1170 let rec f acc1 acc2 l = 1171 match l with 1172 [] -> acc2 :: acc1 1173 | h :: q -> 1174 match acc2 with 1175 [] -> f acc1 [h] q 1176 | h2 :: _ -> 1177 if (name h) = (name h2) then 1178 if List.mem h acc2 then 1179 f acc1 acc2 q 1180 else 1181 f acc1 (acc2 @ [h]) q 1182 else 1183 f (acc2 :: acc1) [h] q 1184 in 1185 f [] [] sorted_items 1186 1187 (** Generate a man page for a group of elements with the same name. 1188 A group must not be empty.*) 1189 method generate_for_group l = 1190 let name = 1191 Name.simple 1192 ( 1193 match List.hd l with 1194 Res_module m -> m.m_name 1195 | Res_module_type mt -> mt.mt_name 1196 | Res_class c -> c.cl_name 1197 | Res_class_type ct -> ct.clt_name 1198 | Res_value v -> v.val_name 1199 | Res_type t -> t.ty_name 1200 | Res_extension x -> x.xt_name 1201 | Res_exception e -> e.ex_name 1202 | Res_attribute a -> a.att_value.val_name 1203 | Res_method m -> m.met_value.val_name 1204 | Res_section (s,_) -> s 1205 | Res_recfield (_,f) -> f.rf_name 1206 | Res_const (_,f) -> f.vc_name 1207 ) 1208 in 1209 let file = self#file_name name in 1210 try 1211 let chanout = self#open_out file in 1212 let b = new_buf () in 1213 bs b (".TH \""^name^"\" "); 1214 bs b !man_section ; 1215 bs b (" source: "^Odoc_misc.current_date^" "); 1216 bs b "OCamldoc "; 1217 bs b ("\""^(match !Global.title with Some t -> t | None -> "")^"\"\n"); 1218 bs b ".SH NAME\n"; 1219 bs b (name^" \\- all "^name^" elements\n\n"); 1220 1221 let f ele = 1222 match ele with 1223 Res_value v -> 1224 bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father v.val_name)^"\n"); 1225 self#man_of_value b v 1226 | Res_type t -> 1227 bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father t.ty_name)^"\n"); 1228 self#man_of_type b t 1229 | Res_extension x -> 1230 bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father x.xt_name)^"\n"); 1231 self#man_of_type_extension b (Name.father x.xt_name) x.xt_type_extension 1232 | Res_exception e -> 1233 bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father e.ex_name)^"\n"); 1234 self#man_of_exception b e 1235 | Res_attribute a -> 1236 bs b ("\n.SH "^Odoc_messages.clas^" "^(Name.father a.att_value.val_name)^"\n"); 1237 self#man_of_attribute b a 1238 | Res_method m -> 1239 bs b ("\n.SH "^Odoc_messages.clas^" "^(Name.father m.met_value.val_name)^"\n"); 1240 self#man_of_method b m 1241 | Res_class c -> 1242 bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father c.cl_name)^"\n"); 1243 self#man_of_class b c 1244 | Res_class_type ct -> 1245 bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father ct.clt_name)^"\n"); 1246 self#man_of_class_type b ct 1247 | Res_recfield (ty,f) -> 1248 bs b ("\n.SH Type "^(ty.ty_name)^"\n"); 1249 self#man_of_recfield b (Name.father ty.ty_name) f 1250 | Res_const (ty,c) -> 1251 bs b ("\n.SH Type "^(ty.ty_name)^"\n"); 1252 self#man_of_const b (Name.father ty.ty_name) c 1253 | Res_module m -> 1254 if Name.father m.m_name <> "" then 1255 begin 1256 bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father m.m_name)^"\n"); 1257 bs b (Odoc_messages.modul^"\n"); 1258 bs b (".BI \""^(Name.simple m.m_name)^"\"\n"); 1259 bs b " : "; 1260 self#man_of_module_type b (Name.father m.m_name) m.m_type; 1261 end 1262 else 1263 begin 1264 bs b ("\n.SH "^Odoc_messages.modul^" "^m.m_name^"\n"); 1265 bs b " : "; 1266 self#man_of_module_type b (Name.father m.m_name) m.m_type; 1267 end; 1268 bs b "\n.sp\n"; 1269 self#man_of_module_body b m 1270 1271 | Res_module_type mt -> 1272 bs b ("\n.SH "^Odoc_messages.modul^" "^(Name.father mt.mt_name)^"\n"); 1273 bs b (Odoc_messages.module_type^"\n"); 1274 bs b (".BI \""^(Name.simple mt.mt_name)^"\"\n"); 1275 bs b " = "; 1276 ( 1277 match mt.mt_type with 1278 None -> () 1279 | Some t -> 1280 self#man_of_module_type b (Name.father mt.mt_name) t 1281 ); 1282 bs b "\n.sp\n"; 1283 self#man_of_module_type_body b mt 1284 1285 | Res_section _ -> 1286 (* normaly, we cannot have modules here. *) 1287 () 1288 in 1289 List.iter f l; 1290 Buffer.output_buffer chanout b; 1291 close_out chanout 1292 with 1293 Sys_error s -> 1294 incr Odoc_info.errors ; 1295 prerr_endline s 1296 1297 (** Generate all the man pages from a module list. *) 1298 method generate module_list = 1299 let sorted_module_list = List.sort (fun m1 m2 -> compare m1.m_name m2.m_name) module_list in 1300 let groups = self#create_groups !man_mini sorted_module_list in 1301 let f group = 1302 match group with 1303 [] -> 1304 () 1305 | [Res_module m] -> self#generate_for_module m 1306 | [Res_module_type mt] -> self#generate_for_module_type mt 1307 | [Res_class cl] -> self#generate_for_class cl 1308 | [Res_class_type ct] -> self#generate_for_class_type ct 1309 | l -> self#generate_for_group l 1310 in 1311 List.iter f groups 1312 end 1313end 1314 1315module type Man_generator = module type of Generator 1316