Source Code 1992 March

home *** CD-ROM | disk | FTP | other *** search

/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 3 / 3579 < prev next >

Wrap

Text File | 1991-07-03 | 19.8 KB | 680 lines

Newsgroups: alt.sources From: goer@ellis.uchicago.edu (Richard L. Goerwitz) Subject: kjv browser, part 3 of 11 Message-ID: <1991Jul3.065005.27989@midway.uchicago.edu> Date: Wed, 3 Jul 1991 06:50:05 GMT ---- Cut Here and feed the following to sh ---- #!/bin/sh # this is bibleref.03 (part 3 of a multipart archive) # do not concatenate these parts, unpack them in order with /bin/sh # file srchutil.icn continued # if test ! -r _shar_seq_.tmp; then echo 'Please unpack part 1 first!' exit 1 fi (read Scheck if test "$Scheck" != 3; then echo Please unpack part "$Scheck" next! exit 1 else exit 0 fi ) < _shar_seq_.tmp || exit 1 if test ! -f _shar_wnt_.tmp; then echo 'x - still skipping srchutil.icn' else echo 'x - continuing file srchutil.icn' sed 's/^X//' << 'SHAR_EOF' >> 'srchutil.icn' && X# X# Name: srchutil.icn X# X# Title: search utilities for bibleref X# X# Author: Richard L. Goerwitz X# X# Version: 1.5 X# X############################################################################ X# X# Contains: X# X# compose_search(), which compiles a little automaton which, when X# run via do_search(), returns a list of hits (i.e. retrieve- X# format bitmaps), X# X# do_search(), on which see above, X# X# various other utilities (e.g. compose_spaced_search()) X# X############################################################################ X# X# Links: ./complete.icn X# X# See also: bibleref.icn X# X############################################################################ X X# for debugging X# link ximage X Xprocedure search_database() X X # X # Search database for word or patterns matching whole words. X # X local search_machine, result, string_memb, tmp X X search_machine := compose_search() | { X err_message("No search performed. Aborting.") X fail X } X X # for debugging purposes X # write(&errout, ximage(search_machine)) X X if *search_machine > 4 X then message("Executing complex search...") X else message("Executing search...") X *(result := do_search(search_machine)[1]) > 0 | { X err_message("No hits.") X fail X } X X # X # Nasty kludge to see what search strings were incorporated into the X # search_machine. X # X string_memb := "???" X tmp := search_machine[2] X repeat { X if type(tmp) == "string" then X string_memb := tmp & break X else if type(tmp) == "list" then X tmp := tmp[2] X else break X } X if *search_machine > 4 then string_memb ||:= "..." X X if type(result) == "set" then result := sort(result) X put(lists, lst(result, 0, &null, string_memb)) X return lists[-1] X Xend X X X Xprocedure compose_search() X X # X # Put together a little search machine out of patterns specified by X # the user. Don't execute, though. Just return a list containing X # the user's directions to the calling procedure, and let it handle X # execution (via do_search()). X # X X local pattern, status, sense_of_search, rsp, result, u, r X static blanks X initial blanks := ' \t,' X X if pos(0) X then rsp := trim(snarf_input("Enter word (q to abort): "), blanks) X else return compose_spaced_search(blanks) X X rsp == (""|"q") & fail X if rsp ? (="!", pattern := tab(many(blanks)), tab(0)) then X sense_of_search := "inverted" X else pattern := rsp X X result := [retrieve, pattern, kjv_filename, sense_of_search] X repeat { X status := map(snarf_input("f to finish, or a/o/n (q aborts): ")) X if upto(blanks, rsp) then X # And together all words in the input string. X return rsp ? compose_spaced_search(blanks) X if status == "f" then X return result X else if status == ("a"|"n"|"o") then { X if status ~== "o" then { X u := GetUnit() | next X r := GetRange() | next X } X return case status of { X "a" : [r_and, result, compose_search(), kjv_filename, u, r] X "o" : [r_and, result, compose_search(), kjv_filename, u, r] X "n" : [r_and, result, compose_search(), kjv_filename, u, r] X } | fail X } X else if status == (""|"q") then fail X else err_message("F = finish, a = and, o = or, n = and-not.") X } X Xend X X X Xprocedure GetUnit() X X local resp X X repeat { X resp := map(snarf_input("Enter unit (b/c/v): ")) X case resp of { X "b" : return 1 X "c" : return 2 X "v" : return 3 X "q"|"" : fail X default : { X err_message("Enter b (book), c (chapter), or v (verse).") X next X } X } X } X Xend X X X Xprocedure GetRange() X X local resp X X repeat { X resp := map(snarf_input("Enter range: ")) X if resp := integer(resp) then X return resp X else { X resp == ("q"|"") & fail X err_message("Enter b (book), c (chapter), or v (verse).") X next X } X } X Xend X X X Xprocedure do_search(l) X X # X # Executes the little machine put together by compose_search(). X # X X if *l = 0 X then return l X X case type(l[1]) of { X "list" : return do_search(l[1]) ||| do_search(l[2:0]) X "procedure" : return [l[1]!do_search(l[2:0])] | [[]] X default : return [l[1]] ||| do_search(l[2:0]) X } X Xend X X X Xprocedure compose_spaced_search(blanks) X X # X # Try to turn searches with spaces in them (e.g. "sackcloth and ashes") X # into separate searches for each constituent word anded together. X # This routine is set up, though, to handle single words or patterns X # as well (e.g. "sackcloth"). X # X X local token, sense_of_search, search_list, dumb_move X static wordchars X initial wordchars := ~blanks X X # X # Whoops, no string. This shouldn't happen, but just in case I screw X # up somewhere in the code, and forget to strip out superfluous blanks X # typed in by the user... X # X tab(upto(wordchars)) | { X err_message("No search string. Aborting.") X fail X } X if ="!" then { X sense_of_search := 1 X tab(upto(wordchars)) X } X token := tab(many(wordchars)) | { X err_message("Unexpected end of input. Aborting") X fail X } X X # X # Make sure tokens aren't just wildcard patterns! Also, warn the X # user about searches containing really common words. X # X upto(&letters, token) | { X err_message("Token "||token||" has no letters in it!") X fail X } X token == (dumb_move := "and"|"the"|"a") & { X err_message("Try not to use common words like \""||dumb_move||".\"") X } X X # X # If we've reached the end of the search string, return what we X # have... X # X search_list := [retrieve, token, kjv_filename, sense_of_search] X pos(0) & (return search_list) X X # X # ...otherwise and this search string together with the next one, X # X return [r_and, search_list, X compose_spaced_search(blanks), X kjv_filename, 3, 0] X Xend SHAR_EOF echo 'File srchutil.icn is complete' && true || echo 'restore of srchutil.icn failed' rm -f _shar_wnt_.tmp fi # ============= complete.icn ============== if test -f 'complete.icn' -a X"$1" != X"-c"; then echo 'x - skipping complete.icn (File already exists)' rm -f _shar_wnt_.tmp else > _shar_wnt_.tmp echo 'x - extracting complete.icn (Text)' sed 's/^X//' << 'SHAR_EOF' > 'complete.icn' && X############################################################################ X# X# Name: complete.icn X# X# Title: complete partial input string X# X# Author: Richard L. Goerwitz X# X# Version: 1.7 X# X############################################################################ X# X# This file contains a single procedure, complete(s,st), which X# completes a string (s) relative to a set or list of strings (st). X# Put differently, complete() lets you supply a partial string, s, X# and get back those strings in st that s is either equal to or a X# substring of. X# X# Lots of command interfaces allow completion of partial input. X# Complete() simply represents my personal sentiments about how this X# might best be done in Icon. If you strip away the profuse comments X# below, you end up with only about thirty lines of actual source X# code. X# X# I have arranged things so that only that portion of an automaton X# which is needed to complete a given string is actually created and X# stored. Storing automata for later use naturally makes complete() X# eat up more memory. The performance gains can make it worth the X# trouble, though. If, for some reason, there comes a time when it X# is advisable to reclaim the space occupied by complete's static X# structures, you can just call it without arguments. This X# "resets" complete() and forces an immediate garbage collection. X# X# Example code: X# X# commands := ["run","stop","quit","save","load","continue"] X# while line := read(&input) do { X# cmds := list() X# every put(cmds, complete(line, commands)) X# case *cmds of { X# 0 : input_error(line) X# 1 : do_command(cmds[1]) X# default : display_possible_completions(cmds) X# } X# etc... X# X# More Iconish methods might include displaying successive X# alternatives each time the user presses the tab key (this would, X# however, require using the nonportable getch() routine). Another X# method might be to use the first string suspended by complete(). X# X# NOTE: This entire shebang could be replaced with a slightly slower X# and much smaller program suggested to me by Jerry Nowlin and Bob X# Alexander. X# X# procedure terscompl(s, st) X# suspend match(s, p := !st) & p X# end X# X# This program will work fine for lists with just a few members, and X# also for cases where s is fairly large. It will also use much less X# memory. X# X############################################################################ X# X# Links: none X# X############################################################################ X X X Xprocedure complete(s,st) X X local dfstn, c, l, old_chr, chr, newtbl, str, strset X static t X initial t := table() X X # No-arg invocation wipes out static structures & causes an X # immediate garbage collection. X if /s & /st then { X t := table() X collect() # do it NOW X fail X } X type(st) == ("list"|"set") | X stop("error (complete): list or set expected for arg2") X X # Seriously, all that's being done here is that possible states X # are being represented by sets containing possible completions of X # s relative to st. Each time a character is snarfed from s, we X # check to see what strings in st might represent possible X # completions, and store these in yet another set. At some X # point, we either run into a character in s that makes comple- X # tion impossible (fail), or we run out of characters in s (in X # which case we succeed, & suspend each of the possible X # completions). X X # Store any sets we have to create in a static structure for later X # re-use. X /t[st] := table() X X # We'll call the table entry for the current set dfstn. (It really X # does enable us to do things deterministically.) X dfstn := t[st] X X # Snarf one character at a time from s. X every c := !s do { X X # The state we're in is represented by the set of all possible X # completions before c was read. If we haven't yet seen char X # c in this state, run through the current-possible-completion X # set, popping off the first character of each possible X # completion, and then construct a table which uses these X # initial chars as keys, and makes the completions that are X # possible for each of these characters into the values for X # those keys. X if /dfstn[st] then { X X # To get strings that start with the same char together, X # sort the current string set (st). X l := sort(st) X newtbl := table() X old_chr := "" X # Now pop off each member of the sorted string set. Use X # first characters as keys, and then divvy up the full strings X # into sets of strings having the same initial letter. X every str := !l do { X str ? { chr := move(1) | next; str := tab(0) } X if old_chr ~==:= chr then { X strset := set([str]) X insert(newtbl, chr, strset) X } X else insert(strset, str) X } X insert(dfstn, st, newtbl) X } X X # What we've done essentially is to create a table in which X # the keys represent labeled arcs out of the current state, X # and the values represent possible completion sets for those X # paths. What we need to do now is store that table in dfstn X # as the value of the current state-set (i.e. the current X # range of possible completions). Once stored, we can then X # see if there is any arc from the current state (dfstn[st]) X # with the label c (dfstn[st][c]). If so, its value becomes X # the new current state (st), and we cycle around again for X # yet another c. X st := \dfstn[st][c] | fail X if *st = 1 & match(s,!st) X then break X } X X # Eventually we run out of characters in c. The current state X # (i.e. the set of possible completions) can simply be suspended X # one element at a time, with s prefixed to each element. If, for X # instance, st had contained ["hello","help","hear"] at the outset X # and s was equal to "hel", we would now be suspending "hel" || X # !set(["lo","p"]). X suspend s || !st X Xend SHAR_EOF true || echo 'restore of complete.icn failed' rm -f _shar_wnt_.tmp fi # ============= ipause.icn ============== if test -f 'ipause.icn' -a X"$1" != X"-c"; then echo 'x - skipping ipause.icn (File already exists)' rm -f _shar_wnt_.tmp else > _shar_wnt_.tmp echo 'x - extracting ipause.icn (Text)' sed 's/^X//' << 'SHAR_EOF' > 'ipause.icn' && X############################################################################ X# X# Name: ipause.icn X# X# Title: pause within an Icon program X# X# Author: Richard L. Goerwitz X# X# Version: 1.2 X# X############################################################################ X# X# Ipause(i) - pause i milliseconds (accuracy depends on the resolution X# of the system clock). Would be nice if Icon had a nap() function, so X# that we didn't just have to loop. Of course, for operating systems X# that don't support all this multitasking nonsense, ipause() will do X# just fine. X# X############################################################################ X X Xprocedure ipause(i) X X local T X T := &time X until &time >= (T + i) X return X Xend SHAR_EOF true || echo 'restore of ipause.icn failed' rm -f _shar_wnt_.tmp fi # ============= rewrap.icn ============== if test -f 'rewrap.icn' -a X"$1" != X"-c"; then echo 'x - skipping rewrap.icn (File already exists)' rm -f _shar_wnt_.tmp else > _shar_wnt_.tmp echo 'x - extracting rewrap.icn (Text)' sed 's/^X//' << 'SHAR_EOF' > 'rewrap.icn' && X############################################################################ X# X# Name: rewrap.icn X# X# Title: advanced line rewrap utility X# X# Author: Richard L. Goerwitz X# X# Version: 1.3 X# X############################################################################ X# X# The procedure rewrap(s,i), included in this file, reformats text X# fed to it into strings < i in length. Rewrap utilizes a static X# buffer, so it can be called repeatedly with different s arguments, X# and still produce homogenous output. This buffer is flushed by X# calling rewrap with a null first argument. The default for X# argument 2 (i) is 70. X# X# Here's a simple example of how rewrap could be used. The following X# program reads the standard input, producing fully rewrapped output. X# X# procedure main() X# every write(rewrap(!&input)) X# write(rewrap()) X# end X# X# Naturally, in practice you would want to do things like check for in- X# dentation or blank lines in order to wrap only on a paragraph-by para- X# graph basis, as in X# X# procedure main() X# while line := read(&input) do { X# if line == "" then { X# "" ~== write(rewrap()) X# write(line) X# } else { X# if match("\t", line) then { X# write(rewrap()) X# write(rewrap(line)) X# } else { X# write(rewrap(line)) X# } X# } X# } X# end X# X# Fill-prefixes can be implemented simply by prepending them to the X# output of rewrap: X# X# i := 70; fill_prefix := " > " X# while line := read(input_file) do { X# line ?:= (f_bit := tab(many('> ')) | "", tab(0)) X# write(fill_prefix || f_bit || rewrap(line, i - *fill_prefix)) X# etc. X# X# Obviously, these examples are fairly simplistic. Putting them to X# actual use would certainly require a few environment-specific X# modifications and/or extensions. Still, I hope they offer some X# indication of the kinds of applications rewrap might be used in. X# X# Note: If you want leading and trailing tabs removed, map them to X# spaces first. Rewrap only fools with spaces, leaving tabs intact. X# This can be changed easily enough, by running its input through the X# Icon detab() function. X# X############################################################################ X# X# See also: wrap.icn X# X############################################################################ X X Xprocedure rewrap(s,i) X X local extra_bit, line X static old_line X initial old_line := "" X X # Default column to wrap on is 70. X /i := 70 X # Flush buffer on null first argument. X if /s then { X extra_bit := old_line X old_line := "" X return "" ~== extra_bit X } X X # Prepend to s anything that is in the buffer (leftovers from the last s). X s ?:= { tab(many(' ')); old_line || trim(tab(0)) } X X # If the line isn't long enough, just add everything to old_line. X if *s < i then old_line := s || " " & fail X X s ? { X X # While it is possible to find places to break s, do so. X while any(' -',line := EndToFront(i),-1) do { X # Clean up and suspend the last piece of s tabbed over. X line ?:= (tab(many(' ')), trim(tab(0))) X if *&subject - &pos + *line > i X then suspend line X else { X old_line := "" X return line || tab(0) X } X } X X # Keep the extra section of s in a buffer. X old_line := tab(0) X X # If the reason the remaining section of s was unrewrapable was X # that it was too long, and couldn't be broken up, then just return X # the thing as-is. X if *old_line > i then { X old_line ? { X if extra_bit := tab(upto(' -')+1) || (tab(many(' ')) | "") X then old_line := tab(0) X else extra_bit := old_line & old_line := "" X return trim(extra_bit) X } X } X # Otherwise, clean up the buffer for prepending to the next s. X else { X # If old_line is blank, then don't mess with it. Otherwise, X # add whatever is needed in order to link it with the next s. X if old_line ~== "" then { X # If old_line ends in a dash, then there's no need to add a X # space to it. X if old_line[-1] ~== "-" X then old_line ||:= " " X } X } X } X Xend X X X Xprocedure EndToFront(i) X # Goes with rewrap(s,i) X *&subject+1 - &pos >= i | fail X suspend &subject[.&pos:&pos <- &pos+i to &pos by -1] Xend SHAR_EOF true || echo 'restore of rewrap.icn failed' rm -f _shar_wnt_.tmp fi # ============= binsrch.icn ============== if test -f 'binsrch.icn' -a X"$1" != X"-c"; then echo 'x - skipping binsrch.icn (File already exists)' rm -f _shar_wnt_.tmp else > _shar_wnt_.tmp echo 'x - extracting binsrch.icn (Text)' sed 's/^X//' << 'SHAR_EOF' > 'binsrch.icn' && X############################################################################ X# X# Name: binsrch.icn X# X# Title: general-purpose binary index search X# X# Author: Richard L. Goerwitz X# X# Version: 1.4 X# X############################################################################ SHAR_EOF true || echo 'restore of binsrch.icn failed' fi echo 'End of part 3' echo 'File binsrch.icn is continued in part 4' echo 4 > _shar_seq_.tmp exit 0 -- -Richard L. Goerwitz goer%sophist@uchicago.bitnet goer@sophist.uchicago.edu rutgers!oddjob!gide!sophist!goer