Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume23/quranref/part05

Text File | 1991-10-19 | 32.2 KB | 935 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Richard L. Goerwitz)
Subject:  v23i071:  quranref - Holy Qur'an word and passage based retrievals, Part05/08
Message-ID: <[e-mail]>
X-Md4-Signature: 4dbe78443e8af50cea3a89f1ce65eaf6
Date: Sat, 19 Oct 1991 02:23:16 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Richard L. Goerwitz)
Posting-number: Volume 23, Issue 71
Archive-name: quranref/part05
Environment: Icon

---- Cut Here and feed the following to sh ----
#!/bin/sh
# this is quranref.05 (part 5 of a multipart archive)
# do not concatenate these parts, unpack them in order with /bin/sh
# file indexutl.icn continued
#
if test ! -r _shar_seq_.tmp; then
    echo 'Please unpack part 1 first!'
    exit 1
fi
(read Scheck
 if test "$Scheck" != 5; 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 indexutl.icn'
else
echo 'x - continuing file indexutl.icn'
sed 's/^X//' << 'SHAR_EOF' >> 'indexutl.icn' &&
X        no -:= 1
X        tab(upto(&digits))
X        bitmap +:= ishift(field, no * IS.len)
X        }
X    }
X    # If we're not at the end of the line, then we've got a
X    # a problem with the portion of the input file passed
X    # to digits_2_bitmap as s (arg1).
X    pos(0) | abort("digits_2_bitmap",
X               "malformed position marker:  "||s,
X               11)
X    }
X
X    # If the current no is not -1, then we have either too
X    # many or too few fields, i.e. someone wrote, say, 01:02:03 in
X    # a text which he or she declared as having four fields.
X    no = 0 | abort("digits_2_bitmap",
X    no || " fields in "||s||" (expected "||IS.no||")",
X    12)
X    # write(&errout,"bitmap = ",radcon(bitmap,10,2))  # for debugging
X    return bitmap
X
Xend
SHAR_EOF
echo 'File indexutl.icn is complete' &&
true || echo 'restore of indexutl.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= retrops.icn ==============
if test -f 'retrops.icn' -a X"$1" != X"-c"; then
    echo 'x - skipping retrops.icn (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting retrops.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'retrops.icn' &&
