Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/3/3579

Text File | 1991-07-02 | 20KB | 680 lines

Newsgroups: alt.sources
From: [e-mail] (Richard L. Goerwitz)
Subject: kjv browser, part 3 of 11
Message-ID: <[e-mail]>
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              [e-mail]
   [e-mail]         rutgers!oddjob!gide!sophist!goer