381 lines · 11.8 KB · Text
RawDownload
(* Help -- a simple Moscow ML library browser, PS 1995-04-30, 2000-04-22 Invoking `help s' has the following effect:  (a) s is normalized to lower case (b) if s is the empty string, then the help browser is invoked with the      message !welcome; (c) otherwise, if the term s appears in !specialfiles, then the browser      is invoked with the file associated with s; (d) otherwise, if the term appears in one of the index files in     !indexfiles, then the help system asks the user to choose which     help file to load, in case there are several, and invokes the     browser with that file; (e) otherwise, a standard error message is shown. The help system looks for help files in the -stdlib and in thedirectories in !helpdirs.   The browser can open a file on a specified line, attempting to centerthat lines in the display (assuming the display can hold !displayLineslines at a time). The browser accepts several commands for moving forth and back in thecurrent file. The browser's search facility cyclically searches (case-insensitive)for occurrences of a given string and displays the line in which thestring was found, as close to the center of the display (or portiondisplayed) as possible. Several hacks are being used to avoid loading too many other librariesalong with Help.*) (* The number of lines to show interactively: *) val displayLines = ref 24 (* Additional directories to search for help files *) val helpdirs = ref [] : string list ref #ifdef macintoshval slash = #":"#else val slash = #"/"#endif   fun joinDirFile dir file =    let open String     in 	if dir <> "" andalso sub(dir, size dir - 1) = slash then 	    dir ^ file	else	    dir ^ str slash ^ file            end (* Find the standard library directory: *) fun getstdlib () =     let open Vector	prim_val argv_ : string vector = 0 "command_line";	val stop = length argv_ - 1;	fun h i = 	    if i < stop then 		if sub(argv_, i) = "-stdlib" then sub(argv_, i+1)		else h (i+1)	    else		raise Fail "Cannot find the standard libraries!"    in h 0 end; (* Full path of the signature index database: *) val indexfiles = ref [joinDirFile (getstdlib ()) "helpsigs.val"] (* Mapping particular search terms to non-.sig files: *) val specialfiles = ref [{term="lib", file="README", title="Overview"}]; (* The help system's response to help "" : *) val welcome =     ref #["Moscow ML library browser: \n",	  "\n",	  "   help \"lib\";   gives an overview of the library units\n",	  "   help \"id\";    provides help on identifier id\n",	  "\n"] localfun print s = TextIO.print s (* The database reading and searching functions.  Included here only * to avoid loading yet another structure.  Types MUST agree with unit * Database in mosml/examples/helpsigs. *) datatype component =     Str					(* structure                       *)  | Exc of string			(* exception constructor with name *)  | Typ of string			(* type constructor with name      *)  | Val of string			(* value with name                 *)  | Con of string			(* value constructor with name	   *)  | Term of string * string option	(* term and optional kind          *) (* An entry consist of a component and the name of its structure: *) type entry = { comp : component, file : string, line : int } datatype 'contents table =    Empty  | Node of string * 'contents * 'contents table * 'contents table type database = entry list table fun readbase filename =    let prim_type in_channel 	type instream_  = { closed: bool, ic: in_channel } ref	prim_val input_value_ : in_channel -> 'a = 1 "intern_val"	prim_val fromI : BasicIO.instream -> instream_   = 1 "identity"        fun input_value is =	    let val ref {closed, ic} = fromI is in		if closed then		    raise SysErr("Input stream is closed", NONE)		else		    input_value_ ic	    end	val is = BasicIO.open_in_bin filename	val db = input_value is : database    in BasicIO.close_in is; db end (* Make sure tilde gets collated as a symbol, before "A": *) fun caseless(#"~", #"~") = EQUAL  | caseless(#"~", c2) =     if Char.toLower c2 < #"a" then GREATER else LESS  | caseless(c1, #"~") =     if Char.toLower c1 < #"a" then LESS else GREATER  | caseless(c1, c2) = Char.compare(Char.toLower c1, Char.toLower c2) val keycompare = String.collate caseless fun lookup(db : database, sought : string) =    let fun look Empty                      = []	  | look (Node(key, value, t1, t2)) =	    case keycompare(sought, key) of		LESS    => look t1	      | GREATER => look t2	      | EQUAL   => value    in look db end (* Auxiliaries: *) fun min (x, y) = if x < y then x else y : int;fun max (x, y) = if x < y then y else x : int; fun natFromString s =    let fun skipWS []              = []	  | skipWS (cs as (c::cr)) = if Char.isSpace c then skipWS cr else cs	fun decval c = Char.ord c - 48	fun h []      res = SOME res	  | h (c::cr) res = if Char.isDigit c then h cr (decval c + 10 * res)			    else SOME res    in 	case skipWS (String.explode s) of	    []    => NONE	  | c::cr => if Char.isDigit c then h cr (decval c)		     else NONE    end fun natToString n =    (if n > 9 then natToString (n div 10) else "")      ^ String.str (Char.chr(48 + n mod 10))    fun normalize []           = []  | normalize (#"\n" :: _) = []  | normalize (c :: cr)    = Char.toLower c :: normalize cr fun toLower s = String.implode (normalize (String.explode s)) (* The signature browser: *) fun show name centerline initiallySought (strs : string Vector.vector) =     let prim_val sub_ : string -> int -> char = 2 "get_nth_char";	prim_val int_to_string : int -> string = 1 "sml_string_of_int"; 	val lines = Vector.length strs	val sought = ref initiallySought	fun instr s str =	    let val len = String.size s		fun eq j k = 		    j >= len orelse 		    sub_ s j = Char.toLower (sub_ str k) andalso eq (j+1) (k+1)		val stop = String.size str - len		fun cmp k = k<=stop andalso (eq 0 k orelse cmp(k+1))	    in cmp 0 end;	fun occurshere str = 	    case !sought of		NONE   => false	      | SOME s => instr s str	fun findline s curr = 	    let fun h i = 		if i >= lines then NONE		else if instr s (Vector.sub(strs, (i+curr) mod lines)) then 		    SOME ((i + curr) mod lines)		else h(i+1)	    in h 0 end	val portion = max(!displayLines, 5) - 1	fun wait next = 	    let val prompt = 		"---- " ^ name ^ "[" ^ 		int_to_string((100 * next) div lines) 		^ "%]: down, up, bottom, top, /(find), next, quit: "		fun toend () = (print "\n....\n"; 				nextpart (lines - portion) portion)		fun tobeg () = (print "\n....\n"; nextpart 0 portion)		fun up   ()  = (print "\n....\n"; 				nextpart (next-3*portion div 2) portion)		fun down ()  = if next=lines then toend()			       else nextpart next (portion div 2)		fun find s =		    case findline s next of			NONE      => 			    (print ("**** String \"" ^ s ^ "\" not found\n"); 			     wait next)		      | SOME line => 			    (print "\n....\n";			     nextpart (line - portion div 2) portion)		fun search chars = 		    let val s = String.implode (normalize chars)		    in sought := SOME s; find s end		fun findnext () =		    (case !sought of			 NONE   => (print "**** No previous search string\n"; 				    wait next)		       | SOME s => find s)	    in 		print prompt;		case String.explode(BasicIO.input_line BasicIO.std_in) of		    []        => ()		  | #"q" :: _ => ()		  | #"u" :: _ => up ()		  | #"d" :: _ => down ()		  | #"t" :: _ => tobeg ()		  | #"g" :: _ => tobeg ()		  | #"b" :: _ => toend ()		  | #"G" :: _ => toend ()                  | #"/" :: s => search s                  | #"n" :: s => findnext ()		  | _         => if next=lines then toend ()				 else nextpart next portion	    end	and nextpart first amount = 	    let val start = max(0, min(lines - amount + 1, first))		val stop  = min(start + amount, lines)	    in prt wait start stop end	and prt wait i stop = 	    if i >= stop then wait i	    else 		let val line = Vector.sub(strs, i) 		in 		    if occurshere line then print "@>" else print "+ ";		    print line; 		    prt wait (i+1) stop		end    in 	print "\n";	if lines <= portion then prt ignore 0 lines	else nextpart (centerline - portion div 2) portion    end (* Read a signature file from the standard library: *) fun readfile file =     let fun openFile [] = 	    raise Fail ("Help.readFile: help file `" ^ file ^ "' not found")	  | openFile (dir1 :: dirr) =		(BasicIO.open_in (joinDirFile dir1 file))		handle SysErr _ => openFile dirr	val is = openFile (getstdlib () :: !helpdirs)	fun h () = if BasicIO.end_of_stream is then []		   else BasicIO.input_line is :: h ()    in Vector.fromList (h ()) end; (* Invoke the browser on a particular line of a signature: *) fun showFile sought entry =     (case entry of 	 {comp = Str, file, ...} => 	     show file 0 NONE (readfile (file ^ ".sig"))       | {comp = Term _, file, line} => 	     show file line NONE (readfile file)       | {comp, file, line} => 	     show file line (SOME sought) (readfile (file ^ ".sig")))    handle SysErr _ => raise Fail "Help.showFile: inconsistent help database" (* Let the user select from the menu: *) fun choose sought entries =    let val _ = print "\nChoose number to browse, or quit: ";	val response = BasicIO.input_line BasicIO.std_in    in 	case natFromString response of	    NONE => (case String.explode response of			  []        => ()	                | [#"\n"]   => ()			| #"Q" :: _ => () 			| #"q" :: _ => () 			| _         => choose sought entries)	  | SOME choice => 		if choice = 0 then ()		else showFile sought (List.nth(entries, choice - 1))    end    handle Subscript => choose sought entries	 | Overflow  => choose sought entries; (* Display the menu of identifiers matching the given one, or * invoke the browser directly if these is only one match:  *) fun display sought []                  = raise Fail "Help.display"  | display sought [entry]             = showFile sought entry  | display sought (entries as e0::er) =     let fun render (entry as {comp, file, ...}) =	    case comp of		Str    => "structure " ^ file	      | Exc id => "exn  " ^ file ^ "." ^ id	      | Typ id => "type " ^ file ^ "." ^ id	      | Val id => "val  " ^ file ^ "." ^ id	      | Con id => "con  " ^ file ^ "." ^ id	      | Term (id, NONE)      => id ^ " (" ^ file ^ ")"	      | Term (id, SOME kind) => kind ^ " " ^ id ^ " (" ^ file ^ ")"	fun maxlen []         max = max	  | maxlen (e1 :: er) max = 	    let val len = size (render e1)	    in maxlen er (if len > max then len else max) end	val maxwidth = maxlen er (size (render e0))	val boxwidth = 6 + 3 + 3 + maxwidth + 2	val horizontal = StringCvt.padRight #"-" boxwidth "    " ^ "\n" 	fun prline lin [] = ()	  | prline lin (e1 :: rest) =	    (print "    | "; 	     print (StringCvt.padLeft #" " 3 (natToString lin)); 	     print " | ";	     print (StringCvt.padRight #" " maxwidth (render e1)); 	     print " |\n";	     prline (lin+1) rest)    in 	print "\n"; 	print horizontal;	prline 1 entries;	print horizontal;	choose sought entries    end in (* Main help function: search for a string in the signature index database: *)			fun defaultBrowser ""    = show "help"     0 NONE (!welcome)  | defaultBrowser "lib" = show "Overview" 0 NONE (readfile "README")  | defaultBrowser id    =     let fun getdb filename = 	    (readbase filename)	    handle SysErr _ => raise Fail "Cannot read help database!"	val sought = toLower id	fun lookone(dbn, res) = lookup(getdb dbn, sought) :: res	fun tryspecial [] = 	    (case List.concat(List.foldl lookone [] (!indexfiles)) of		 [] => 		     print ("\nSorry, no help on identifier `" ^ id ^ "'\n\n")	       | entries  => display sought entries)	  | tryspecial ({term, file, title} :: rest) =	    if term = sought then show title 0 NONE (readfile file)	    else tryspecial rest    in 	tryspecial (!specialfiles)    endval browser = ref defaultBrowserfun help s = !browser s   end