#! /bin/sh # (* exec /opt/godi/bin/ocaml "$0" "$@" *) directory ".";; (* $Id$ * ---------------------------------------------------------------------- * *) #use "topfind";; #require "findlib";; #require "unix";; #require "str";; #require "cgi";; (*-CUT-*) (* ---------------------------------------------------------------------- *) let cgi = new Netcgi.std_activation ~operating_type:Netcgi.buffered_transactional_optype ();; let param n = (cgi # argument n) # value;; let print s = cgi # output # output_string s;; let cancel() = cgi # output # rollback_work();; let commit() = cgi # output # commit_work();; (* ---------------------------------------------------------------------- *) let list_directory d = try let dd = Unix.opendir d in let rec read () = try let name = Unix.readdir dd in if name <> "." & name <> ".." then name :: read() else read() with End_of_file -> Unix.closedir dd; [] in read() with Unix.Unix_error (code,_,_) -> prerr_endline ("Warning: cannot read directory " ^ d ^ ": " ^ Unix.error_message code); [] ;; let all_packages() = let l = Fl_package_base.list_packages() in Sort.list ( <= ) l ;; let modules_of_pkg pkg = try List.map String.capitalize (Str.split (Str.regexp "[ \t]*\\([ \t]\\|,\\)[ \t]*") (Findlib.package_property [] pkg "browse_interfaces")) with Not_found -> let d = Findlib.package_directory pkg in let l = list_directory d in let re = Str.regexp "^\\(.*\\)\\.cmi$" in List.flatten (List.map (fun f -> if Str.string_match re f 0 then [String.capitalize (Str.matched_group 1 f)] else []) l) ;; (* ---------------------------------------------------------------------- *) let escape_html = Netencoding.Html.encode ~in_enc:`Enc_iso88591 () ;; type text = Highlighted of string | Normal of string ;; let read_file path = let fd = open_in path in let rec read () = try let line = input_line fd in Normal line :: Normal "\n" :: read() with End_of_file -> [] in let t = read() in close_in fd; t ;; let rec highlight re t = let rec highlight_string s k = if k < String.length s then begin try let k' = Str.search_forward re s k in let x1 = Normal (String.sub s k (k'-k)) in let x2 = Highlighted (Str.matched_string s) in let x3 = highlight_string s (Str.match_end()) in x1 :: x2 :: x3 with Not_found -> [ Normal (String.sub s k (String.length s - k)) ] end else [] in match t with Highlighted s :: t' -> Highlighted s :: highlight re t' | Normal s :: t' -> highlight_string s 0 @ highlight re t' | [] -> [] ;; let rec somewhere_highlighted t = match t with Normal s :: t' -> somewhere_highlighted t' | Highlighted s :: t' -> true | [] -> false ;; let highlighted_lines t = let rec extract this_line t = match t with Normal "\n" :: t' -> extract t' t' | Normal s :: t' -> extract this_line t' | Highlighted s :: t' -> extract_line this_line | [] -> [] and extract_line this_line = match this_line with Normal "\n" :: l' -> Normal "\n" :: extract l' l' | [] -> [] | x :: l' -> x :: extract_line l' in extract t t ;; let rec print_text t = match t with Normal s :: t' -> print (escape_html s); print_text t' | Highlighted s :: t' -> print ""; print (escape_html s); print ""; print_text t' | [] -> () ;; (* ---------------------------------------------------------------------- *) let action() = let pkg = try Str.split (Str.regexp ",") (param "pkg") with Not_found -> [] in let modules = try Str.split (Str.regexp ",") (param "mod") with Not_found -> [] in let searchmod = try param "searchmod" with Not_found -> "" in let searchtext = try param "searchtext" with Not_found -> "" in let hlight = try param "hlight" with Not_found -> "" in let pkg_url p = "" ^ escape_html p ^ "" in let mod_url p m = "" ^ escape_html m ^ "" in let mod_url_hl p m hl = "" ^ escape_html m ^ "" in (*** headline ***) cgi # set_header(); print "Objective Caml Packages\n"; print "\n"; print "

Objective Caml Packages

\n"; (*** package list ***) let n_cols = 6 in let l_packages = all_packages() in let packages = Array.of_list l_packages in let n = Array.length packages in let n_rows = (n-1)/n_cols + 1 in print "\n"; for row = 0 to n_rows - 1 do print "\n"; for col = 0 to n_cols - 1 do let k = col * n_rows + row in if k < n then begin print "\n"; end done; print "\n"; done; print "
"; print (pkg_url packages.(k)); print "
\n"; (*** searched modules ***) if searchmod <> "" then begin print "

