pax_global_header00006660000000000000000000000064120367120740014514gustar00rootroot0000000000000052 comment=75c83250b7f2f9eb9e8993d24927865625c7f1a6 caml2html-1.4.3/000077500000000000000000000000001203671207400134045ustar00rootroot00000000000000caml2html-1.4.3/LICENSE000066400000000000000000000431311203671207400144130ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. caml2html-1.4.3/META000066400000000000000000000002611203671207400140540ustar00rootroot00000000000000name = "caml2html" version = "1.3.1" description = "Syntax highlighting for OCaml code" requires = "str unix" archive(byte) = "caml2html.cma" archive(native) = "caml2html.cmxa" caml2html-1.4.3/Makefile000066400000000000000000000107131203671207400150460ustar00rootroot00000000000000VERSION = 1.4.3 export VERSION ifndef PREFIX PREFIX = $(shell dirname $(shell dirname `which ocamlc`)) endif ifndef BINDIR BINDIR = $(PREFIX)/bin endif ifndef OCAMLC OCAMLC = ocamlc -w A endif ifndef OCAMLOPT OCAMLOPT = ocamlopt endif ifndef OCAMLLEX OCAMLLEX = ocamllex endif ifndef OCAMLDEP OCAMLDEP = ocamldep endif MODULES = hashtbl2 version annot tag plugin input output output_latex main OBJS = $(patsubst %, %.cmo, $(MODULES)) OBJS-NAT = $(patsubst %, %.cmx, $(MODULES)) .PHONY: default default: caml2html test ### GODI targets ### .PHONY: all opt install all: byte bytelib opt: caml2html optlib install: install -m 0755 caml2html $(BINDIR) || \ install -m 0755 caml2html.byte $(BINDIR)/caml2html test -f caml2html.cma -o -f caml2html.cmxa && $(MAKE) libinstall uninstall: rm -f $(BINDIR)/caml2html $(MAKE) libuninstall || true ### end of GODI targets ### .PHONY: pre byte test lib libinstall libuninstall \ bytelib optlib tidy clean dep archive pre: version.ml caml2html.mli caml2html.ml caml2html.mli: annot.mli plugin.mli input.mli \ output.mli output_latex.mli version.ml \ caml2html.mli.mlx camlmix -clean caml2html.mli.mlx -o caml2html.mli caml2html.ml: hashtbl2.mli hashtbl2.ml tag.ml annot.ml \ plugin.ml input.ml output.ml output_latex.ml caml2html.ml.mlx camlmix -clean caml2html.ml.mlx -o caml2html.ml version.ml: version.ml.mlx Makefile camlmix -clean version.ml.mlx -o version.ml byte: caml2html.byte test: rm -f caml2html_test.mli ocamlc -i caml2html_test.ml > caml2html_test.mli ocamlc -c caml2html_test.mli ocamlc -c -dtypes caml2html_test.ml ./caml2html -o caml2html_test.html \ caml2html_test.mli caml2html_test.ml caml2html_test2.ml \ -ln -ie7 \ -ext date:date \ -ext cat:cat \ -ext "rot13:tr '[a-z]' '[n-za-m]'" ./caml2html -o caml2html_self_test.html \ tag.ml annot.mli annot.ml plugin.mli plugin.ml \ input.mli input.mll output.mli output.ml \ output_latex.mli output_latex.ml \ main.ml \ -ln ./caml2html -latex -o caml2html_self_test.tex \ tag.ml annot.mli annot.ml plugin.mli plugin.ml \ input.mli input.mll output.mli output.ml \ output_latex.mli output_latex.ml \ main.ml \ -ln caml2html: $(OBJS-NAT) $(OCAMLOPT) -o caml2html str.cmxa unix.cmxa $(OBJS-NAT) caml2html.byte: $(OBJS) $(OCAMLC) -custom -o caml2html.byte str.cma unix.cma $(OBJS) lib: all bytelib optlib libinstall: ocamlfind install caml2html META caml2html.mli caml2html.cmi \ caml2html.*a libuninstall: ocamlfind remove caml2html bytelib: $(OBJS) caml2html.cmi caml2html.cmo $(OCAMLC) -a -o caml2html.cma caml2html.cmo optlib: $(OBJS-NAT) caml2html.cmi caml2html.cmx $(OCAMLOPT) -a -o caml2html.cmxa caml2html.cmx # remove everything that we don't want to include into the archive tidy: rm -f caml2html caml2html.byte \ *.cm[ixoa] *.cmxa *.a *.obj *.o *~ *.annot \ *.ml.html caml2html_test.html caml2html_self_test.html \ caml2html_self_test.tex # remove everything that is not a source file clean: tidy rm -f input.ml *.mlx.ml \ caml2html.ml caml2html.mli version.ml caml2html_test.mli \ caml2html.html caml2html-help dep: input.ml $(OCAMLDEP) hashtbl2.mli hashtbl2.ml version.ml annot.mli annot.ml \ tag.ml plugin.mli plugin.ml input.mli input.ml \ output.mli output.ml output_latex.mli output_latex.ml \ main.ml > depend .SUFFIXES: .mll .mly .ml .mli .cmi .cmo .cmx .mll.ml: $(OCAMLLEX) $< .mly.ml: $(OCAMLYACC) $< .mli.cmi: $(OCAMLC) -c $< .ml.cmo: $(OCAMLC) -dtypes -c $< .ml.cmx: $(OCAMLOPT) -dtypes -c $< -include depend input.ml: input.mll ################ Only for developers P = caml2html-$(VERSION) caml2html.html: caml2html caml2html.html.mlx ./caml2html -help > caml2html-help camlmix -o caml2html.html caml2html.html.mlx archive: pre opt test caml2html.html @echo "Making archive for version $(VERSION)" rm -rf /tmp/$(P) && \ cp -rp . /tmp/$(P) && \ cd /tmp/$(P) && $(MAKE) tidy && \ rm -f *~ caml2html*.tar* && \ cd .. && tar czf $(P).tar.gz $(P) && \ tar cjf $(P).tar.bz2 $(P) mv /tmp/$(P).tar.gz /tmp/$(P).tar.bz2 . cp $(P).tar.gz $(P).tar.bz2 $$WWW/ cp $(P).tar.gz $(P).tar.bz2 ../releases/ cd $$WWW/ && ln -sf $(P).tar.gz caml2html.tar.gz && \ ln -sf $(P).tar.bz2 caml2html.tar.bz2 cp caml2html.html $$WWW/caml2html-help.html cp README $$WWW/caml2html-readme.txt cp history.txt $$WWW/caml2html-history.txt cp version.ml $$WWW/caml2html-version.ml cp caml2html_test.ml $$WWW/ cp caml2html_test.html $$WWW/ touch -c $$WWW/caml2html.html.mlx caml2html-1.4.3/README.md000066400000000000000000000020361203671207400146640ustar00rootroot00000000000000Caml2html ========= Caml2html is a command-line tool that highlights the syntax of OCaml source code. Requirements ------------ Caml2html needs an OCaml compiler (>= 3.00) properly installed. GNU make is required for the compilation. Compiling --------- ```bash $ make # try "make byte" if make does not work ``` Compiling the library (optional): ```bash $ make lib # try "make bytelib" if it does not work ``` Installing the executable ------------------------- ``` $ make install ``` The program is installed in the `BINDIR` directory specified at the first line of the Makefile (`/usr/bin` by default), and is named `caml2html` (even for bytecode option). Uninstalling ------------ ``` $ make uninstall ``` How to run it ------------- Type `caml2html -help`, or have a look at the html documentation (`caml2html.html`). Authors and license ------------------- Caml2html was originally written by Sébastien Ailleret, and is now developed by Martin Jambon. It is distributed for free under a GPL license (see `LICENSE` file). caml2html-1.4.3/TODO000066400000000000000000000004631203671207400140770ustar00rootroot00000000000000- add a -s option which reads the code from the command line - add "mkdir -p" feature instead of just "mkdir" - bug in ocaml compiler (3.09.2): -dtypes option on input.mll creates an input.annot file where character counts are higher than what they should be. The number of lines is correct though. caml2html-1.4.3/annot.ml000066400000000000000000000203331203671207400150560ustar00rootroot00000000000000(* $Id$ *) open Printf open Scanf open Lexing type t = { start : position; stop : position; typ : string } type layer_info = { innermost : bool; outermost : bool } type tag = [ `Start of string | `Stop ] * (position * layer_info) let create_pos file line linechar char = { pos_fname = file; pos_lnum = line; pos_bol = linechar; pos_cnum = char } (* The format of .annot files provides the fields that are required by the standard Lexing.position type. That's convenient, however the pos_bol and pos_cnum are relative to the .ml file from which the information is extracted. This works if the source file is the .ml file, but if it has line directives indicating that the source is another file such as a .mll or .mly, the pos_fname and pos_lnum fields will correctly point to the source file, while the pos_bol and pos_cnum fields will point to the position in the .ml file, because line directives don't allow to retrieve this information. As a consequence, we must use the (line,char) positions and not absolute character position. *) let parse_type_data pos_line type_lines = sscanf pos_line "%S %i %i %i %S %i %i %i" (fun file1 line1 linechar1 char1 file2 line2 linechar2 char2 -> let pos1 = create_pos file1 line1 linechar1 char1 in let pos2 = create_pos file2 line2 linechar2 char2 in { start = pos1; stop = pos2; typ = String.concat "\n" type_lines }) (* Pervasives.compare is not guaranteed to work like this: *) let compare_arrays a b = let c = compare (Array.length a) (Array.length b) in if c <> 0 then c else let result = ref 0 in try for i = 0 to Array.length a - 1 do let c = compare a.(i) b.(i) in if c <> 0 then (result := c; raise Exit) done; !result with Exit -> !result let compare_tags (a, _) (b, _) = compare_arrays a b let print_pos pos = printf "%S %i %i %i\n" pos.pos_fname pos.pos_lnum pos.pos_bol pos.pos_cnum (* Generate a sequence of nested opening and closing tags. *) let tagify ~impl_file l = let info0 = { innermost = false; outermost = false } in let length x = x.stop.pos_cnum - x.start.pos_cnum in let tags = List.fold_left (fun l x -> if x.start.pos_fname <> impl_file || x.stop.pos_fname <> impl_file then l else let len = length x in let start = x.start in let stop = x.stop in let start_key = [| start.pos_lnum; start.pos_cnum - start.pos_bol; 1; -len |] in let stop_key = [| stop.pos_lnum; stop.pos_cnum - stop.pos_bol; -1; len |] in if compare_arrays start_key stop_key >= 0 then (* Bad tagging! *) (eprintf "Ignoring annotation: stop tag at or before start tag!\n%!"; l) else (start_key, (`Start x.typ, (x.start, info0))) :: (stop_key, (`Stop, (x.stop, info0))) :: l) [] l in List.map snd (List.sort compare_tags tags) (* We keep only a sequence of non-nested annotations. That's too bad, but it would have to be implemented in javascript and it's not so easy to implement something reliable. Without nesting, CSS with hover is sufficient, even in IE (but we must use elements). *) (* let rec remove_outer_tags = function ((_, `Start _) as a) :: ((_, `Stop) as b) :: l -> a :: b :: remove_outer_tags l | (_, `Start _) :: ((_, `Start _) :: _ as l) -> remove_outer_tags l | (_, `Stop) :: l -> remove_outer_tags l | [] -> [] | [(_, `Start _)] -> assert false let rec remove_inner_tags = function (_, `Start _) as start :: l -> let stop, rest = skip_tag_sequence 1 l in start :: stop :: remove_inner_tags rest | (_, `Stop) :: _ -> assert false | [] -> [] and skip_tag_sequence n = function (_, `Start _) :: l -> skip_tag_sequence (n+1) l | ((_, `Stop) as stop) :: l -> let n = n - 1 in if n = 0 then stop, l else skip_tag_sequence n l | [] -> assert false *) let set_innermost (tag, (pos, x)) = (tag, (pos, { x with innermost = true })) let set_outermost (tag, (pos, x)) = (tag, (pos, { x with outermost = true })) let rec mark_innermost = function ((`Start _, _) as a) :: ((`Stop, _) as b) :: l -> set_innermost a :: set_innermost b :: mark_innermost l | ((`Start _, _) as a) :: ((`Start _, _) :: _ as l) -> a :: mark_innermost l | ((`Stop, _) as a) :: l -> a :: mark_innermost l | [] -> [] | [(`Start _, _)] -> invalid_arg "Annot.mark_innermost" let rec mark_outermost = function (`Start _, _) as start :: l -> set_outermost start :: skip_tag_sequence 1 l | (`Stop, _) :: _ -> invalid_arg "Annot.mark_outermost" | [] -> [] and skip_tag_sequence n = function ((`Start _, _) as start) :: l -> start :: skip_tag_sequence (n+1) l | ((`Stop, _) as stop) :: l -> let n = n - 1 in if n = 0 then set_outermost stop :: mark_outermost l else stop :: skip_tag_sequence n l | [] -> invalid_arg "Annot.skip_tag_sequence" let set_layer_info l = mark_outermost (mark_innermost l) (* let z = { innermost = false; outermost = false };; let start x = (`Start x, (x, z));; let stop x = (`Stop, (x, z));; let l = [ start 1; stop 1; start 2; start 3; start 4; stop 4; stop 3; stop 2 ];; mark_outermost (mark_innermost l);; *) type filter = [ `All | `Innermost | `Outermost ] let is_field s = try for i = 0 to String.length s - 2 do match s.[i] with 'a'..'z' -> () | _ -> raise Exit done; if s = "" || s.[String.length s - 1] <> '(' then raise Exit; true with Exit -> false let is_data s = String.length s >= 2 && s.[0] = ' ' && s.[1] = ' ' let string_of_line = function `Loc s -> s | `Type -> "type(" | `Close -> ")" | `Data s -> s | `Field s -> s | `Other s -> s | `Empty -> "" let string_of_line2 = function `Loc s -> "L " ^ s | `Type -> "T " ^ "type(" | `Close -> "C " ^ ")" | `Data s -> "D " ^ s | `Field s -> "F " ^ s | `Other s -> "O " ^ s | `Empty -> "E " ^ "" let classify_line s = if s = "" then `Other s else if s.[0] = '"' then `Loc s else if s = "type(" then `Type else if s = ")" then `Close else if is_data s then `Data s else if is_field s then `Field s else `Other s let preparse_file annot_file = let ic = open_in annot_file in let l = ref [] in try while true do l := classify_line (input_line ic) :: !l done; assert false with End_of_file -> close_in ic; List.rev !l (* impl_file is the file that we want to annotate and annot_file if the file that contains the annotation information. Usually impl_file is a .ml, but it may be a .mll or .mly file. Annotation files normally end in .annot and are produced by ocamlc or ocamlopt when -dtypes is specified. Only annotations that refer to impl_file are selected. *) let parse ~impl_file ~annot_file = let rec field_loop accu l = match l with `Close :: l -> (List.rev accu, l) | `Data s :: l -> field_loop (s :: accu) l | [] -> failwith "unexpected end of file" | l -> (List.rev accu, l) in let rec body_loop type_data l = match l with `Type :: l -> let data, rem = field_loop [] l in if rem == l then type_data, l else body_loop (Some data) rem | `Field _ :: l -> let data, rem = field_loop [] l in if rem == l then type_data, l else body_loop type_data rem | l -> type_data, l in let rec main_loop accu l = match l with `Loc loc_s :: l -> let type_data, l = body_loop None l in let accu = match type_data with None -> accu | Some data_lines -> parse_type_data loc_s data_lines :: accu in main_loop accu l | `Empty :: l -> main_loop accu l | [] -> List.rev accu | x :: _ -> failwith (sprintf "junk found in annot file %S: %S" annot_file (string_of_line x)) in let l = preparse_file annot_file in (*List.iter (fun x -> print_endline (string_of_line2 x)) l;*) let l = main_loop [] l in set_layer_info (tagify ~impl_file l) let guess_annot_file file = try let name = Filename.chop_extension file ^ ".annot" in if Sys.file_exists name then Some name else None with _ -> None (* impl_file is the file to annotate. See parse function above. *) let from_file ~impl_file ~annot_file : tag list option = if Sys.file_exists annot_file then Some (parse ~impl_file ~annot_file) else None caml2html-1.4.3/annot.mli000066400000000000000000000006021203671207400152240ustar00rootroot00000000000000(* $Id$ *) type layer_info = { innermost : bool; outermost : bool } type tag = [ `Start of string | `Stop ] * (Lexing.position * layer_info) type filter = [ `All | `Innermost | `Outermost ] val parse : impl_file:string -> annot_file:string -> tag list val guess_annot_file : string -> string option val from_file : impl_file:string -> annot_file:string -> tag list option caml2html-1.4.3/caml2html.html.mlx000066400000000000000000000046441203671207400167640ustar00rootroot00000000000000## #use "topfind";; #camlp4o;; #require "netstring";; #require "mikmatch_pcre";; open Mikmatch;; .## How to use Caml2html