X############################################################################
X#
X#    Name:     retrops.icn
X#
X#    Title:     logical operations for retrievals
X#
X#    Author:     Richard L. Goerwitz
X#
X#    Version: 1.17
X#
X############################################################################
X#
X#  The following collection of procedures implements logical
X#  and/or/and_not operations for the retrieve text-retrieval package.
X#  Their general form is
X#
X#      r_op(set1, set2, filename, field, range)
X#
X#  where op = one of either and, or, or and_not.  The field and range
X#  arguments are optional.
X#
X#  To illustrate how these operations are performed, let me explain
X#  how one of the procedures below, r_and(), works.  Let us assume we
X#  have retrieve()d bitmap sets for two patterns in a single indexed
X#  file.  Call the sets set1 and set2.  Call the file filename.  These
X#  two sets are passed to r_and() as arguments one and two.  R_and()
X#  takes the intersection of these two sets.  The result is a
X#  collection of all bitmaps pointing to blocks in filename containing
X#  words matching *both* of the two patterns used to generate set1 and
X#  set2.  R_and() returns this result to the calling procedure.
X#
X#  Note that, by default, r_and() retrieves co-ocurrences of patterns
X#  within a single block.  If the programmer wishes to find
X#  co-ocurrences within larger units, he or she may supply a field
X#  argument.  Fields are fixed width bit-fields into which location
X#  markers for filename are divided, numbered from the largest and
X#  most general to the smallest and most specific.  See the file
X#  makeind for a discussion of how they are handled.  A range
X#  parameter may also be specified, which makes it possible to look
X#  for coocurrences in collections of more than one unit of the type
X#  specified in the field argument.
X#
X############################################################################
X#
X#  Links: none
X#
X#  See also: retrieve.icn, makeind.icn
X#
X############################################################################
X
X# The following globals contain stats for current file (here, arg 3).
X# global filestats    # declared in initfile.icn
X# global IS           # declared in indexutl.icn
X
Xprocedure r_or(set1, set2, filename, field, range)
X
X    # Check for sloppy programming.
X    /filename & abort("apply_op", "you gotta call me with a filename", 43)
X    type(set1) == ("list"|"set") |
X    abort("apply_op","arg 1 must be a list/set",45)
X    type(set2) == ("list"|"set") |
X    abort("apply_op","arg 2 must be a list/set",46)
X
X    # Be sure to convert lists to sets.  Personally, I think list -> set
X    # conversions should be as automatic in Icon as their string -> cset
X    # correspondents.
X    type(set1) == "set" | (set1 := set(set1))
X    type(set2) == "set" | (set2 := set(set2))
X
X    # No need to initialize variables.  Field and range are
X    # meaningless for this op.
X    return set1 ++ set2
X
Xend
X
Xprocedure r_and(set1, set2, filename, field, range)
X    # set intersection
X    return apply_op("**", set1, set2, filename, field, range)
Xend
X
Xprocedure r_and_not(set1, set2, filename, field, range)
X    # simpler way of saying X and not Y, or Y and not X
X    return apply_op("--", set1, set2, filename, field, range)
Xend
X
X
Xprocedure apply_op(op, set1, set2, filename, field, range)
X
X    local r_shift, tbl, elem, set1a, set2a, set3, set4, shifted_elem, elem2
X
X    # globals:
X    #
X    # IS is a global record in which will be stored important stats for
X    # the file named in arg 4 (filename).  We will be using two of IS's
X    # fields:
X    #
X    # IS.len   = the number of bits needed to hold an integer
X    #             representation of a single field in filename
X    # IS.no    = number of fields for filename
X    #
X    # Filestats is a global table which contains various important stats
X    # for every file that's been accessed.  These stats are kept in a
X    # record of type Fs
X    #
X    #     record Fs(ind_filename, bmp_filename, lim_filename, unt_filename
X    #               IS, ofs_table)
X    #
X    # Fs is declared in initfile.icn; here all we need is Fs.IS,
X    # which we access via filestats[filename].IS.  Initfile() sets up
X    # filestats for filename, but we shouldn't call it here.  It has
X    # (or should already have) been called by retrieve().
X    #
X
X    # Check for sloppy programming.
X    /filename & abort("apply_op", "you gotta call me with a filename", 43)
X    type(set1) == ("list"|"set") |
X    abort("apply_op","arg 1 must be a list/set",47)
X    type(set2) == ("list"|"set") |
X    abort("apply_op","arg 2 must be a list/set",48)
X
X    # Initialize important variables.
X    #
X    if /filestats | /filestats[filename]
X    then abort("apply_op", "can't apply_op before retrieve()ing", 44)
X    IS := filestats[filename].IS      # re-initialize IS for current file
X
X    /field := IS.no; field := IS.no - field
X    (/range := 0) | (range := abs(range))
X    IS.no >= field >= 0 | abort("apply_op", "field out of range", 40)
X    range >= 0 | abort("apply_op", "no negative ranges, please!", 41)
X
X    if field = range = 0 then {
X    type(set1) ~== "set" & set1 := set(set1)
X    type(set2) ~== "set" & set2 := set(set2)
X    # no need to shift anything around
X    return op(set1, set2)
X    } else {
X    set1a := set()
X    if field = 0 then {
X        # Great, no need to shift out any fields.
X        every elem := !set1 do {
X        if abs(elem - !set2) <= range then
X            insert(set1a, elem)
X        }
X        if op == "**"
X        then return set1a
X        else {
X        # op == "--"
X        (type(set1) == "set") | (set1 := set(set1))
X        return (set1 -- set1a)
X        }
X    }
X    # Uh oh, we need to knock out some fields!
X    else {
X        tbl := table()
X        set1a := set(); set2a := set()
X        r_shift := -(field * IS.len)
X        every elem := !set1 do {
X        shifted_elem := ishift(elem, r_shift)
X        /tbl[shifted_elem] := set()
X        insert(tbl[shifted_elem], elem)
X        insert(set1a, shifted_elem)
X        }
X        every elem := !set2 do {
X        shifted_elem := ishift(elem, r_shift)
X        op == "**" & {
X            /tbl[shifted_elem] := set()
X            insert(tbl[shifted_elem], elem)
X        }
X        insert(set2a, shifted_elem)
X        }
X        set4 := set()
X        if range = 0 then {
X        set3 := op(set1a, set2a)
X        every insert(set4, !tbl[!set3])
X                return set4
X        }
X        # Difficult stuff, field ~= verse, range ~= 0.
X        else {
X        if op == "**" then {
X            every elem := !set1a do {
X                # Range is always positive (see above; range
X                # := abs(range)).
X            if abs(elem - (elem2 := !set2a)) <= range then
X                every insert(set4, !tbl[elem|elem2])
X            }
X            return set4
X        }
X        # else if op == "--"
X        else {
X            set3 := set()
X            every elem := !set1a do {
X            if abs(elem - !set2a) <= range then {
X                insert(set3, elem)
X            }
X            }
X            every insert(set4, !tbl[!(set1a -- set3)])
X            return set4
X        }
X        }
X    }
X    }
X
Xend
SHAR_EOF
true || echo 'restore of retrops.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= whatnext.icn ==============
if test -f 'whatnext.icn' -a X"$1" != X"-c"; then
    echo 'x - skipping whatnext.icn (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting whatnext.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'whatnext.icn' &&