Results of module search

\n"; let l1 = Str.split_delim (Str.regexp "\\*") searchmod in let s1 = "^" ^ String.concat ".*" (List.map Str.quote l1) ^ "$" in let r1 = Str.regexp_case_fold s1 in let rec search_pkg pl = match pl with [] -> [] | p :: pl' -> let modules = Sort.list ( <= ) (modules_of_pkg p) in let found_modules = List.flatten (List.map (fun m -> if Str.string_match r1 m 0 then [m] else []) modules) in List.map (fun m -> p,m) found_modules @ search_pkg pl' in let result = search_pkg l_packages in if result = [] then print "Sorry, nothing found.\n" else begin print "\n"; List.iter (fun (p,m) -> print "\n"; print ("\n"); print ("\n"); print "\n") result; print "
Package " ^ pkg_url p ^ "Module " ^ mod_url p m ^ "
\n" end end; (*** full-text search ***) if searchtext <> "" then begin print "

Results of full-text search

\n"; let l1 = Str.split_delim (Str.regexp "\\*") searchtext in let s1 = String.concat ".*" (List.map Str.quote l1) in let r1 = Str.regexp_case_fold s1 in let rec search_pkg pl = match pl with [] -> [] | p :: pl' -> let p_dir = Findlib.package_directory p in let modules = Sort.list ( <= ) (modules_of_pkg p) in let found = List.flatten (List.map (fun m -> let m_file = String.uncapitalize m ^ ".mli" in let m_path = Filename.concat p_dir m_file in if Sys.file_exists m_path then begin let t = read_file m_path in let t' = highlight r1 t in if somewhere_highlighted t' then let lines = highlighted_lines t' in [p,m,lines] else [] end else []) modules) in found @ search_pkg pl' in let result = search_pkg l_packages in if result = [] then print "Sorry, nothing found.\n" else begin print "\n"; List.iter (fun (p,m,lines) -> print "\n"; print ("\n"); print ("\n"); print "\n"; print "\n"; print "\n") result; print "
Package " ^ pkg_url p ^ "Module " ^ mod_url_hl p m s1 ^ "
\n";
	  print_text lines;
	  print "
\n" end end; (*** selected packages ***) List.iter (fun p -> if List.mem p l_packages then begin let p_html = escape_html p in print ("

Package " ^ p_html ^ "

\n"); let version = try Findlib.package_property [] p "version" with Not_found -> "unknown" in let description = try Findlib.package_property [] p "description" with Not_found -> "none" in let uses_pkg = Findlib.package_ancestors [] p in let pkg_mods = Sort.list ( <= ) (modules_of_pkg p) in print "\n"; print "\n"; print "\n"; print ("\n"); print "\n"; print "\n"; print "\n"; print ("\n"); print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
Version:" ^ escape_html version ^ "
Description:" ^ escape_html description ^ "
Ancestors:"; if uses_pkg = [] then print "none" else print (String.concat ", " (List.map pkg_url uses_pkg)); print "
Modules:"; if pkg_mods = [] then print "none" else print (String.concat ", " (List.map (mod_url p) pkg_mods)); print "
\n"; end) pkg; (*** selected modules ***) if List.length pkg = 1 then begin let p = List.hd pkg in let p_dir = Findlib.package_directory p in List.iter (fun m -> let m_html = escape_html m in print ("

Module " ^ m_html ^ "

\n"); let m_file = String.uncapitalize m ^ ".mli" in let m_path = Filename.concat p_dir m_file in if Sys.file_exists m_path then begin print "
\n";
	  let t = read_file m_path in
	  let t' = 
	    if hlight <> "" then
	      highlight (Str.regexp_case_fold hlight) t
	    else
	      t
	  in
	  print_text t';
	  print "
\n" end else print "Sorry, no printable interface definition found.") modules end; (*** search ***) print "

Search

\n"; print "You may use * as wildcard character.
\n"; print "
\n"; print "\n"; print "\n"; print ""; print ""; print "\n"; print "\n"; print "\n"; print ""; print ""; print "\n"; print "\n"; print "
Search toplevel module:
Full-text search:
\n"; print "
\n"; print "\n" ;; begin try action() with e -> cgi # set_header(); print "

Software error

\n"; print (Printexc.to_string e); print "\n"; end; commit()