How to use Caml2html

More information about Caml2html here.

Usage

##= Netencoding.Html.encode 
      ~in_enc:`Enc_iso88591 
      ~out_enc:`Enc_iso88591 () 
      (Text.file_contents "caml2html-help") .##

Examples

Process a single file code.ml: 

caml2html code.ml

Same thing with a title for the page: 

caml2html -t code.ml

Process a file with a title and line numbers: 

caml2html -t -ln code.ml

Process a file with a title, line numbers and replace tabs by 4 spaces: 

caml2html -t -ln -tab 4 code.ml

Process a file without footnotes (the most simple output): 

caml2html -nf code.ml

Process a file and use a css (style.css): 

caml2html -css code.ml

Process a file and use a specific css (http://blabla.com/style2.css): 

caml2html -css -cssurl http://blabla.com/style2.css code.ml

Read from stdin and output to stdout: 

caml2html

Process many files into a single file: 

caml2html -o result.html *.mli *.ml

Process many files, and create one HTML page for each file: 

caml2html *.ml

Same thing, but write result in the html directory: 

caml2html -d html *.ml

Same thing, but write result in the html directory: 

caml2html -d html *.ml

You can specify the character encoding with the -charset option: 

caml2html -charset euc-jp input.ml -o output.html

You can write the comments in HTML. This lets you add simple formatting such as hyperlinks. Beware that one HTML tag cannot span over several lines, and that the characters <, > and & must be written as &lt;, &gt; and &amp;. 

(* This is file1.ml.
   <a href="#file2.ml">This is a link to file2.ml</a>. *)
...

In this case, use the -hc option: 

caml2html -hc file1.ml file2.ml -o result.html

This document was not generated by caml2html! caml2html-1.4.3/caml2html.ml.mlx000066400000000000000000000013651203671207400164250ustar00rootroot00000000000000##= "(* Generated by camlmix. *) (* Do not edit! *)" (* yes you can *) ## module Version = struct ## @include "version.ml" ## end module Hashtbl2 : sig ## @include "hashtbl2.mli" ## end = struct ## @include "hashtbl2.ml" ## end module Annot : sig ## @include "annot.mli" ## end = struct ## @include "annot.ml" ## end module Tag = struct ## @include "tag.ml" ## end module Plugin : sig ## @include "plugin.mli" ## end = struct ## @include "plugin.ml" ## end module Input : sig ## @include "input.mli" ## end = struct ## @include "input.ml" ## end module Output : sig ## @include "output.mli" ## end = struct ## @include "output.ml" ## end module Output_latex : sig ## @include "output_latex.mli" ## end = struct ## @include "output_latex.ml" ## end caml2html-1.4.3/caml2html.mli.mlx000066400000000000000000000005271203671207400165750ustar00rootroot00000000000000## print_string "(* Generated by camlmix. *) (* Do not edit! *)" ## module Annot : sig ## @include "annot.mli" ## end module Plugin : sig ## @include "plugin.mli" ## end module Input : sig ## @include "input.mli" ## end module Output : sig ## @include "output.mli" ## end module Output_latex : sig ## @include "output_latex.mli" ## end caml2html-1.4.3/caml2html_test.ml000066400000000000000000000022651203671207400166650ustar00rootroot00000000000000 (* Test file for caml2html (the first line is empty) *) (* -hc option: link to caml2html_test.mli (same page, colorized) * link to caml2html_test.ml (source) *) (* This is a multi-line "*)" comment *) open Printf type 'aa' weird = E10 type t = [ `A | `b of int | ` C | ` (* *) D | ` E ] (* nested (* comments *) *) (* "multi- line string in comment" *) (*html

Hello

This is HTML!

*) (*date*) (*rot13 Caml2html rules! "*)" *) (*foo*) module Zéro'04 = struct let characters = [ 'a'; '\000'; '\x12'; ' '; '\t'; 'z' ] let n = 0X12 + truncate 1.2E-1_2 let the_Truth = let ignore4 a b c d = false in not (ignore4 1._0_None 1.0E10E10) end let hel'Lo = "\"Hello \ World!\"" let ( |* ) a b = match a, b with 1, 0 | 0, 1 -> 1+1 | _ -> 0 let _ = assert true; if 0 mod 1 < 1 && `Abc <> `def then print_endline hel'Lo ;; (* long types *) let t x = (x, x) let a x = t (t x) let b x = a (a x) let _ = fun x -> b (b x) ;; # 123 (* line directives are not parsed, sorry... *) caml2html-1.4.3/caml2html_test2.ml000066400000000000000000000010331203671207400167370ustar00rootroot00000000000000let add_operator ~name ~level ~value = EXTEND Pcaml.expr: LEVEL $level$ [ [ x = SELF; $name$; y = SELF -> <:expr< $value$ $x$ $y$ >> ] ]; END EXTEND Pcaml.str_item: [ [ "OPERATOR"; name = STRING; "LEVEL"; level = STRING; "VALUE"; value = Pcaml.expr; "END" -> add_operator ~name:(Token.eval_string _loc name) ~level:(Token.eval_string _loc level) ~value; <:str_item< declare end >> ] ]; END let expand _loc e = <:expr< 1 + $e$ >> caml2html-1.4.3/caml2html_test2.mli000066400000000000000000000001761203671207400171170ustar00rootroot00000000000000val add_operator : name:string -> level:string -> value:MLast.expr -> unit val expand : MLast.loc -> MLast.expr -> MLast.expr caml2html-1.4.3/depend000066400000000000000000000013741203671207400145730ustar00rootroot00000000000000hashtbl2.cmi: hashtbl2.cmo: hashtbl2.cmi hashtbl2.cmx: hashtbl2.cmi annot.cmi: annot.cmo: annot.cmi annot.cmx: annot.cmi tag.cmo: tag.cmx: plugin.cmi: plugin.cmo: plugin.cmi plugin.cmx: plugin.cmi input.cmi: annot.cmi input.cmo: tag.cmo plugin.cmi annot.cmi input.cmi input.cmx: tag.cmx plugin.cmx annot.cmx input.cmi output.cmi: input.cmi annot.cmi output.cmo: plugin.cmi input.cmi hashtbl2.cmi annot.cmi output.cmi output.cmx: plugin.cmx input.cmx hashtbl2.cmx annot.cmx output.cmi output_latex.cmi: input.cmi output_latex.cmo: plugin.cmi input.cmi output_latex.cmi output_latex.cmx: plugin.cmx input.cmx output_latex.cmi main.cmo: plugin.cmi output_latex.cmi output.cmi input.cmi main.cmx: plugin.cmx output_latex.cmx output.cmx input.cmx caml2html-1.4.3/hashtbl2.ml000066400000000000000000000036161203671207400154530ustar00rootroot00000000000000type ('a, 'b) t = ('a, 'b list ref) Hashtbl.t let create n = Hashtbl.create n let clear = Hashtbl.clear let add tbl key data = let r = try Hashtbl.find tbl key with Not_found -> let r = ref [] in Hashtbl.add tbl key r; r in r := data :: !r let copy tbl = let tbl2 = Hashtbl.copy tbl in Hashtbl.iter (fun key r -> Hashtbl.replace tbl2 key (ref !r)) tbl; tbl2 let find tbl key = List.hd !(Hashtbl.find tbl key) let find_all tbl key = !(Hashtbl.find tbl key) let mem = Hashtbl.mem let remove tbl key = try let r = Hashtbl.find tbl key in match !r with [data] -> Hashtbl.remove tbl key | hd :: tl -> r := tl | [] -> invalid_arg "remove" with Not_found -> () let remove_all = Hashtbl.remove let replace tbl key data = try let r = Hashtbl.find tbl key in r := data :: (List.tl !r) with Not_found -> Hashtbl.add tbl key (ref [data]) let replace_all tbl key l = try let r = Hashtbl.find tbl key in r := l with Not_found -> Hashtbl.add tbl key (ref l) let iter f tbl = Hashtbl.iter (fun key r -> f key (List.hd !r)) tbl let iter_all f tbl = Hashtbl.iter (fun key r -> f key !r) tbl let fold f tbl init = Hashtbl.fold (fun key r accu -> f key (List.hd !r) accu) tbl init let fold_all f tbl init = Hashtbl.fold (fun key r accu -> f key !r accu) tbl init let list_keys tbl = fold (fun key _ accu -> key :: accu) tbl [] let list_values tbl = fold (fun _ data accu -> data :: accu) tbl [] let list_all_values tbl = fold_all (fun _ l accu -> l :: accu) tbl [] let list tbl = fold (fun key data accu -> (key, data) :: accu) tbl [] let list_all tbl = fold_all (fun key l accu -> (key, l) :: accu) tbl [] let of_list n l = let tbl = create n in List.iter (fun (key, data) -> add tbl key data) l; tbl let of_keys n l = let tbl = create n in List.iter (fun key -> replace tbl key ()) l; tbl caml2html-1.4.3/hashtbl2.mli000066400000000000000000000140151203671207400156170ustar00rootroot00000000000000(** This module provides a kind of hash tables where each key is present only once in the table, as opposed to the naive usage of the standard [Hashtbl] module. Its main purpose is to provide efficient implementation of functions such as [list_keys] with enhanced safety over the direct use of an [('a, 'b list ref) Hashtbl.t] type. Many functions have two variants: - the first one is applied only on the current bindings, like [iter]. - the second one has the [_all] suffix like [iter_all] and is applied to the list of all the values that are bound to the given key instead of only to the topmost value. This list of values is prebuilt, so there is no cost for building the list when such a function is applied. Example - clustering elements: [Hashtbl2.list_all (Hashtbl2.of_list 10 [ (1, "a"); (2, "b"); (1, "c") ])] returns [[(2, ["b"]); (1, ["c"; "a"])]]. [Hashtbl2] is an additional layer over the standard [Hashtbl] module. @author Martin Jambon *) type ('a, 'b) t (** The type of hash tables from type ['a] to type ['b]. This representation is suitable for clustering elements according to the given keys. *) val create : int -> ('a, 'b) t (** [Hashtbl2.create n] creates a new, empty hash table, with initial size [n]. For best results, [n] should be on the order of the expected number of elements that will be in the table. The table grows as needed, so [n] is just an initial guess. *) val clear : ('a, 'b) t -> unit (** Empty a hash table. *) val add : ('a, 'b) t -> 'a -> 'b -> unit (** [Hashtbl2.add tbl x y] adds a binding of [x] to [y] in table [tbl]. Previous bindings for [x] are not removed, but simply hidden. That is, after performing {!Hashtbl2.remove}[ tbl x], the previous binding for [x], if any, is restored. (Same behavior as with association lists.) *) val copy : ('a, 'b) t -> ('a, 'b) t (** Return a copy of the given hashtable. *) val find : ('a, 'b) t -> 'a -> 'b (** [Hashtbl2.find tbl x] returns the current binding of [x] in [tbl], or raises [Not_found] if no such binding exists. *) val find_all : ('a, 'b) t -> 'a -> 'b list (** [Hashtbl2.find_all tbl x] returns the list of all data associated with [x] in [tbl]. The current binding is returned first, then the previous bindings, in reverse order of introduction in the table. *) val mem : ('a, 'b) t -> 'a -> bool (** [Hashtbl2.mem tbl x] checks if [x] is bound in [tbl]. *) val remove : ('a, 'b) t -> 'a -> unit (** [Hashtbl2.remove tbl x] removes the current binding of [x] in [tbl], restoring the previous binding if it exists. It does nothing if [x] is not bound in [tbl]. *) val remove_all : ('a, 'b) t -> 'a -> unit (** [Hashtbl2.remove_all tbl x] removes all bindings of [x] in [tbl]. It does nothing if [x] is not bound in [tbl]. *) val replace : ('a, 'b) t -> 'a -> 'b -> unit (** [Hashtbl2.replace tbl x y] replaces the current binding of [x] in [tbl] by a binding of [x] to [y]. If [x] is unbound in [tbl], a binding of [x] to [y] is added to [tbl]. This is functionally equivalent to {!Hashtbl2.remove}[ tbl x] followed by {!Hashtbl2.add}[ tbl x y]. *) val replace_all : ('a, 'b) t -> 'a -> 'b list -> unit (** [Hashtbl2.replace_all tbl x y] replaces all bindings of [x] in [tbl] by bindings of [x] to the elements of [y]. The first element of [y] defines the current binding, the second element is the defined the previous binding, and so on. *) val iter : ('a -> 'b -> unit) -> ('a, 'b) t -> unit (** [Hashtbl2.iter f tbl] applies [f] to current bindings in table [tbl]. [f] receives the key as first argument, and the associated value as second argument. Each current binding is presented exactly once to [f]. Hidden bindings are ignored. The order in which the bindings are passed to [f] is unspecified. *) val iter_all : ('a -> 'b list -> unit) -> ('a, 'b) t -> unit (** [Hashtbl2.iter_all f tbl] applies [f] to all bindings in table [tbl]. [f] receives the key as first argument, and all the associated values as second argument in reverse order of introduction in the table. The order in which the bindings are passed to [f] is unspecified. *) val fold : ('a -> 'b -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c (** [Hashtbl2.fold f tbl init] computes [(f kN dN ... (f k1 d1 init)...)], where [k1 ... kN] are the keys of current bindings in [tbl], and [d1 ... dN] are the associated values. Each current binding is presented exactly once to [f]. Hidden bindings are ignored. *) val fold_all : ('a -> 'b list -> 'c -> 'c) -> ('a, 'b) t -> 'c -> 'c (** [Hashtbl2.fold_all f tbl init] computes [(f kN lN ... (f k1 l1 init)...)], where [k1 ... kN] are the keys of all bindings in [tbl], and [l1 ... lN] are the lists of associated values, in reverse order of introduction in the table. *) val list_keys : ('a, 'b) t -> 'a list (** [Hashtbl2.list_keys tbl] returns a list of all the keys from the current bindings. Therefore no key is duplicated. Order is unspecified. *) val list_values : ('a, 'b) t -> 'b list (** [Hashtbl2.list_values tbl] returns a list of all the values from the current bindings. Hidden bindings are ignored. Order is unspecified. *) val list_all_values : ('a, 'b) t -> 'b list list (** [Hashtbl2.list_all_values tbl] returns a list of all the values from all bindings. Order is unspecified. *) val list : ('a, 'b) t -> ('a * 'b) list (** [Hashtbl2.list tbl] returns a list of the current bindings. Order is unspecified. *) val list_all : ('a, 'b) t -> ('a * 'b list) list (** [Hashtbl2.list_all tbl] returns a list of all the bindings clustered according to their key. Order is unspecified. *) val of_list : int -> ('a * 'b) list -> ('a, 'b) t (** [Hashtbl2.of_list n l] converts a list of bindings into a hash table of initial size [n]. The ordering of the list is the order of introduction of the bindings in the table. *) val of_keys : int -> 'a list -> ('a, unit) t (** [Hashtbl2.of_keys n l] converts a list of elements into a hash table of initial size [n] containing unique copies of these elements bound at most one time to [()]. *) caml2html-1.4.3/history.txt000066400000000000000000000047111203671207400156510ustar00rootroot00000000000000************** v1.4 *************** For more recent changes, see the git history at: https://github.com/mjambon/caml2html/commits/master 2012-01-03: release 1.4.2 - fix: no more extra newline occurring before special comments 2010-08-02: release 1.4.1 - added the previously missing module Output_latex to the library 2010-06-28: release 1.4.0 - added -latex output mode and -make-latex-defs - added -body option ************** v1.3 *************** 2009-08-13: release 1.3.2 - added support for the extended format of annot files created by ocaml 3.11 release 1.3.1: - new -ext option for defining custom comment handlers. - hardcoded "(*html" handler that for raw HTML. 2007-02-11: release 1.3.0: - type of expressions is now displayed when the mouses passes over them. It uses .annot files produced by the -dtypes options of ocamlc/ocamlopt. - camlp4 quotations are now recognized as such - bugfix: fixed -d option which didn't work. - -d now creates the directory if it doesn't exist ************** v1.2 *************** (Martin Jambon) 2006-03-02: release 1.2.4 2006-02-06: fixed bad color of multiline strings in comments 2005-10-20: 1.2.3 added GODI/GODIVA-compliant targets in Makefile 2005-05-08: 1.2.2 fixed bug concerning nested comments 2005-03-26: version 1.2.1 - added option -charset - added option -hc (HTML comments) 2004-11-16: - release of version 1.2.0 including the library, on Martin's website - many changes everywhere: * new names for the modules, library functions, .mli files for the library * bugfixes in the tokenizer, failsafe execution * production of W3C-compliant HTML * tabs are now replaced by 8 spaces by default * created test.ml for (extreme!) testing 2004-05-15: - smaller HTML output 2004-05-04: - added targets libinstall/libunistall ************** v1.1 *************** (Sébastien Ailleret) 2002-11-25: - fix small bugs and enhance documentation 2002-11-19: - new way of managing input and output 2002-11-18: - replace '<', '>' and '&' in order to avoid conflict with html 2002-11-17: - add css support (option -css and -cssurl) 2002-11-15: - user Buffer in the output in order to avoid to many string concat - add html head information (title...) and optional footnotes 2002-11-14: - can replace tabs by spaces 2002-11-13: - lexer performances improvements ************** v1.0 *************** (Sébastien Ailleret) 2002-11-06: - first public release caml2html-1.4.3/input.mli000066400000000000000000000030221203671207400152430ustar00rootroot00000000000000(* Copyright 2004 Martin Jambon This file is distributed under the terms of the GNU Public License http://www.gnu.org/licenses/gpl.txt *) (* This module provides functions that parse OCaml source code and return a list of tokens which are suitable for automatic syntax highlighting. Any input is accepted. Only a lexical analysis is performed and thus can be used to highlight incorrect programs as well as derivatives of OCaml (.ml .mli .mll .mly). *) type token = [ `Comment of string (** a (fragment of) comment *) | `Special_comment of string * string (** (handler name, full comment) *) | `Construct of string (** an uppercase identifier or an identifier starting with ` *) | `Keyword of string (** a keyword *) | `Newline (** a newline character *) | `String of string (** a (fragment of) string or character literal *) | `Quotation of string (** a camlp4 quotation *) | `Tab (** a tabulation character *) | `Token of string (** anything else *) | `Start_annot of (Annot.layer_info * string) (** start of a type annotation read from .annot file *) | `Stop_annot of Annot.layer_info ] (** end of a type annotation read from .annot file *) val parse : ?annot:Annot.tag list -> Lexing.lexbuf -> token list val string : ?filename:string -> ?annot:Annot.tag list -> string -> token list val channel : ?filename:string -> ?annot:Annot.tag list -> in_channel -> token list val file : ?annot:Annot.tag list -> string -> token list caml2html-1.4.3/input.mll000066400000000000000000000255741203671207400152660ustar00rootroot00000000000000(* $Id$ *) { (* Copyright 2002-2004 Sebastien Ailleret Copyright 2004-2006 Martin Jambon This file is distributed under the terms of the GNU Public License http://www.gnu.org/licenses/gpl.txt *) open Printf open Lexing type token = [ `Comment of string | `Special_comment of string * string | `Construct of string | `Keyword of string | `Newline | `String of string | `Quotation of string | `Tab | `Token of string | `Start_annot of (Annot.layer_info * string) | `Stop_annot of Annot.layer_info ] type state = { mutable depth : int; buf : Buffer.t; lexbuf : lexbuf; mutable tokens : token list; mutable annot_tags : Annot.tag list; mutable in_group : bool } let init_state annot_tags lexbuf = { depth = 0; buf = Buffer.create 1000; lexbuf = lexbuf; tokens = []; annot_tags = annot_tags; in_group = false } let stringpair_of_token = function `Comment s -> "Comment", s | `Construct s -> "Construct", s | `Keyword s -> "Keyword", s | `Newline -> "Newline", "" | `String s -> "String", s | `Quotation s -> "Quotation", s | `Tab -> "Tab", "" | `Token s -> "Token", s | `Start_annot (_info, s) -> "Start_annot", s | `Stop_annot _info -> "Stop_annot", "" let string_of_token x = match stringpair_of_token x with a, "" -> a | a, b -> sprintf "%s %S" a b let print_tokens l = List.iter (fun s -> printf "%s\n" (string_of_token s)) l let keywords = [ "and"; "as"; "asr"; "assert"; "begin"; "class"; "constraint"; "do"; "done"; "downto"; "else"; "end"; "exception"; "external"; "false"; "for"; "fun"; "function"; "functor"; "if"; "in"; "include"; "inherit"; "initializer"; "land"; "lazy"; "let"; "lor"; "lsl"; "lsr"; "lxor"; "match"; "method"; "mod"; "module"; "mutable"; "new"; "object"; "of"; "open"; "or"; "private"; "rec"; "sig"; "struct"; "then"; "to"; "true"; "try"; "type"; "val"; "virtual"; "when"; "while"; "with" ] let is_keyword = let tbl = Hashtbl.create 100 in List.iter (fun key -> Hashtbl.add tbl key ()) keywords; Hashtbl.mem tbl let tokenify s = if is_keyword s then `Keyword s else `Token s let init_lexbuf lexbuf filename = let pos = lexbuf.lex_curr_p in lexbuf.lex_curr_p <- { pos with pos_fname = filename } let compare_pos a b = let c = compare a.pos_lnum b.pos_lnum in if c <> 0 then c else compare (a.pos_cnum - a.pos_bol) (b.pos_cnum - b.pos_bol) (* Consume the list of annotations *) let get_annot state cur_pos = let rec loop () = match state.annot_tags with [] -> [] | ((_, (tag_pos, _)) as tag) :: tl -> if compare_pos tag_pos cur_pos <= 0 then (state.annot_tags <- tl; tag :: loop ()) else [] in loop () let simple_annot x = match x with (`Start typ, (_, info)) -> `Start_annot (info, typ) | (`Stop, (_, info)) -> `Stop_annot info let simple_annots = List.map simple_annot (* Add all unclosed tags that may remain *) let finish_annot state = state.tokens <- (List.rev_map simple_annot state.annot_tags) @ state.tokens; state.annot_tags <- [] let newline state = let lexbuf = state.lexbuf in let pos = lexbuf.lex_curr_p in lexbuf.lex_curr_p <- { pos with pos_lnum = pos.pos_lnum + 1; pos_bol = pos.pos_cnum } let shift x pos = { pos with pos_cnum = pos.pos_cnum + x } let begin_group state = state.in_group <- true let end_group state = state.in_group <- false let add_token ?(offset = 0) state x = if x = `Newline then newline state; let annot1, annot2 = if not state.in_group then let annot1 = get_annot state (shift offset (lexeme_start_p state.lexbuf)) in let annot2 = get_annot state (shift offset (lexeme_end_p state.lexbuf)) in annot1, annot2 else [], [] in state.tokens <- (List.rev_append (simple_annots annot2) (x :: (List.rev_append (simple_annots annot1) state.tokens))) let return_tokens state = let l = List.rev state.tokens in let tagged = List.map (function `Start_annot _ as x -> (Tag.Start, x) | `Stop_annot _ as x -> (Tag.Stop, x) | x -> (Tag.Other, x)) l in let annotate b x = if not b then x else match x with `Start_annot (info, typ) -> `Start_annot ({ info with Annot.innermost = true }, typ) | `Stop_annot info -> `Stop_annot { info with Annot.innermost = true } | _ -> assert false in let l = Tag.annotate_innermost annotate (Tag.remove_matches tagged) in let result = List.map snd l in result } let upper = ['A'-'Z' '\192'-'\214' '\216'-'\222'] let lower = ['a'-'z' '\223'-'\246' '\248'-'\255'] let digit = ['0'-'9'] let identchar = upper | lower | digit | ['_' '\''] let hex = ['0'-'9' 'a'-'f' 'A'-'F'] let oct = ['0'-'7'] let bin = ['0'-'1'] let operator_char = [ '!' '$' '%' '&' '*' '+' '-' '.' '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] let infix_symbol = ['=' '<' '>' '@' '^' '|' '&' '+' '-' '*' '/' '$' '%'] operator_char* let prefix_symbol = ['!' '?' '~'] operator_char* let lident = (lower | '_' identchar) identchar* let uident = upper identchar* let blank = [ ' ' '\t' ] let space = [ ' ' '\t' '\r' '\n' ] rule token state = parse | "(*" (lident as handler_name)? { begin_group state; Buffer.clear state.buf; state.depth <- 1; (match handler_name with Some name when Plugin.exists name -> comment true state lexbuf; let s = Buffer.contents state.buf in let n = Plugin.count_newlines s in (for i = 1 to n do newline state done); add_token state (`Special_comment (name, s)) | None | Some _ -> Buffer.add_string state.buf "(*"; (match handler_name with Some name -> Buffer.add_string state.buf name | None -> ()); comment false state lexbuf; Buffer.add_string state.buf "*)"; add_token state (`Comment (Buffer.contents state.buf)); ); end_group state; token state lexbuf } | '"' { begin_group state; Buffer.clear state.buf; Buffer.add_char state.buf '"'; string state false lexbuf; add_token state (`String (Buffer.contents state.buf)); end_group state; token state lexbuf } | "<<" | "<:" lident "<" { begin_group state; add_token state (`Construct (lexeme lexbuf)); Buffer.clear state.buf; quotation state lexbuf; add_token ~offset:(-2) state (`Quotation (Buffer.contents state.buf)); add_token state (`Construct ">>"); end_group state; token state lexbuf } | '`' | uident { add_token state (`Construct (lexeme lexbuf)); token state lexbuf } | lident { add_token state (tokenify (lexeme lexbuf)); token state lexbuf } | "!=" | "#" | "&" | "&&" | "(" | ")" | "*" | "+" | "," | "-" | "-." | "->" | "." | ".. :" | "::" | ":=" | ":>" | ";" | ";;" | "<" | "<-" | "=" | ">" | ">]" | ">}" | "?" | "??" | "[" | "[<" | "[>" | "[|" | "]" | "_" | "`" | "{" | "{<" | "|" | "|]" | "}" | "~" { add_token state (`Keyword (lexeme lexbuf)); token state lexbuf } | prefix_symbol | infix_symbol { add_token state (`Token (lexeme lexbuf)); token state lexbuf } | "'\n'" | "'\r\n'" { List.iter (add_token state) [`String "'"; `Newline; `String "'"]; token state lexbuf } | "'\\\n'" | "'\\\r\n'" { List.iter (add_token state) [`String "'\\"; `Newline; `String "'"]; token state lexbuf } | "'" ([^'\'''\\'] | '\\' (_ | digit digit digit | 'x' hex hex)) "'" { add_token state (`String (lexeme lexbuf)); token state lexbuf } | '\r'? '\n' { add_token state `Newline; token state lexbuf } | '\t' { add_token state `Tab; token state lexbuf } | eof { finish_annot state; return_tokens state } | ' '+ { add_token state (`Token (lexeme lexbuf)); token state lexbuf } | '-'? (digit (digit | '_')* | ("0x"| "0X") hex (hex | '_')* | ("0o"| "0O") oct (oct | '_')* | ("0b"| "0B") bin (bin | '_')* ) | '-'? digit (digit | '_')* ('.' (digit | '_')* )? (['e' 'E'] ['+' '-']? digit (digit | '_')* )? | _ { add_token state (`Token (lexeme lexbuf)); token state lexbuf } and comment special state = parse | "(*" { state.depth <- state.depth + 1; Buffer.add_string state.buf "(*"; comment special state lexbuf } | "*)" { state.depth <- state.depth - 1; if (state.depth > 0) then ( Buffer.add_string state.buf "*)"; comment special state lexbuf ) } | '"' { Buffer.add_char state.buf '"'; string state true lexbuf; comment special state lexbuf } | eof { finish_annot state } | '\r'? '\n' { if special then ( Buffer.add_char state.buf '\n'; comment special state lexbuf ) else ( add_token state (`Comment (Buffer.contents state.buf)); add_token state `Newline; Buffer.clear state.buf; comment special state lexbuf ) } | '\t' { add_token state (`Comment (Buffer.contents state.buf)); add_token state `Tab; Buffer.clear state.buf; comment special state lexbuf } | _ { Buffer.add_string state.buf (lexeme lexbuf); comment special state lexbuf } and string state comment = parse | '"' { Buffer.add_char state.buf '"' } | "\\\\" | '\\' '"' { Buffer.add_string state.buf (lexeme lexbuf); string state comment lexbuf } | eof { finish_annot state } | '\r'? '\n' { let s = Buffer.contents state.buf in add_token state (if comment then `Comment s else `String s); add_token state `Newline; Buffer.clear state.buf; string state comment lexbuf } | '\t' { let s = Buffer.contents state.buf in add_token state (if comment then `Comment s else `String s); add_token state `Tab; Buffer.clear state.buf; string state comment lexbuf } | _ { Buffer.add_string state.buf (lexeme lexbuf); string state comment lexbuf } and quotation state = parse | ">>" { () } | "\\>>" { Buffer.add_string state.buf "\\>>"; quotation state lexbuf } | '\r'? '\n' { let s = Buffer.contents state.buf in add_token state (`Quotation s); add_token state `Newline; Buffer.clear state.buf; quotation state lexbuf } | '\t' { let s = Buffer.contents state.buf in add_token state (`Quotation s); add_token state `Tab; Buffer.clear state.buf; quotation state lexbuf } | _ { Buffer.add_string state.buf (lexeme lexbuf); quotation state lexbuf } { let parse ?(annot = []) lexbuf = token (init_state annot lexbuf) lexbuf let string ?(filename = "") ?(annot = []) s = let lexbuf = Lexing.from_string s in init_lexbuf lexbuf filename; token (init_state annot lexbuf) lexbuf let channel ?(filename = "") ?(annot = []) ic = let lexbuf = Lexing.from_channel ic in init_lexbuf lexbuf filename; token (init_state annot lexbuf) lexbuf let file ?annot s = let ic = open_in s in let l = channel ~filename:s ?annot ic in close_in ic; l } caml2html-1.4.3/main.ml000066400000000000000000000166211203671207400146700ustar00rootroot00000000000000(* $Id$ *) (* Copyright 2002-2004 Sébastien Ailleret Copyright 2004-2007, 2010 Martin Jambon This file is distributed under the terms of the GNU Public License http://www.gnu.org/licenses/gpl.txt *) open Printf open Output let line_numbers = ref default_param.line_numbers let title = ref default_param.title let tab_size = ref default_param.tab_size let footnote = ref default_param.footnote let style = ref default_param.style let raw_comments = ref default_param.html_comments let charset = ref default_param.charset let annot_filter = ref default_param.annot_filter let no_annot = ref default_param.no_annot let ie7 = ref default_param.ie7 let out_format = ref (`Html : [`Html | `Latex ]) let body_only = ref false let get_html_param () = { Output.line_numbers = !line_numbers; title = !title; body_only = !body_only; tab_size = !tab_size; footnote = !footnote; style = !style; html_comments = !raw_comments; charset = !charset; annot_filter = !annot_filter; no_annot = !no_annot; ie7 = !ie7 } let get_latex_param () = { Output_latex.line_numbers = !line_numbers; title = !title; body_only = !body_only; tab_size = !tab_size; latex_comments = !raw_comments; defs = Output_latex.default_param.Output_latex.defs } let get_param () = match !out_format with `Html -> `Html (get_html_param ()) | `Latex -> `Latex (get_latex_param ()) (* output file *) let res_file = ref "" (* output directory *) let res_dir = ref "" let usage = " Caml2html colorizes a set of OCaml source files (.ml, .mli, .mll, .mly, ...). Type annotations will be shown when the mouse pointer passes over an expression if the corresponding .annot file is available. To obtain a .annot file, compile with ocamlc -dtypes or ocamlopt -dtypes. Usage: " ^ (Filename.basename Sys.argv.(0)) ^ " [options] file1 ... fileN Options:" let speclist = [ ("-annotfilter", Arg.Symbol (["innermost"; "outermost"], (function "innermost" -> annot_filter := `Innermost | "outermost" -> annot_filter := `Outermost | _ -> assert false)), " choose whether innermost or outermost type annotations should be used (default: innermost)"); ("-charset", Arg.String (fun s -> charset := s), sprintf "\ specify charset to use (default: %s)" default_param.charset); ("-css", Arg.Unit (fun () -> style := `Url "style.css"), " use CSS named style.css for styling"); ("-cssurl", Arg.String (fun s -> style := `Url s), " use the given URL as CSS for styling"); ("-inhead", Arg.Unit (fun () -> style := `Inhead Output.default_style), " use default styling and place it in the section of the document (default when applicable)"); ("-inline", Arg.Unit (fun () -> style := `Inline), " use inline styling (HTML only, default fallback if -inhead is not applicable)"); ("-body", Arg.Set body_only, " output only document's body, for inclusion into an existing document (see also -make-css and -make-latex-defs)"); ("-ln", Arg.Unit (fun () -> line_numbers := true), " add line number at the beginning of each line"); ("-hc", Arg.Unit (fun () -> raw_comments := true), " comments are treated as raw HTML or LaTeX code (no newlines inside of tags)"); ("-t", Arg.Unit (fun () -> title := true), " add a title to the HTML page"); ("-nf", Arg.Unit (fun () -> footnote := false), " do not add footnotes to the HTML page"); ("-ie7", Arg.Set ie7, " drop support for type annotations on Internet Explorer 6 and older"); ("-noannot", Arg.Set no_annot, " do not insert type annotations as read from .annot files (HTML output only)"); ("-notab", Arg.Unit (fun () -> tab_size := -1), " do not replace tabs by spaces"); ("-tab", Arg.Set_int tab_size, " replace tab by n spaces (default = 8)"); ("-d", Arg.String (fun s -> res_dir := s), " generate files in directory dir, rather than in current directory"); ("-o", Arg.String (fun s -> res_file := s), " output file"); ("-v", Arg.Unit (fun () -> Printf.printf "%s\n" version; exit 0), " print version number to stdout and exit"); ("-make-css", Arg.String (fun s -> Output.make_css s; exit 0), " create CSS file with default color definitions and exit"); ("-ext", Arg.String Plugin.register_command, " use the given external command CMD to handle comments that start with (*NAME. NAME must be a lowercase identifier."); ("-latex", Arg.Unit (fun () -> out_format := `Latex), " output LaTeX code instead of HTML."); ("-make-latex-defs", Arg.String (fun s -> Output_latex.make_defs_file s; exit 0), " create a file containing the default LaTeX color definitions and matching highlighting commands, and exit. \\usepackage{alltt,color} is not included."); ] let handle_stdin_to_stdout out_format = let buf = Buffer.create 8192 in let l = Input.channel stdin in (match out_format with `Html param -> if not param.Output.body_only then Output.begin_document ~param buf []; Output.ocaml_file ~param buf l; if not param.Output.body_only then Output.end_document ~param buf | `Latex param -> if not param.Output_latex.body_only then Output_latex.begin_document ~param buf []; Output_latex.ocaml_file ~param buf l; if not param.Output_latex.body_only then Output_latex.end_document ~param buf ); Buffer.output_buffer stdout buf let manage_files out_format files = match out_format with `Html param -> if !res_file = "" then (* handles files separately *) let manage_one file = let buf = Buffer.create 8192 in if not param.Output.body_only then Output.begin_document ~param buf [file]; Output.handle_file ~param buf file; if not param.Output.body_only then Output.end_document ~param buf; Output.save_file ~dir:!res_dir buf (file ^ ".html") in List.iter manage_one files else (* groups all files into one *) Output.ocaml_document ~param ~dir: !res_dir files !res_file | `Latex param -> if !res_file = "" then let manage_one file = let buf = Buffer.create 8192 in if not param.Output_latex.body_only then Output_latex.begin_document ~param buf [file]; Output_latex.handle_file ~param buf file; if not param.Output_latex.body_only then Output_latex.end_document ~param buf; Output_latex.save_file ~dir:!res_dir buf (file ^ ".tex") in List.iter manage_one files else Output_latex.ocaml_document ~param ~dir: !res_dir files !res_file let () = let files = ref [] in Arg.parse speclist (fun x -> files := x :: !files) usage; if !res_file = "" && !files = [] then (title := false; handle_stdin_to_stdout (get_param ())) else (if !res_file <> "" && ((List.length !files) >= 2) then title := true; (manage_files (get_param ())) (List.rev !files)) caml2html-1.4.3/output.ml000066400000000000000000000350541203671207400153050ustar00rootroot00000000000000(* $Id$ *) (* Copyright 2002-2004 Sébastien Ailleret Copyright 2004 Martin Jambon This file is distributed under the terms of the GNU Public License http://www.gnu.org/licenses/gpl.txt *) (* This module provides functions that parse OCaml source code and return a list of tokens which are suitable for automatic syntax highlighting. Any input is accepted. Only a lexical analysis is performed and thus can be used to highlight incorrect programs as well as derivatives of OCaml (.ml .mli .mll .mly). *) open Printf let version = "caml2html " ^ Version.version type class_definition = (string list * (string * string) list) (* This will be come before the token-specific color definitions *) let default_default_style : class_definition list = [ ["code"; "pre"], [ "color", "black"; "background-color", "white" ]; ["a.Cannot"], [ "color", "black"; "text-decoration", "none" ] ] let key_color1 = Some "green" let key_color2 = Some "#77aaaa" let key_color3 = Some "#cc9900" let key_color4 = Some "#990099" let key_color5 = Some "#808080" let construct_color = (Some "#0033cc", None, "Cconstructor") let comment_color = (Some "#990000", None, "Ccomment") let string_color = (Some "#aa4444", None, "Cstring") let quotation_color = (None, None, "Cquotation") let annot_color = (None, Some "#b4eeb4", "Cannot:hover") let background_color = (None, Some "white", "Cbackground") let linenum_color = (Some "black", Some "silver", "Clinenum") let alpha_keyword_color = (key_color5, None, "Calphakeyword") let nonalpha_keyword_color = (None, None, "Cnonalphakeyword") let default_keyword_color_list = [ "and", (key_color1, None, "Cand"); "as", (key_color1, None, "Cas"); "class", (key_color1, None, "Cclass"); "constraint", (key_color1, None, "Cconstraint"); "exception", (key_color1, None, "Cexception"); "external", (key_color1, None, "Cexternal"); "fun", (key_color1, None, "Cfun"); "function", (key_color1, None, "Cfunction"); "functor", (key_color1, None, "Cfunctor"); "in", (key_color1, None, "Cin"); "inherit", (key_color1, None, "Cinherit"); "initializer", (key_color1, None, "Cinitializer"); "let", (key_color1, None, "Clet"); "method", (key_color1, None, "Cmethod"); "module", (key_color1, None, "Cmodule"); "mutable", (key_color1, None, "Cmutable"); "of", (key_color1, None, "Cof"); "private", (key_color1, None, "Cprivate"); "rec", (key_color1, None, "Crec"); "type", (key_color1, None, "Ctype"); "val", (key_color1, None, "Cval"); "virtual", (key_color1, None, "Cvirtual"); "do", (key_color2, None, "Cdo"); "done", (key_color2, None, "Cdone"); "downto", (key_color2, None, "Cdownto"); "else", (key_color2, None, "Celse"); "for", (key_color2, None, "Cfor"); "if", (key_color2, None, "Cif"); "lazy", (key_color2, None, "Clazy"); "match", (key_color2, None, "Cmatch"); "new", (key_color2, None, "Cnew"); "or", (key_color2, None, "Cor"); "then", (key_color2, None, "Cthen"); "to", (key_color2, None, "Cto"); "try", (key_color2, None, "Ctry"); "when", (key_color2, None, "Cwhen"); "while", (key_color2, None, "Cwhile"); "with", (key_color2, None, "Cwith"); "assert", (key_color3, None, "Cassert"); "include", (key_color3, None, "Cinclude"); "open", (key_color3, None, "Copen"); "begin", (key_color4, None, "Cbegin"); "end", (key_color4, None, "Cend"); "object", (key_color4, None, "Cobject"); "sig", (key_color4, None, "Csig"); "struct", (key_color4, None, "Cstruct"); "raise", (Some "red", None, "Craise"); "asr", (key_color5, None, "Casr"); "land", (key_color5, None, "Cland"); "lor", (key_color5, None, "Clor"); "lsl", (key_color5, None, "Clsl"); "lsr", (key_color5, None, "Clsr"); "lxor", (key_color5, None, "Clxor"); "mod", (key_color5, None, "Cmod"); "false", (None, None, "Cfalse"); "true", (None, None, "Ctrue"); "|", (key_color2, None, "Cbar"); ] let default_keyword_colors = let tbl = Hashtbl.create 100 in List.iter (fun (s, (color, bgcolor, css_class)) -> Hashtbl.add tbl s (color, bgcolor, css_class)) default_keyword_color_list; tbl let all_colors = linenum_color :: background_color :: construct_color :: comment_color :: annot_color :: string_color :: quotation_color :: alpha_keyword_color :: nonalpha_keyword_color :: (List.map snd default_keyword_color_list) let make_style l = String.concat ";" (List.map (fun (name, value) -> name ^ ":" ^ value) l) let inline_style (fg, bg, _class) = let colors = [] in let colors = match fg with None -> colors | Some color -> ("color:" ^ color) :: colors in let colors = match bg with None -> colors | Some color -> ("background-color:" ^ color) :: colors in String.concat ";" colors let make_classes ?(default = default_default_style) ?(colors = all_colors) () = let buf = Buffer.create 2000 in List.iter (fun (classnames, style) -> if classnames <> [] then bprintf buf "%s { %s }" (String.concat "," classnames) (make_style style)) default; let color_groups = Hashtbl2.list_all (Hashtbl2.of_list 50 (List.map (fun (a,b,c) -> ((a,b),c)) colors)) in List.iter (fun ((fg, bg), l) -> let color = match fg with None -> "" | Some color -> " color: " ^ color ^ ";" in let background_color = match bg with None -> "" | Some color -> " background-color: " ^ color ^ ";" in bprintf buf ".%s {%s%s }\n" (String.concat ",\n." (List.sort String.compare l)) color background_color) color_groups; Buffer.contents buf let make_css ?(default = default_default_style) ?(colors = all_colors) file = let oc = open_out file in output_string oc (make_classes ~default ~colors ()); close_out oc let default_style = make_classes () type style = [ `Inline | `Inhead of string | `Url of string ] type param = { line_numbers : bool; title : bool; body_only : bool; tab_size : int; footnote : bool; style : style; html_comments : bool; charset : string; annot_filter : Annot.filter; no_annot : bool; ie7 : bool (* if true, type annotations will not work on versions of Internet Explorer prior to IE 7 (but rendering is better) *) } let default_param = { line_numbers = false; title = false; body_only = false; tab_size = 8; footnote = true; style = `Inhead default_style; html_comments = false; charset = "iso-8859-1"; annot_filter = `Innermost; no_annot = false; ie7 = false } let add_string buf nbsp s = String.iter (function '<' -> Buffer.add_string buf "<" | '>' -> Buffer.add_string buf ">" | '&' -> Buffer.add_string buf "&" | ' ' when nbsp -> Buffer.add_string buf " " | c -> Buffer.add_char buf c) s let line_comment p buf i = if p.line_numbers then match p.style with `Inline -> (* should use color parameters *) bprintf buf "%4d:\ " (inline_style linenum_color) i (inline_style background_color) | `Inhead _ | `Url _ -> bprintf buf "%4d:\ " i let colorize ?(comment = false) p buf nbsp style s = let add = if comment && p.html_comments then Buffer.add_string buf else add_string buf nbsp in match p.style with `Inhead _ | `Url _ -> let _, _, clas = style in bprintf buf "" clas; add s; Buffer.add_string buf "" | `Inline -> match inline_style style with "" -> add s | sty -> bprintf buf "" sty; add s; Buffer.add_string buf "" let compact_annot s = let space = ref true in let buf = Buffer.create 200 in String.iter (function ' ' | '\n' | '\t' | '\r' -> if !space then () else (space := true; Buffer.add_char buf ' ') | c -> space := false; Buffer.add_char buf c) s; Buffer.contents buf let ignore_annot p info = p.no_annot || p.annot_filter = `Innermost && not info.Annot.innermost || p.annot_filter = `Outermost && not info.Annot.outermost let hover_start p = if p.ie7 then "span" else "a href=\"javascript:;\"" let hover_stop p = if p.ie7 then "span" else "a" let start_annot p buf info annot = if ignore_annot p info then () else ((* We use "a href" and not "span" in order to make the hover work in IE 6. *) match p.style with `Inline -> bprintf buf "<%s style=\"text-decoration:none;%s\" \ title=\"\"" (hover_start p) (inline_style annot_color); add_string buf false (compact_annot annot); Buffer.add_string buf "\">" | `Inhead _ | `Url _ -> bprintf buf "<%s style=\"text-decoration:none\" \ class=\"Cannot\" title=\"" (hover_start p); add_string buf false (compact_annot annot); Buffer.add_string buf "\">") let stop_annot p buf info = if ignore_annot p info then () else bprintf buf "" (hover_stop p) let rec fold_left f accu l = match l with [] -> accu | a :: rest -> fold_left f (f accu a rest) rest let ocaml ?(nbsp = false) ?(keyword_colors = default_keyword_colors) ?(param = default_param) buf l = let _last_line = fold_left (fun line token rest -> match token with `String s -> colorize param buf nbsp string_color s; line | `Quotation s -> colorize param buf nbsp quotation_color s; line | `Token s -> add_string buf nbsp s; line | `Comment s -> colorize ~comment:true param buf nbsp comment_color s; line | `Special_comment (handler_name, s0) -> let html = match Plugin.expand handler_name s0 with None -> failwith ( sprintf "Handler %s failed on line %i with input %s" handler_name line s0 ) | Some s -> s in bprintf buf "%s
" html;
	       line + (Plugin.count_newlines s0)
	   | `Construct s ->
	       colorize param buf nbsp construct_color s;
	       line
	   | `Keyword k ->
	       (try 
		  let color = Hashtbl.find keyword_colors k in
		  colorize param buf nbsp color k;
		with Not_found -> 
		  let color =
		    match k.[0] with
			'a' .. 'z' -> alpha_keyword_color
		      | _ -> nonalpha_keyword_color in
		  colorize param buf nbsp color k);
	       line
	   | `Newline ->
	       Buffer.add_char buf '\n';
	       (match rest with
                    []
                  | `Special_comment _ :: _ -> ()
                  | _ ->
		      line_comment param buf line
               );
	       line + 1
	   | `Tab ->
	       if param.tab_size < 0 then Buffer.add_char buf '\t'
	       else add_string buf nbsp (String.make param.tab_size ' ');
	       line
	   | `Start_annot (info, annot) -> (start_annot param buf info annot; 
					    line)
	   | `Stop_annot info -> stop_annot param buf info; line)
      2 l in
  ()

let ocamlcode
  ?annot
  ?keyword_colors
  ?(param = default_param)
  ?(tag_open = "")
  ?(tag_close = "")
  s =
  let buf = Buffer.create (10 * String.length s) in
  Buffer.add_string buf tag_open;
  line_comment param buf 1;
  ocaml ?keyword_colors ~param ~nbsp:true buf (Input.string ?annot s);
  Buffer.add_string buf tag_close;
  Buffer.contents buf

let ocamlpre
  ?annot
  ?keyword_colors
  ?(param = default_param)
  ?(tag_open = "
")
  ?(tag_close = "
")
  s =
  let buf = Buffer.create (10 * String.length s) in
  Buffer.add_string buf tag_open;
  line_comment param buf 1;
  ocaml ?keyword_colors ~param ~nbsp:false buf (Input.string ?annot s);
  Buffer.add_string buf tag_close;
  Buffer.contents buf


let is_valid_anchor =
  let re = Str.regexp "[A-Za-z][-A-Za-z0-9_:.]*$" in
  fun s -> Str.string_match re s 0
    
let ocaml_file
  ?(filename = "") 
  ?keyword_colors
  ~param
  buf l =
  
  let anchor = 
    if is_valid_anchor filename then 
      sprintf "" filename
    else "" in

  if param.title then
    (bprintf buf "
%s%s
\n" anchor filename;
     Buffer.add_string buf "\n
")
  else
    bprintf buf "\n
%s" anchor;

  line_comment param buf 1;
  ocaml ?keyword_colors ~param buf l;
  Buffer.add_string buf "
\n"



let begin_document 
  ?(param = default_param)
  buf files =
  let rec make_title = function
    | [] -> ()
    | [a] -> Buffer.add_string buf a
    | a :: l -> Printf.bprintf buf "%s, " a; make_title l in
  bprintf buf "\



  
  
" param.charset;
  make_title files;
  Printf.bprintf buf
    "\n  \n" 
    Version.version;
  (match param.style with
       `Url url ->
	 Printf.bprintf buf
	 "  \n" 
	url
     | `Inhead s ->
	 Printf.bprintf buf "\n" s
     | `Inline -> ());
  Buffer.add_string buf "\n\n"


let end_document ?(param = default_param) buf =
  if param.footnote then
    Buffer.add_string buf "




This document was generated using 
caml2html
";
  Buffer.add_string buf "\n\n"


let handle_file ?keyword_colors ?(param = default_param) buf filename =
  let annot =
    match Annot.guess_annot_file filename with
	None -> None
      | Some annot_file ->
	  Annot.from_file 
	    ~impl_file:filename ~annot_file in
  let l = Input.file ?annot filename in
  ocaml_file ?keyword_colors ~param ~filename buf l

let rec mkdir_p dir =
  if Sys.file_exists dir then ()
  else
    (mkdir_p (Filename.dirname dir);
     Unix.mkdir dir 0o777)

let save_file ?(dir = "") buf file =
  let dir_res_name =
    if dir = "" then file
    else
      (mkdir_p dir;
       Filename.concat dir file) in
  let chan_out = open_out dir_res_name in
  Buffer.output_buffer chan_out buf;
  close_out chan_out

let ocaml_document ?dir ?keyword_colors ?param files outfile =
  let buf = Buffer.create 50_000 in
  begin_document ?param buf files;
  let rec tmp = function
    | [] -> ()
    | [x] -> handle_file ?keyword_colors ?param buf x
    | x :: l ->
	handle_file ?keyword_colors ?param buf x;
        Buffer.add_string buf "\n
\n";
        tmp l in
  tmp files;
  end_document ?param buf;
  save_file ?dir buf outfile
caml2html-1.4.3/output.mli000066400000000000000000000104401203671207400154460ustar00rootroot00000000000000(* 
   Copyright 2004 Martin Jambon

   This module produces HTML code for the presentation of OCaml programs
   (.ml .mli .mll .mly).

   This file is distributed under the terms of the GNU Public License
   http://www.gnu.org/licenses/gpl.txt
*)

val version : string
(** Version of caml2html. For compatibility with older versions. 
  Use [Version.version] instead, which returns only the version code,
  without the "caml2html " prefix. *)

type class_definition = (string list * (string * string) list)

val default_default_style : class_definition list

val default_style : string

val key_color1 : string option
val key_color2 : string option
val key_color3 : string option
val key_color4 : string option
val key_color5 : string option
val construct_color : string option * string option * string
val comment_color : string option * string option * string
val string_color : string option * string option * string
val alpha_keyword_color : string option * string option * string
val nonalpha_keyword_color : string option * string option * string

val default_keyword_color_list : 
  (string * (string option * string option * string)) list
val default_keyword_colors : 
  (string, string option * string option * string) Hashtbl.t
val all_colors : (string option * string option * string) list
(** colors which are used for the predefined style.
  This is a list of couples (optional color specification, CSS class). *)

val make_css : 
  ?default: class_definition list ->
  ?colors:(string option * string option * string) list -> string -> unit
(** make a CSS file from the given colors *)

type style = [ `Inline | `Inhead of string | `Url of string ]

type param = {
  line_numbers : bool;
  title : bool;
  body_only : bool;
  tab_size : int;
  footnote : bool;
  style : style;
  html_comments : bool;
  charset : string;
  annot_filter : Annot.filter;
  no_annot : bool;
  ie7 : bool;
}
(** the type of the options for making the HTML document *)

val default_param : param

val ocaml :
  ?nbsp:bool ->
  ?keyword_colors:(string, string option * string option * string) Hashtbl.t ->
  ?param:param ->
  Buffer.t -> 
  Input.token list -> unit
(** [ocaml buf l] formats the list of tokens [l] into some HTML code
  which should be placed in a  or 
 region,
  and adds the result the given buffer [buf].
  Option [nbsp] tells if the spaces must be converted into " " or not
  (required in  regions but not in 
; default is false). *)

val ocamlcode :
  ?annot:Annot.tag list ->
  ?keyword_colors:(string, string option * string option * string) Hashtbl.t ->
  ?param:param -> ?tag_open:string -> ?tag_close:string -> string -> string
(** [ocamlcode s1 s2] parses [s1] and formats the result as a HTML string
  enclosed between  and  unless specified otherwise. *)

val ocamlpre :
  ?annot:Annot.tag list ->
  ?keyword_colors:(string, string option * string option * string) Hashtbl.t ->
  ?param:param -> ?tag_open:string -> ?tag_close:string -> string -> string
(** [ocamlcode s1 s2] parses [s1] and formats the result as a HTML string
  enclosed between 
 and 
 unless specified otherwise. *)

(* $Id$ *)

val ocaml_file :
  ?filename:string ->
  ?keyword_colors:(string, string option * string option * string) Hashtbl.t ->
  param:param ->
  Buffer.t ->
  Input.token list -> unit
(** [ocaml_file buf tokens] makes HTML code that represents one source file
  of OCaml code. The name of the file is added as title, 
  depending on the parameters and is specified with the [filename] option.
*)

val begin_document : ?param:param -> Buffer.t -> string list -> unit
val end_document : ?param:param -> Buffer.t -> unit

val handle_file :
  ?keyword_colors:(string, string option * string option * string) Hashtbl.t ->
  ?param:param -> Buffer.t -> string -> unit
(** [handle_file buf srcfile] parse the given file [srcfile]
  and puts the HTML into [buf]. *)

val save_file : ?dir:string -> Buffer.t -> string -> unit
(** [save_file buf file] just saves the contents of buffer [buf]
  in the given [file]. *)

val ocaml_document :
  ?dir:string ->
  ?keyword_colors:(string, string option * string option * string) Hashtbl.t ->
  ?param:param -> string list -> string -> unit
(** [ocaml_document files file] parses the given OCaml [files]
  and make one complete HTML document that shows the contents of 
  these files. *)
caml2html-1.4.3/output_latex.ml000066400000000000000000000221151203671207400164740ustar00rootroot00000000000000(* $Id$ *)
(* 
   Copyright 2002-2004 Sébastien Ailleret
   Copyright 2004, 2010 Martin Jambon
   
   This file is distributed under the terms of the GNU Public License
   http://www.gnu.org/licenses/gpl.txt
*)

(*
   This module provides functions that parse OCaml source code and return
   a list of tokens which are suitable for automatic syntax highlighting.
   Any input is accepted. Only a lexical analysis is performed and thus can
   be used to highlight incorrect programs as well as derivatives
   of OCaml (.ml .mli .mll .mly).
*)

open Printf


type class_definition = (string list * (string * string) list)

let rgb1 (r, g, b) =
  sprintf "%.2f,%.2f,%.2f"
    (float r /. 255.)
    (float g /. 255.)
    (float b /. 255.)

let rgb255 (r, g, b) =
  sprintf "%i,%i,%i" r g b

let color1 = 0, 128, 0
let color2 = 119, 170, 170
let color3 = 204, 153, 0
let color4 = 153, 0, 153
let color5 = 128, 128, 128
let color6 = 255, 0, 0
let color7 = 0, 51, 204
let color8 = 153, 0, 0
let color9 = 170, 68, 68

let key_color1 = Some (rgb1 color1)
let key_color2 = Some (rgb1 color2)
let key_color3 = Some (rgb1 color3)
let key_color4 = Some (rgb1 color4)
let key_color5 = Some (rgb1 color5)
let key_color6 = Some (rgb1 color6)

let construct_color = (Some (rgb1 color7), "Cconstructor")
let comment_color = (Some (rgb1 color8), "Ccomment")
let string_color = (Some (rgb1 color9), "Cstring")
let quotation_color = (None, "Cquotation")
let linenum_color = (None, "Clinenum")

let alpha_keyword_color = (key_color5, "Calphakeyword")
let nonalpha_keyword_color = (None, "Cnonalphakeyword")

let default_keyword_color_list =
  [
    "and", (key_color1, "Cand");
    "as", (key_color1, "Cas");
    "class", (key_color1, "Cclass");
    "constraint", (key_color1, "Cconstraint");
    "exception", (key_color1, "Cexception");
    "external", (key_color1, "Cexternal");
    "fun", (key_color1, "Cfun");
    "function", (key_color1, "Cfunction");
    "functor", (key_color1, "Cfunctor");
    "in", (key_color1, "Cin");
    "inherit", (key_color1, "Cinherit");
    "initializer", (key_color1, "Cinitializer");
    "let", (key_color1, "Clet");
    "method", (key_color1, "Cmethod");
    "module", (key_color1, "Cmodule");
    "mutable", (key_color1, "Cmutable");
    "of", (key_color1, "Cof");
    "private", (key_color1, "Cprivate");
    "rec", (key_color1, "Crec");
    "type", (key_color1, "Ctype");
    "val", (key_color1, "Cval");
    "virtual", (key_color1, "Cvirtual");
    
    "do", (key_color2, "Cdo");
    "done", (key_color2, "Cdone");
    "downto", (key_color2, "Cdownto");
    "else", (key_color2, "Celse");
    "for", (key_color2, "Cfor");
    "if", (key_color2, "Cif");
    "lazy", (key_color2, "Clazy");
    "match", (key_color2, "Cmatch");
    "new", (key_color2, "Cnew");
    "or", (key_color2, "Cor");
    "then", (key_color2, "Cthen");
    "to", (key_color2, "Cto");
    "try", (key_color2, "Ctry");
    "when", (key_color2, "Cwhen");
    "while", (key_color2, "Cwhile");
    "with", (key_color2, "Cwith");
    
    "assert", (key_color3, "Cassert");
    "include", (key_color3, "Cinclude");
    "open", (key_color3, "Copen");
    
    "begin", (key_color4, "Cbegin");
    "end", (key_color4, "Cend");
    "object", (key_color4, "Cobject");
    "sig", (key_color4, "Csig");
    "struct", (key_color4, "Cstruct");
    
    "raise", (key_color6, "Craise");

    "asr", (key_color5, "Casr");
    "land", (key_color5, "Cland");
    "lor", (key_color5, "Clor");
    "lsl", (key_color5, "Clsl");
    "lsr", (key_color5, "Clsr");
    "lxor", (key_color5, "Clxor");
    "mod", (key_color5, "Cmod");
    
    "false", (None, "Cfalse");
    "true", (None, "Ctrue");

    "|", (key_color2, "Cbar");
  ]

let default_keyword_colors =
  let tbl = Hashtbl.create 100 in
  List.iter
    (fun (s, (color, css_class)) -> 
       Hashtbl.add tbl s (color, css_class))
    default_keyword_color_list;
  tbl

let all_colors =
  linenum_color ::
    construct_color ::
    comment_color ::
    string_color ::
    quotation_color ::
    alpha_keyword_color ::
    nonalpha_keyword_color ::
    (List.map snd default_keyword_color_list)

let make_defs
  ?(colors = all_colors) () =
  let buf = Buffer.create 2000 in

  List.iter (
    fun (fg, name) -> 
      match fg with 
	  None ->
            bprintf buf "\
\\newcommand\\%s[1]{#1}
"
              name
	| Some color ->
            bprintf buf "\
\\definecolor{%sColor}{rgb}{%s}
\\newcommand\\%s[1]{\\textcolor{%sColor}{#1}}
"
              name color
              name name
  ) colors;

  Buffer.contents buf

  
let make_defs_file
    ?(colors = all_colors)
    file =
  let oc = open_out file in
  output_string oc (make_defs ~colors ());
  close_out oc

let default_style = make_defs ()

type param = {
  line_numbers : bool; 
  title : bool;
  body_only : bool;
  tab_size : int;
  latex_comments : bool;
  defs : string;
}

let default_param = {
  line_numbers = false; 
  title = false;
  body_only = false;
  tab_size = 8;
  latex_comments = false;
  defs = default_style;
}


let add_string buf s = 
  String.iter
    (function
	 '\\' -> Buffer.add_string buf "\\(\\backslash\\)"
       | '{' -> Buffer.add_string buf "\\{"
       | '}' -> Buffer.add_string buf "\\}"
       | c -> Buffer.add_char buf c)
    s


let line_comment p buf i =
  if p.line_numbers then
    bprintf buf "\\Clinenum{%4i}: " i

 
let colorize ?(comment = false) p buf style s =
  let add =
    if comment && p.latex_comments then Buffer.add_string buf
    else add_string buf in
  let _, clas = style in
  bprintf buf "\\%s{" clas;
  add s;
  Buffer.add_string buf "}"



let rec fold_left f accu l =
  match l with
      [] -> accu
    | a :: rest -> fold_left f (f accu a rest) rest

let ocaml
  ?(keyword_colors = default_keyword_colors)
  ?(param = default_param)
  buf l =
  
  let _last_line =
    fold_left
      (fun line token rest ->
	 match token with
	     `String s ->
	       colorize param buf string_color s;
	       line
	   | `Quotation s ->
	       colorize param buf quotation_color s;
	       line
	   | `Token s ->
	       add_string buf s;
	       line
	   | `Comment s ->
	       colorize ~comment:true param buf comment_color s;
	       line
	   | `Special_comment (handler_name, s0) ->
	       let html = 
		 match Plugin.expand handler_name s0 with
		     None -> 
		       failwith (
			 sprintf "Handler %s failed on line %i with input %s"
			   handler_name line s0
		       )
		   | Some s -> s
	       in
	       bprintf buf "\\end{alltt}%s\\begin{alltt}" html;
	       line + (Plugin.count_newlines s0)
	   | `Construct s ->
	       colorize param buf construct_color s;
	       line
	   | `Keyword k ->
	       (try 
		  let color = Hashtbl.find keyword_colors k in
		  colorize param buf color k;
		with Not_found -> 
		  let color =
		    match k.[0] with
			'a' .. 'z' -> alpha_keyword_color
		      | _ -> nonalpha_keyword_color in
		  colorize param buf color k);
	       line
	   | `Newline ->
	       Buffer.add_char buf '\n';
	       if rest <> [] then
		 line_comment param buf line;
	       line + 1
	   | `Tab ->
	       if param.tab_size < 0 then Buffer.add_char buf '\t'
	       else add_string buf (String.make param.tab_size ' ');
	       line
	   | `Start_annot (info, annot) -> line
	   | `Stop_annot info -> line)
      2 l in
  ()


let esc s =
  let buf = Buffer.create (2 * String.length s) in
  for i = 0 to String.length s - 1 do
    match s.[i] with
        '_' | '{' | '}' | '%' | '~' as c -> bprintf buf "\\%c" c
      | '\\' -> bprintf buf "$\\backslash$"
      | c -> Buffer.add_char buf c
  done;
  Buffer.contents buf

let ocaml_file
  ?(filename = "") 
  ?keyword_colors
  ~param
  buf l =
  
  if param.title then
    bprintf buf "\\section{\\tt %s}\n" (esc filename);

  Buffer.add_string buf "\n\\begin{alltt}\n";
  line_comment param buf 1;
  ocaml ?keyword_colors ~param buf l;
  Buffer.add_string buf "\\end{alltt}\n"



let begin_document ?(param = default_param) buf files =
  bprintf buf "\
%% Auto-generated by caml2html %s from %s
\\documentclass{article}
\\usepackage{alltt}
\\usepackage{color}
"
    Version.version (String.concat ", " files);
  bprintf buf "%s\n" param.defs;
  Buffer.add_string buf "\\begin{document}\n"


let end_document ?(param = default_param) buf =
  Buffer.add_string buf "\\end{document}\n"


let handle_file ?keyword_colors ?(param = default_param) buf filename =
  let l = Input.file filename in
  ocaml_file ?keyword_colors ~param ~filename buf l

let rec mkdir_p dir =
  if Sys.file_exists dir then ()
  else
    (mkdir_p (Filename.dirname dir);
     Unix.mkdir dir 0o777)

let save_file ?(dir = "") buf file =
  let dir_res_name =
    if dir = "" then file
    else
      (mkdir_p dir;
       Filename.concat dir file) in
  let chan_out = open_out dir_res_name in
  Buffer.output_buffer chan_out buf;
  close_out chan_out

let ocaml_document ?dir ?keyword_colors ?param files outfile =
  let buf = Buffer.create 50_000 in
  begin_document ?param buf files;
  let rec tmp = function
    | [] -> ()
    | [x] -> handle_file ?keyword_colors ?param buf x
    | x :: l ->
	handle_file ?keyword_colors ?param buf x;
        Buffer.add_string buf "\n\\rule{\\textwidth}{1pt}\n";
        tmp l in
  tmp files;
  end_document ?param buf;
  save_file ?dir buf outfile
caml2html-1.4.3/output_latex.mli000066400000000000000000000055641203671207400166560ustar00rootroot00000000000000(* 
   Copyright 2004, 2010 Martin Jambon

   This module produces HTML code for the presentation of OCaml programs
   (.ml .mli .mll .mly).

   This file is distributed under the terms of the GNU Public License
   http://www.gnu.org/licenses/gpl.txt
*)

(* $Id$ *)

type class_definition = (string list * (string * string) list)

val default_style : string

val key_color1 : string option
val key_color2 : string option
val key_color3 : string option
val key_color4 : string option
val key_color5 : string option
val construct_color : string option * string
val comment_color : string option * string
val string_color : string option * string
val alpha_keyword_color : string option * string
val nonalpha_keyword_color : string option * string

val default_keyword_color_list : 
  (string * (string option * string)) list
val default_keyword_colors : 
  (string, string option * string) Hashtbl.t
val all_colors : (string option * string) list
(** colors which are used for the predefined style.
  This is a list of pairs (optional color specification, CSS class). *)

val make_defs_file : 
  ?colors:(string option * string) list -> string -> unit
(** Dump color definitions and matching highlighting commands into a file. *)

type param = {
  line_numbers : bool;
  title : bool;
  body_only : bool;
  tab_size : int;
  latex_comments : bool;
  defs : string;
}
(** the type of the options for making the HTML document *)

val default_param : param

val ocaml :
  ?keyword_colors:(string, string option * string) Hashtbl.t ->
  ?param:param ->
  Buffer.t -> 
  Input.token list -> unit
(** [ocaml buf l] formats the list of tokens [l] into some LaTeX code
  which should be placed within the alltt environment,
  and adds the result the given buffer [buf]. *)

val ocaml_file :
  ?filename:string ->
  ?keyword_colors:(string, string option * string) Hashtbl.t ->
  param:param ->
  Buffer.t ->
  Input.token list -> unit
(** [ocaml_file buf tokens] makes LaTeX code that represents one source file
  of OCaml code. The name of the file is added as title, 
  depending on the parameters and is specified with the [filename] option.
*)

val begin_document : ?param:param -> Buffer.t -> string list -> unit
val end_document : ?param:param -> Buffer.t -> unit

val handle_file :
  ?keyword_colors:(string, string option * string) Hashtbl.t ->
  ?param:param -> Buffer.t -> string -> unit
(** [handle_file buf srcfile] parse the given file [srcfile]
  and puts the HTML into [buf]. *)

val save_file : ?dir:string -> Buffer.t -> string -> unit
(** [save_file buf file] just saves the contents of buffer [buf]
  in the given [file]. *)

val ocaml_document :
  ?dir:string ->
  ?keyword_colors:(string, string option * string) Hashtbl.t ->
  ?param:param -> string list -> string -> unit
(** [ocaml_document files file] parses the given OCaml [files]
  and make one complete HTML document that shows the contents of 
  these files. *)
caml2html-1.4.3/plugin.ml000066400000000000000000000025611203671207400152400ustar00rootroot00000000000000(* $Id$ *)

open Printf

type handler =
    [ `Command of string
    | `Function of (string -> string option) ]

let plugins = Hashtbl.create 20

let add = Hashtbl.replace plugins
let remove = Hashtbl.remove plugins
let exists = Hashtbl.mem plugins
let find = Hashtbl.find plugins


let count_newlines s = 
  let n = ref 0 in
  String.iter (
    function
	'\n' -> incr n
      | _ -> ()
  ) s;
  !n

let expand name s =
  let h =
    try find name
    with Not_found ->
      failwith (sprintf "Plugin %s doesn't exist." name)
  in
  match h with
      `Function f -> f s
    | `Command cmd ->
	let p = Unix.open_process cmd in
	let ic, oc = p in
	output_string oc s;
	close_out oc;
	let buf = Buffer.create 1024 in
	try
	  while true do
	    Buffer.add_string buf (input_line ic);
	    Buffer.add_char buf '\n'
	  done;
	  assert false
	with End_of_file ->
	  match Unix.close_process p with
	      Unix.WEXITED 0 -> Some (Buffer.contents buf)
	    | _ -> None

	    
let html_handler =
  `Function (fun s -> Some s)

let _ = 
  add "html" html_handler


let register_command s =
  try
    let i = String.index s ':' in
    let name = String.sub s 0 i in
    let cmd = String.sub s (i+1) (String.length s - i - 1) in
    if name = "" || cmd = "" then
      raise Not_found
    else
      add name (`Command cmd)
  with Not_found ->
    failwith (sprintf "Cannot register %S: wrong syntax" s)
caml2html-1.4.3/plugin.mli000066400000000000000000000020771203671207400154130ustar00rootroot00000000000000(* $Id$ *)

type handler =
    [ `Command of string (* External command *)
    | `Function of (string -> string option) (* Function *) ]
      (** Custom comment handler. *)

val add : string -> handler -> unit
  (** Add or replace handler. *)

val remove : string -> unit
  (** Remove handler if it exists. *)

val exists : string -> bool
  (** Test whether such handler exists. *)

val find : string -> handler
  (** Find handler or raise [Not_found]. *)


val count_newlines : string -> int
  (** Count the number of newline characters in a string. *)

val expand : string -> string -> string option
  (** [expand handler_name s] find the handler [handler_name]
      and apply it to the input string [s].
      If the handler is an external command, the result is [None] 
      if and only if the process exits with a non-zero status.
      If the handler is a function, the behavior corresponds to
      the behavior of the function itself and any exception is propagated.
  *)

val register_command : string -> unit
  (** Parse and register a handler defined as "name:command". *)
caml2html-1.4.3/style.css000066400000000000000000000015611203671207400152610ustar00rootroot00000000000000.Cannot:hover { background-color: #b4eeb4; }
.Cbar,
.Cdo,
.Cdone,
.Cdownto,
.Celse,
.Cfor,
.Cif,
.Clazy,
.Cmatch,
.Cnew,
.Cor,
.Cthen,
.Cto,
.Ctry,
.Cwhen,
.Cwhile,
.Cwith { color: #77aaaa; }
.Cassert,
.Cinclude,
.Copen { color: #cc9900; }
.Cstring { color: #aa4444; }
.Cand,
.Cas,
.Cclass,
.Cconstraint,
.Cexception,
.Cexternal,
.Cfun,
.Cfunction,
.Cfunctor,
.Cin,
.Cinherit,
.Cinitializer,
.Clet,
.Cmethod,
.Cmodule,
.Cmutable,
.Cof,
.Cprivate,
.Crec,
.Ctype,
.Cval,
.Cvirtual { color: green; }
.Cbackground { background-color: white; }
.Craise { color: red; }
.Cconstructor { color: #0033cc; }
.Ccomment { color: #990000; }
.Calphakeyword,
.Casr,
.Cland,
.Clor,
.Clsl,
.Clsr,
.Clxor,
.Cmod { color: #808080; }
.Clinenum { color: black; background-color: silver; }
.Cbegin,
.Cend,
.Cobject,
.Csig,
.Cstruct { color: #990099; }
.Cfalse,
.Cnonalphakeyword,
.Cquotation,
.Ctrue { }
caml2html-1.4.3/tag.ml000066400000000000000000000026601203671207400145150ustar00rootroot00000000000000(* $Id$ *)
(* Various operations on lists of elements (Other) mixed with
   Start and Stop tags *)


(* The type of elements *)
type kind = Start | Stop | Other

(* Recursively remove consecutive start/stop pairs *)
let rec remove_matches = function
    (Start, _) as start :: l -> 
      (match remove_matches l with
	   (Stop, _) :: rest -> rest
	 | rest -> start :: rest)
  | (Stop, _) as stop :: l -> stop :: remove_matches l
  | (Other, _) as x :: l -> x :: remove_matches l
  | [] -> []

(* Annotate innermost start/stop pairs *)
let rec annotate_innermost f = function
    (Start, a) :: l ->
      let other, next_stop = find_stop f [] l in
      (match next_stop with
	   (Stop, b) :: rest ->
	     (Start, f true a) :: other @ (Stop, f true b) ::
	     annotate_innermost f rest
	 | (Start, _) :: _ -> other @ annotate_innermost f next_stop
	 | (Other, _) :: _ -> assert false
	 | [] -> other)
  | (tag, x) :: l -> (tag, f false x) :: annotate_innermost f l
  | [] -> []
	
and find_stop f accu = function
    (Other, x) :: l -> find_stop f ((Other, f false x) :: accu) l
  | l -> (List.rev accu), l

(*
let start x = (Start, x);;
let stop x = (Stop, x);;
let other x = (Other, x);;
let annotate b x = (x, b);;
let l1, l2 = 
  [ stop 1; stop 2; start 3; start 4; start 5; stop 5; start 6 ],
  [ stop 6; start 7; stop 7; stop 4; stop 3; start 8; stop 8; start 9 ];;
let l = remove_matches (l1 @ [other 10] @ l2);;
annotate_innermost annotate l;;
*)
caml2html-1.4.3/test.ml000066400000000000000000000025061203671207400147200ustar00rootroot00000000000000(* The type of elements *)
type kind = Start | Stop | Other

(* Recursively remove consecutive start/stop pairs *)
let rec remove_matches = function
    (Start, _) as start :: l -> 
      (match remove_matches l with
	   (Stop, _) :: rest -> rest
	 | rest -> start :: rest)
  | (Stop, _) as stop :: l -> stop :: remove_matches l
  | (Other, _) as x :: l -> x :: remove_matches l
  | [] -> []

(* Annotate innermost start/stop pairs *)
let rec annotate_innermost f = function
    (Start, a) :: l ->
      let other, next_stop = find_stop f [] l in
      (match next_stop with
	   (Stop, b) :: rest ->
	     (Start, f true a) :: other @ (Stop, f true b) ::
	     annotate_innermost f rest
	 | (Start, _) :: _ -> other @ annotate_innermost f next_stop
	 | (Other, _) :: _ -> assert false
	 | [] -> other)
  | (tag, x) :: l -> (tag, f false x) :: annotate_innermost f l
  | [] -> []
	
and find_stop f accu = function
    (Other, x) :: l -> find_stop f ((Other, f false x) :: accu) l
  | l -> (List.rev accu), l


let start x = (Start, x);;
let stop x = (Stop, x);;
let other x = (Other, x);;
let annotate b x = (x, b);;
let l1, l2 = 
  [ stop 1; stop 2; start 3; start 4; start 5; stop 5; start 6 ],
  [ stop 6; start 7; stop 7; stop 4; stop 3; start 8; stop 8; start 9 ];;
let l = remove_matches (l1 @ [other 10] @ l2);;
annotate_innermost annotate l;;
caml2html-1.4.3/version.ml.mlx000066400000000000000000000000541203671207400162210ustar00rootroot00000000000000let version = "##= Sys.getenv "VERSION" ##"