helm/DEVEL/pxp/pxp/doc/manual/src/getcode.ml

   1 #! /bin/sh
   2 # (*
   3 exec ocamlfattop "$0"
   4 *) directory ".";;
   5
   6 open Str;;
   7
   8 let name_re = regexp "(\\*\\$[ \t]*\\([a-zA-Z0-9.-]*\\)[ \t]*\\*)";;
   9 let subst_re = regexp "[<>&'%]";;
  10
  11 let begin_entity name =
  12   "<!ENTITY " ^  name ^ " '";;
  13
  14 let end_entity () =
  15   "'>\n"
  16 ;;
  17
  18
  19 let text = ref "" in
  20 let within_entity = ref false in
  21 try
  22   while true do
  23     let line = read_line() in
  24     if string_match name_re line 0 then begin
  25       let name = matched_group 1 line in
  26       if !within_entity then
  27         text := !text ^ "\n" ^ end_entity();
  28       within_entity := false;
  29       if name <> "-" then begin
  30         text := !text ^ begin_entity name;
  31         within_entity := true
  32       end
  33     end
  34     else
  35       if !within_entity then begin
  36         let line' =
  37           global_substitute subst_re
  38             (fun s ->
  39                let s' = matched_group 0 s in
  40                match s' with
  41                    "<" -> "&lt;"
  42                  | ">" -> "&gt;"
  43                  | "&" -> "&amp;"
  44                  | "'" -> "&apos;"
  45                  | "%" -> "&percent;"
  46                  | _ -> assert false)
  47             line
  48         in
  49         text := !text ^ "\n" ^ line'
  50       end
  51   done;
  52 with End_of_file ->
  53   if !within_entity then
  54     text := !text ^ "\n" ^ end_entity();
  55   print_string !text
  56 ;;