X###########################################################################
X#
X#    Name:     whatnext.icn
X#
X#    Title:     return next/previous bitmap in filename
X#
X#    Author:     Richard L. Goerwitz
X#
X#    Version: 1.8
X#
X###########################################################################
X#
X#  Given a bitmap and a filename, NextBitmap() and PrevBitmap() return
X#  either the next or previous bitmap in filename.  Fail if there is no
X#  next or previous bitmap.  Syntax:
X#
X#      {Next,Prev}Bitmap(bitmap, filename, start_no)
X#
X#  start_no specifies the lowest possible field value.  If null, defaults
X#  to 1.  Normally start_no will be either 1 or 0.
X#
X############################################################################
X#
X#  links:  ./indexutl.icn ./initfile.icn
X#
X############################################################################
X
X# For error messages, debugging.
Xlink radcon
X
X# Declared in indexutl.icn.
X# record is(FS, s_len, len, no, is_case_sensitive)
X# global IS
X
X# Declared in initfile.icn.
X# global filestats
X# record Fs(ind_filename, bmp_filename, lim_filename, unt_filename,
X#           IS, ofs_table)
X
X# Used here to store limits data in the static table limits_tbl.
Xrecord ldata(limitslst, limitsset)
X
X
Xprocedure PrevBitmap(bitmap, filename, start_no)
X    return PrevNextBitmap(bitmap, filename, "p", start_no)
Xend
X
Xprocedure NextBitmap(bitmap, filename, start_no)
X    return PrevNextBitmap(bitmap, filename, "n", start_no)
Xend
X
X
Xprocedure PrevNextBitmap(bitmap, filename, direction, start_no)
X
X    local limits_file, limit, bitmap_length, limitslst,
X    limitsset, field_mask, shift_bits_out, lowlimit, shift_back,
X    i, j, newbitmap
X    static limits_tbl
X    initial limits_tbl := table()
X
X    # These verses are missing from the standard Hebrew Bible.  For
X    # English, we can safely ignore them.  See below ("return newbitmap")
X    # for an explanation of how to use a weirdos set.
X    # weirdos := set(["josh 14:8","deut 23:12"])
X
X    # Check for sloppy programming.
X    /filename & abort("PrevNextBitmap", "you called me without a filename",54)
X    /start_no := 1        # default low value for fields is 1
X
X    # If necessary, initialize limits stats for the current file.
X    #
X    if /limits_tbl[filename] then {
X    if /filestats | /filestats[filename] then
X        initfile(filename)           # see initfile.icn
X    limits_file := open(filestats[filename].lim_filename) |
X        abort("PrevBitmap","can't open "||
X          filestats[filename].lim_filename ||
X          ", index with the -l [int] option", 60)
X    IS := filestats[filename].IS
X    # Figure out how many bits we need (has to be divisible by 8).
X    bitmap_length := ((IS.len * IS.no) <= seq(0,8))
X    limitslst := list(); limitsset := set()
X    shift_bits_out := -(((IS.no-IS.r_field)+ 1) * IS.len)
X    while limit := read_int(limits_file, bitmap_length) do {
X        lowlimit :=    ishift(limit, shift_bits_out)
X        # Shift back, filling remaining fields with start_no (usu. 1).
X        # Note that if IS.no - IS.r_field is 0, nothing will happen!
X        every shift_back := IS.len * (1 to (IS.no-IS.r_field)+ 1) do {
X        lowlimit := ior(ishift(lowlimit, shift_back), start_no)
X        }
X        every put(limitslst, lowlimit | limit)
X        insert(limitsset, limit)
X    }
X    close(limits_file)
X    insert(limits_tbl, filename, ldata(limitslst, limitsset))
X    }
X
X    IS := filestats[filename].IS
X    limitslst := limits_tbl[filename].limitslst
X    limitsset := limits_tbl[filename].limitsset
X    #
X    # Used to mask off the least significant field of bitmap.
X    field_mask := 2^(IS.len)-1
X    #
X    # How many bits should we shift to the right?  E.g. in biblical
X    # texts with morphological tags, we want to shift out the morpheme
X    # field, and deal only with book chapter:verse.  The rollover
X    # field (IS.r_field) is the field on which the limits file is
X    # based.  Subtract it from the total number of fields (IS.no), and
X    # then multiply it by the field width in bits (IS.len) and we get
X    # the amount to shift out in order to leave us with the rollover
X    # field in the least position.
X    #
X    shift_bits_out := -((IS.no-IS.r_field) * IS.len)
X
X    if direction == "p" then {
X    #
X    # See if the rollover field has its lowest possible value.  If
X    # so, then use the limits list to get a bitmap for the
X    # preceding section in filename.
X    #
X    if iand(ishift(bitmap, shift_bits_out), field_mask) = start_no then {
X        bitmap = limitslst[j := 1 to *limitslst] | fail
X        newbitmap := limitslst[j - 1] | fail
X    }
X    #
X    # If the rollover field doesn't have its lowest possible
X    # value, then it can simply be decremented; then the remaining
X    # fields must be reset to start_no.
X    #
X    else {
X        # Decrement appropriate field by one; direction is "p".
X        newbitmap := ishift(bitmap, shift_bits_out) - 1
X        # Shift back, filling remaining fields with start_no (usu. 1).
X        # Note that if IS.no - IS.r_field is 0, nothing will happen!
X        every shift_back := IS.len * (1 to (IS.no-IS.r_field)) do {
X        newbitmap := ior(ishift(newbitmap, shift_back), start_no)
X        }
X    }
X    return newbitmap
X        # This is how we'd handle things if we needed a weirdos set
X        # (needed, e.g., for the Hebrew Bible).
X        # if member(weirdos, newbitmap)
X        # then return WhatsNextPrevious(
X    #    newbitmap, filename, direction, start_no)
X        # else return newbitmap
X    }
X    else if direction == "n" then {
X    #
X    # See if the field after the rollover field has its highest
X    # possible value.  We can determine this by checking to see if
X    # bitmap is a member of the limits set.  If so, then use the
X    # limits *list* to get a bitmap for the next section in filename.
X    #
X    if member(limitsset,bitmap) then {
X        bitmap = limitslst[i := 1 to *limitslst] | fail
X        newbitmap := limitslst[i + 1] | fail
X    }
X    #
X    # If the rollover field doesn't have its highest possible
X    # value, then it can simply be incremented; then the remaining
X    # fields must be reset to start_no.
X    #
X    else {
X        # Increment appropriate field by one; direction is "n".
X        newbitmap := ishift(bitmap, shift_bits_out) + 1
X        # Shift back, filling remaining fields with start_no (usu. 1).
X        every shift_back := IS.len * (1 to (IS.no-IS.r_field)) do {
X        newbitmap := ior(ishift(newbitmap, shift_back), start_no)
X        }
X    }
X    return newbitmap
X        # if member(weirdos, newbitmap)
X        # then return WhatsNextPrevious(
X    #    newbitmap, filename, direction, start_no)
X        # else return newbitmap
X    }
X
X    # If we get to here, we've fed this procedure a bad bitmap, or have
X    # used the wrong filename argument.
X    abort("NextPrevBitmap", "Bad argument: 2r"||exbase10(bitmap,2), 63)
X    fail
X
Xend
SHAR_EOF
true || echo 'restore of whatnext.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= iolib.icn ==============
if test -f 'iolib.icn' -a X"$1" != X"-c"; then
    echo 'x - skipping iolib.icn (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting iolib.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'iolib.icn' &&
X########################################################################
X#
X#    Name:    iolib.icn
X#
X#    Title:    Icon termlib-type tools for MS-DOS and UNIX
X#
X#    Author:    Richard L. Goerwitz (with help from Norman Azadian)
X#
X#    Version: 1.13
X#
X#########################################################################
X#
X#  The authors place this and future versions of iolib in the public
X#  domain.
X#
X#########################################################################
X#
X#  The following library represents a series of rough functional
X#  equivalents to the standard Unix low-level termcap routines.  It is
X#  not meant as an exact termlib clone.  Nor is it enhanced to take
X#  care of magic cookie terminals, terminals that use \D in their
X#  termcap entries, or archaic terminals that require padding.  This
X#  library is geared mainly for use with ANSI and VT-100 devices.
X#  Note that this file may, in most instances, be used in place of the
X#  older UNIX-only itlib.icn file.  It essentially replaces the DOS-
X#  only itlibdos routines.  For DOS users not familiar with the whole
X#  notion of generalized screen I/O, I've included extra documentation
X#  below.  Please read it.
X#
X#  The sole disadvantage of this over the old itlib routines is that
X#  iolib.icn cannot deal with archaic or arcane UNIX terminals and/or
X#  odd system file arrangements.  Note that because these routines
X#  ignore padding, they can (unlike itlib.icn) be run on the NeXT and
X#  other systems which fail to implement the -g option of the stty
X#  command.  Iolib.icn is also simpler and faster than itlib.icn.
X#
X#  I want to thank Norman Azadian for suggesting the whole idea of
X#  combining itlib.icn and itlibdos.icn into one distribution, for
X#  suggesting things like letting drive specifications appear in DOS
X#  TERMCAP environment variables, and for finding several bugs (e.g.
X#  the lack of support for %2 and %3 in cm).  Although he is loathe
X#  to accept this credit, I think he deserves it.
X#
X#########################################################################
X#
X#  Contents:
X#
X#  setname(term)
X#    Use only if you wish to initialize itermlib for a terminal
X#  other than what your current environment specifies.  "Term" is the
X#  name of the termcap entry to use.  Normally this initialization is
X#  done automatically, and need not concern the user.
X#
X#  getval(id)
X#    Works something like tgetnum, tgetflag, and tgetstr.  In the
X#  spirit of Icon, all three have been collapsed into one routine.
X#  Integer valued caps are returned as integers, strings as strings,
X#  and flags as records (if a flag is set, then type(flag) will return
X#  "true").  Absence of a given capability is signalled by procedure
X#  failure.
X#
X#  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
X#    Analogous to tgoto.  "Cm" is the cursor movement command for
X#  the current terminal, as obtained via getval("cm").  Igoto()
X#  returns a string which, when output via iputs, will cause the
X#  cursor to move to column "destcol" and line "destline."  Column and
X#  line are always calculated using a *one* offset.  This is far more
X#  Iconish than the normal zero offset used by tgoto.  If you want to
X#  go to the first square on your screen, then include in your program
X#  "iputs(igoto(getval("cm"),1,1))."
X#
X#  iputs(cp,affcnt)
X#    Equivalent to tputs.  "Cp" is a string obtained via getval(),
X#  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
X#  count of affected lines.  It is completely irrelevant for most
X#  modern terminals, and is supplied here merely for the sake of
X#  backward compatibility with itlib, a UNIX-only version of these
X#  routines (one which handles padding on archaic terminals).
X#
X##########################################################################
X#
X#  Notes for MS-DOS users:
X#
X#    There are two basic reasons for using the I/O routines
X#  contained in this package.  First, by using a set of generalized
X#  routines, your code will become much more readable.  Secondly, by
X#  using a high level interface, you can avoid the cardinal
X#  programming error of hard coding things like screen length and
X#  escape codes into your programs.
X#
X#    To use this collection of programs, you must do two things.
X#  First, you must add the line "device=ansi.sys" (or the name of some
X#  other driver, like zansi.sys, nansi.sys, or nnansi.sys [=new
X#  nansi.sys]) to your config.sys file.  Secondly, you must add two
X#  lines to your autoexec.bat file: 1) "set TERM=ansi-mono" and 2)
X#  "set TERMCAP=\location\termcap."  The purpose of setting the TERM
X#  variable is to tell this program what driver you are using.  If you
X#  have a color system, you could use "ansi-color" instead of
X#  "ansi-mono," although for compatibility with a broader range of
X#  users, it would perhaps be better to stick with mono.  The purpose
X#  of setting TERMCAP is to make it possible to determine where the
X#  termcap database file is located.  The termcap file (which should
X#  have been packed with this library as termcap.dos) is a short
X#  database of all the escape sequences used by the various terminal
X#  drivers.  Set TERMCAP so that it reflects the location of this file
X#  (which should be renamed as termcap, for the sake of consistency
X#  across UNIX and MS-DOS spectra).  If desired, you can also try
X#  using termcap2.dos.  Certain games work a lot better using this
X#  alternate file.  To try it out, rename it to termcap, and set
X#  the environment variable TERMCAP to its location.
X#
X#    Although the authors make no pretense of providing here a
X#  complete introduction to the format of the termcap database file,
X#  it will be useful, we believe, to explain a few basic facts about
X#  how to use this program in conjunction with it.  If, say, you want
X#  to clear the screen, add the line,
X#
X#    iputs(getval("cl"))
X#
X#  to your program.  The function iputs() outputs screen control
X#  sequences.  Getval retrieves a specific sequence from the termcap
X#  file.  The string "cl" is the symbol used in the termcap file to
X#  mark the code used to clear the screen.  By executing the
X#  expression "iputs(getval("cl"))," you are 1) looking up the "cl"
X#  (clear) code in the termcap database entry for your terminal, and
X#  the 2) outputting that sequence to the screen.
X#
X#    Some other useful termcap symbols are "ce" (clear to end of
X#  line), "ho" (go to the top left square on the screen), "so" (begin
X#  standout mode), and "se" (end standout mode).  To output a
X#  boldfaced string, str, to the screen, you would write -
X#
X#    iputs(getval("so"))
X#    writes(str)
X#    iputs(getval("se"))
X#
X#  You can also write "writes(getval("so") || str || getval("se")),
X#  but this would make reimplementation for UNIX terminals that
X#  require padding rather difficult.
X#
X#    It is also heartily to be recommended that MS-DOS programmers
X#  try not to assume that everyone will be using a 25-line screen.
X#  Most terminals are 24-line.  Some 43.  Some have variable window
X#  sizes.  If you want to put a status line on, say, the 2nd-to-last
X#  line of the screen, then determine what that line is by executing
X#  "getval("li")."  The termcap database holds not only string-valued
X#  sequences, but numeric ones as well.  The value of "li" tells you
X#  how many lines the terminal has (compare "co," which will tell you
X#  how many columns).  To go to the beginning of the second-to-last
X#  line on the screen, type in:
X#
X#    iputs(igoto(getval("cm"), 1, getval("li")-1))
X#
X#  The "cm" capability is a special capability, and needs to be output
X#  via igoto(cm,x,y), where cm is the sequence telling your computer
X#  to move the cursor to a specified spot, x is the column, and y is
X#  the row.  The expression "getval("li")-1" will return the number of
X#  the second-to-last line on your screen.
X#
X##########################################################################
X#
X#  Requires: UNIX or MS-DOS, co-expressions
X#
X#  See also: itlib.icn, iscreen.icn
X#
X##########################################################################
X
X
Xglobal tc_table, isDOS
Xrecord true()
X
X
Xprocedure check_features()
X
X    initial {
X
X    if find("UNIX",&features) then
X        isDOS := &null
X    else if find("MS-DOS", &features) then
X        isDOS := 1
X    else stop("check_features:  OS not (yet?) supported.")
X
X    find("expressi",&features) |
X        er("check_features","co-expressions not implemented - &$#!",1)
X    }
X
X    return
X
Xend
X
X
X
Xprocedure setname(name)
X
X    # Sets current terminal type to "name" and builds a new termcap
X    # capability database (residing in tc_table).  Fails if unable to
X    # find a termcap entry for terminal type "name."  If you want it
X    # to terminate with an error message under these circumstances,
X    # comment out "| fail" below, and uncomment the er() line.
X
X    #tc_table is global
X
X    check_features()
X
X    tc_table := table()
X    tc_table := maketc_table(getentry(name)) | fail
X    # er("setname","no termcap entry found for "||name,3)
X    return "successfully reset for terminal " || name
X
Xend
X
X
X
Xprocedure getname()
X
X    # Getname() first checks to be sure we're running under DOS or
X    # UNIX, and, if so, tries to figure out what the current terminal
X    # type is, checking successively the value of the environment
X    # variable TERM, and then (under UNIX) the output of "tset -".
X    # Terminates with an error message if the terminal type cannot be
X    # ascertained.  DOS defaults to "mono."
X
X    local term, tset_output
X
X    check_features()
X
X    if \isDOS then {
X        term := getenv("TERM") | "mono"
X    }
X    else {
X    if not (term := getenv("TERM")) then {
X        tset_output := open("/bin/tset -","pr") |
X        er("getname","can't find tset command",1)
X        term := !tset_output
X        close(tset_output)
X    }
X    }
X
X    return \term |
X    er("getname","can't seem to determine your terminal type",1)
X
Xend
X
X
X
Xprocedure er(func,msg,errnum)
X
X    # short error processing utility
X    write(&errout,func,":  ",msg)
X    exit(errnum)
X
Xend
X
X
X
Xprocedure getentry(name, termcap_string)
X
X    # "Name" designates the current terminal type.  Getentry() scans
X    # the current environment for the variable TERMCAP.  If the
X    # TERMCAP string represents a termcap entry for a terminal of type
X    # "name," then getentry() returns the TERMCAP string.  Otherwise,
X    # getentry() will check to see if TERMCAP is a file name.  If so,
X    # getentry() will scan that file for an entry corresponding to
X    # "name."  If the TERMCAP string does not designate a filename,
X    # getentry() will scan the termcap file for the correct entry.
X    # Whatever the input file, if an entry for terminal "name" is
X    # found, getentry() returns that entry.  Otherwise, getentry()
X    # fails.
X
X    local isFILE, f, getline, line, nm, ent1, ent2, entry
X    static slash, termcap_names
X    initial {
X    if \isDOS then {
X        slash := "\\"
X        termcap_names := ["termcap","termcap.dos","termcap2.dos"]
X    }
X    else {
X        slash := "/"
X        termcap_names := ["/etc/termcap"]
X    }
X    }
X
X
X    # You can force getentry() to use a specific termcap file by cal-
X    # ling it with a second argument - the name of the termcap file
X    # to use instead of the regular one, or the one specified in the
X    # termcap environment variable.
X    /termcap_string := getenv("TERMCAP")
X
X    if \isDOS then {
X    if \termcap_string then {
X        if termcap_string ? (
X         not ((tab(any(&letters)), match(":")) | match(slash)),
X         pos(1) | tab(find("|")+1), =name)
X        then {
X        # if entry ends in tc= then add in the named tc entry
X        termcap_string ?:= tab(find("tc=")) ||
X            # Recursively fetch the new termcap entry w/ name trimmed.
X            # Note that on the next time through name won't match the
X            # termcap environment variable, so getentry() will look for
X            # a termcap file.
X            (move(3), getentry(tab(find(":"))) ?
X             (tab(find(":")+1), tab(0)))
X        return termcap_string
X        }
X        else isFILE := 1
X    }
X    }
X    else {
X    if \termcap_string then {
X        if termcap_string ? (
X            not match(slash), pos(1) | tab(find("|")+1), =name)
X        then {
X        # if entry ends in tc= then add in the named tc entry
X        termcap_string ?:= tab(find("tc=")) ||
X            # Recursively fetch the new termcap entry w/ name trimmed.
X            (move(3), getentry(tab(find(":")), "/etc/termcap") ?
X             (tab(find(":")+1), tab(0)))
X        return termcap_string
X        }
X        else isFILE := 1
X    }
X    }
X
X    # The logic here probably isn't clear.  The idea is to try to use
X    # the termcap environment variable successively as 1) a termcap en-
X    # try and then 2) as a termcap file.  If neither works, 3) go to
X    # the /etc/termcap file.  The else clause here does 2 and, if ne-
X    # cessary, 3.  The "\termcap_string ? (not match..." expression
X    # handles 1.
X
X    if \isFILE            # if find(slash, \termcap_string)
X    then f := open(\termcap_string)
X    /f := open(!termcap_names) |
X    er("getentry","I can't access your termcap file.  Read iolib.icn.",1)
X
X    getline := create read_file(f)
X
X    while line := @getline do {
X    if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then {
X        entry := ""
X        while (\line | @getline) ? {
X        if entry ||:= 1(tab(find(":")+1), pos(0))
X        then {
X            close(f)
X            # if entry ends in tc= then add in the named tc entry
X            entry ?:= tab(find("tc=")) ||
X            # recursively fetch the new termcap entry
X            (move(3), getentry(tab(find(":"))) ?
X             # remove the name field from the new entry
X             (tab(find(":")+1), tab(0)))
X            return entry
X        }
X        else {
X            \line := &null # must precede the next line
X            entry ||:= trim(trim(tab(0),'\\'),':')
X        }
X        }
X    }
X    }
X
X    close(f)
X    er("getentry","can't find and/or process your termcap entry",3)
X
Xend
X
X
X
Xprocedure read_file(f)
X
X    # Suspends all non #-initial lines in the file f.
X    # Removes leading tabs and spaces from lines before suspending
X    # them.
X
X    local line
X
X    \f | er("read_tcap_file","no valid termcap file found",3)
X    while line := read(f) do {
X    match("#",line) & next
X    line ?:= (tab(many('\t ')) | &null, tab(0))
X    suspend line
X    }
X
X    fail
X
Xend
X
X
X
Xprocedure maketc_table(entry)
X
X    # Maketc_table(s) (where s is a valid termcap entry for some
X    # terminal-type): Returns a table in which the keys are termcap
X    # capability designators, and the values are the entries in
X    # "entry" for those designators.
X
X    local k, v, str, decoded_value
X
X    /entry & er("maketc_table","no entry given",8)
X    if entry[-1] ~== ":" then entry ||:= ":"
X
X    /tc_table := table()
X
X    entry ? {
X
X    tab(find(":")+1)    # tab past initial (name) field
X
X    while tab((find(":")+1) \ 1) ? {
X        &subject == "" & next
X        if k := 1(move(2), ="=") then {
X        # Get rid of null padding information.  Iolib can't
X        # handle it (unlike itlib.icn).  Leave star in.  It
X        # indicates a real dinosaur terminal, and will later
X        # prompt an abort.
X        str := ="*" | ""; tab(many(&digits))
X        decoded_value := Decode(str || tab(find(":")))
X        }
X        else if k := 1(move(2), ="#")
X        then decoded_value := integer(tab(find(":")))
X        else if k := 1(tab(find(":")), pos(-1))
X        then decoded_value := true()
X        else er("maketc_table", "your termcap file has a bad entry",3)
X        /tc_table[k] := decoded_value
X        &null
X    }
X    }
X
X    return tc_table
X
Xend
X
X
X
Xprocedure getval(id)
X
X    /tc_table := maketc_table(getentry(getname())) |
SHAR_EOF
true || echo 'restore of iolib.icn failed'
fi
echo 'End of  part 5'
echo 'File iolib.icn is continued in part 6'
echo 6 > _shar_seq_.tmp
exit 0

exit 0 # Just in case...
--
Kent Landfield                   INTERNET: [e-mail]
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    [phone]         FAX:      [phone]
Please send comp.sources.misc-related mail to [e-mail].