Path: utzoo!utgpu!news-server.csri.toronto.edu!rutgers!cs.utexas.edu!sdd.hp.com!zaphod.mps.ohio-state.edu!think.com!linus!agate!ucbvax!GARGOYLE.UCHICAGO.EDU!goer%sophist
From: goer%sophist@GARGOYLE.UCHICAGO.EDU (Richard Goerwitz)
Newsgroups: comp.lang.icon
Subject: klondike, part 04 of 05
Message-ID: <9012081054.AA08433@sophist>
Date: 8 Dec 90 10:54:56 GMT
Sender: daemon@ucbvax.BERKELEY.EDU
Distribution: inet
Organization: The Internet
Lines: 683

---- Cut Here and feed the following to sh ----
#!/bin/sh
# this is klondike.04 (part 4 of a multipart archive)
# do not concatenate these parts, unpack them in order with /bin/sh
# file itlib.icn continued
#
if test ! -r _shar_seq_.tmp; then
	echo 'Please unpack part 1 first!'
	exit 1
fi
(read Scheck
 if test "$Scheck" != 4; 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 itlib.icn'
else
echo 'x - continuing file itlib.icn'
sed 's/^X//' << 'SHAR_EOF' >> 'itlib.icn' &&
X#    
X#	Name:	itlib.icn
X#	
X#	Title:	Icon termlib-type tools
X#	
X#	Author:	Richard L. Goerwitz
X#
X#	Version: 1.23
X#
X#########################################################################
X#
X#  I place this and future versions of itlib in the public domain - RLG
X#
X#########################################################################
X#
X#  The following library represents a series of rough functional
X#  equivalents to the standard Unix low-level termcap routines.  They
X#  are not meant as exact termlib clones.  Nor are they enhanced to
X#  take care of magic cookie terminals, terminals that use \D in their
X#  termcap entries, or, in short, anything I felt would not affect my
X#  normal, day-to-day work with ANSI and vt100 terminals.
X#
X#  Requires:  A unix platform & co-expressions.  There is an MS-DOS
X#  version, itlibdos.icn.
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 only relevant for terminals which
X#  specify proportional (starred) delays in their termcap entries.
X#
X#  Bugs:  I have not tested these routines on terminals that require
X#  padding.  These routines WILL NOT WORK if your machines stty com-
X#  mand has no -g option (tisk, tisk).  This includes NeXT worksta-
X#  tions, and some others that I haven't had time to pinpoint.
X#
X##########################################################################
X#
X#  Requires: UNIX, co-expressions
X#
X#  See also: iscreen.icn (a set of companion utilities)
X#
X##########################################################################
X
X
Xglobal tc_table, tty_speed
Xrecord true()
X
X
Xprocedure check_features()
X
X    local in_params, line
X    # global tty_speed
X
X    initial {
X	find("unix",map(&features)) |
X	    er("check_features","unix system required",1)
X	find("o-expres",&features) |
X	    er("check_features","co-expressions not implemented - &$#!",1)
X	system("/bin/stty tabs") |
X	    er("check_features","can't set tabs option",1)
X    }
X
X    # clumsy, clumsy, clumsy, and probably won't work on all systems
X    tty_speed := getspeed()
X    return "term characteristics reset; features check out"
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 Unix, and,
X    # if so, tries to figure out what the current terminal type is,
X    # checking successively the value of the environment variable
X    # TERM, and then the output of "tset -".  Terminates with an error
X    # message if the terminal type cannot be ascertained.
X
X    local term, tset_output
X
X    check_features()
X
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    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 /etc/termcap 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 f, getline, line, nm, ent1, ent2
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 \termcap_string ? (not match("/"), pos(0) | tab(find("|")+1), =name)
X    then return termcap_string
X    else {
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 find("/",\termcap_string)
X	then f := open(termcap_string)
X	/f := open("/etc/termcap") |
X	    er("getentry","I can't access your /etc/termcap file",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
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
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), ="=")
X	    then tc_table[k] := Decode(tab(find(":")))
X	    else if k := 1(move(2), ="#")
X	    then tc_table[k] := integer(tab(find(":")))
X	    else if k := 1(tab(find(":")), pos(-1))
X	    then tc_table[k] := true()
X	    else er("maketc_table", "your termcap file has a bad entry",3)
X	}
X    }
X
X    return tc_table
X
Xend
X
X
X
Xprocedure getval(id)
X
X    /tc_table := maketc_table(getentry(getname())) |
X	er("getval","can't make a table for your terminal",4)
X
X    return \tc_table[id] | fail
X	# er("getval","the current terminal doesn't support "||id,7)
X
Xend
X
X
X
Xprocedure Decode(s)
X
X    # Does things like turn ^ plus a letter into a genuine control
X    # character.
X
X    new_s := ""
X
X    s ? {
X
X	while new_s ||:= tab(upto('\\^')) do {
X	    chr := move(1)
X	    if chr == "\\" then {
X		new_s ||:= {
X		    case chr2 := move(1) of {
X			"\\" : "\\"
X			"^"  : "^"
X			"E"  : "\e"
X			"b"  : "\b"
X			"f"  : "\f"
X			"n"  : "\n"
X			"r"  : "\r"
X			"t"  : "\t"
X			default : {
X			    if any(&digits,chr2) then {
X				char(integer("8r"||chr2||move(2 to 0 by -1))) |
X				    er("Decode","bad termcap entry",3)
X			    }
X			   else chr2
X			}
X		    }
X		}
X	    }
X	    else new_s ||:= char(ord(map(move(1),&lcase,&ucase)) - 64)
X	}
X	new_s ||:= tab(0)
X    }
X
X    return new_s
X
Xend
X
X
X
Xprocedure igoto(cm,col,line)
X
X    local colline, range, increment, str, outstr, chr, x, y
X
X    if col > (tc_table["co"]) | line > (tc_table["li"]) then {
X	colline := string(\col) || "," || string(\line) | string(\col|line)
X	range := "(" || tc_table["co"]-1 || "," || tc_table["li"]-1 || ")"
X	er("igoto",colline || " out of range " || (\range|""),9)
X    } 
X
X    # Use the Iconish 1;1 upper left corner & not the C-ish 0 offsets
X    increment := -1
X    outstr := ""
X    
X    cm ? {
X	while outstr ||:= tab(find("%")) do {
X	    tab(match("%"))
X	    chr := move(1)
X	    if case chr of {
X		"." :  outstr ||:= char(line + increment)
X		"+" :  outstr ||:= char(line + ord(move(1)) + increment)
X		"d" :  {
X		    str := string(line + increment)
X		    outstr ||:= right(str, integer(tab(any('23'))), "0") | str
X		}
X	    }
X	    then line :=: col
X	    else {
X		case chr of {
X		    "n" :  line := ixor(line,96) & col := ixor(col,96)
X		    "i" :  increment := 0
X		    "r" :  line :=: col
X		    "%" :  outstr ||:= "%"
X		    "B" :  line := ior(ishift(line / 10, 4), line % 10)
X		    ">" :  {
X			x := move(1); y := move(1)
X			line > ord(x) & line +:= ord(y)
X			&null
X		    }
X		} | er("goto","bad termcap entry",5)
X	    }
X	}
X    return outstr || tab(0)
X    }
X
Xend
X
X
X
Xprocedure iputs(cp, affcnt)
X
X    local baud_rates, char_rates, i, delay, PC
X    static num_chars, char_times
X    # global tty_speed
X
X    initial {
X	num_chars := &digits ++ '.'
X	char_times := table()
X	# Baud rates in decimal, not octal (as in termio.h)
X	baud_rates := [0,7,8,9,10,11,12,13,14,15]
X	char_rates := [0,333,166,83,55,41,20,10,10,10]
X	every i := 1 to *baud_rates do {
X	    char_times[baud_rates[i]] := char_rates[i]
X	}
X    }
X
X    type(cp) == "string" |
X	er("iputs","you can't iputs() a non-string value!",10)
X
X    cp ? {
X	delay := tab(many(num_chars))
X	if ="*" then {
X	    delay *:= \affcnt |
X		er("iputs","affected line count missing",6)
X	}
X	writes(tab(0))
X    }
X
X    if (\delay, tty_speed ~= 0) then {
X	PC := tc_table["pc"] | "\000"
X	char_time := char_times[tty_speed] | (return "speed error")
X	delay := (delay * char_time) + (char_time / 2)
X	every 1 to delay by 10
X	do writes(PC)
X    }
X
X    return
X
Xend
X
X
X
Xprocedure getspeed()
X
X    local stty_g, stty_output, c_cflag, o_speed
X
X    stty_g := open("/bin/stty -g 2>&1","pr") |
X	er("getspeed","Can't access your stty command.",4)
X    stty_output := !stty_g
X    close(stty_g)
X
X    \stty_output ? {
X	# tab to the third field of the output of the stty -g cmd
X        tab(find(":")+1) & tab(find(":")+1) &
X	c_cflag := integer("16r"||tab(find(":")))
X    } | er("getspeed","Unable to unwind your stty -g output.",4)
X
X    o_speed := iand(15,c_cflag)
X    return o_speed
X
Xend
SHAR_EOF
echo 'File itlib.icn is complete' &&
true || echo 'restore of itlib.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= getchlib.icn ==============
if test -f 'getchlib.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping getchlib.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting getchlib.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'getchlib.icn' &&
X############################################################################
X#
X#	Name:	 getchlib.icn
X#
X#	Title:	 Implementation of getch() for Unix (and more)
X#
X#	Author:	 Richard L. Goerwitz
X#
X#	Version: 1.11
X#
X############################################################################
X#
X#  I place this and future versions of getchlib in the public domain - RLG
X#
X############################################################################
X#
X#  Implementing getch() is a much, much more complex affair under Unix
X#  than it is under, say, MS-DOS.  This library represents one,
X#  solution to the problem - one which can be run as a library, and
X#  need not be compiled into the run-time system.
X#
X#  Four basic utilities are included here:
X#
X#	getch()		- waits until a keystroke is available &
X#	    returns it without displaying it on the screen
X#	getche()	- same as getch() only with echo
X#	getse(s)	- like getche() only for strings.  The optional
X#	    argument s gives getse() something to start with.  Use this
X#           if, say, you want to read single characters in cbreak mode,
X#           but get more input if the character read is the first part
X#           of a longer command.  If the user backspaces over everything
X#           that has been input, getse() fails.  Returns on \r or \n.
X#	reset_tty()	- absolutely vital routine for putting the cur-
X#           rent tty line back into cooked mode; call it before exiting
X#           or you will find yourself with a locked-up terminal; use it
X#           also if you must temporarily restore the terminal to cooked
X#           mode
X#
X#  Note that getse() *must* be used in place of read(&input) if you
X#  are planning on using getch() or getche(), since read(&input)
X#  assumes a tty with "sane" settings.
X#
X#  Warning:  The routines below do not do any sophisticated output
X#  processing.  As noted above, they also put your tty line in raw
X#  mode.  I know, I know:  "Raw is overkill - use cbreak."  But in
X#  a world that includes SysV, one must pick a lowest common denomi-
X#  nator.  And no, icanon != cbreak.
X#
X#  Bugs:  These routines will not work on systems that do not imple-
X#  ment the -g option for the stty command.  The NeXT workstation is
X#  an example of such a system.  Tisk, tisk.
X#
X############################################################################
X#
X#  Example program:
X#
X#      The following program is a simple file viewer.  To run, it
X#  needs to be linked with itlib.icn, iscreen.icn, and this file
X#  (getchlib.icn).
X#
X#  procedure main(a)
X#
X#      # Simple pager/file searcher for Unix systems.  Must be linked
X#      # with itlib.icn and iscreen.icn.
X#  
X#      local intext, c, s
X#  
X#      # Open input file
X#      intext := open(a[1],"r") | {
X#  	write(&errout,"Can't open input file.")
X#  	exit(1)
X#      }
X#  
X#      # Initialize screen
X#      clear()
X#      print_screen(intext) | exit(0)
X#  
X#      # Prompt & read input
X#      repeat {
X#  	iputs(igoto(getval("cm"), 1, getval("li")))
X#  	emphasize()
X#  	writes("More? (y/n or /search):")
X#  	write_ce(" ")
X#  	case c := getche() of {
X#  	    "y" : print_screen(intext) | break
X#  	    " " : print_screen(intext) | break
X#  	    "n" : break
X#  	    "q" : break
X#  	    "/" : {
X#  		iputs(igoto(getval("cm"), 1, getval("li")))
X#  		emphasize()
X#  		writes("Enter search string:")
X#  		write_ce(" ")
X#  		pattern := GetMoreInput()
X#  		/pattern | "" == pattern & next
X#  		# For more complex patterns, use findre() (IPL findre.icn)
X#  		if not find(pattern, s := !intext) then {
X#  		    iputs(igoto(getval("cm"), 1, getval("li")))
X#  		    emphasize()
X#  		    write_ce("String not found.")
X#  		    break
X#  		}
X#  		else print_screen(intext, s) | break
X#  	    }
X#  	}
X#      }
X#  
X#      reset_tty()
X#      write()
X#      exit(0)
X#
X#  end
X#  
X#  procedure GetMoreInput(c)
X#  
X#      local input_string
X#      static BS
X#      initial BS := getval("bc") | "\b"
X#  
X#      /c := ""
X#      if any('\n\r', chr := getch())
X#      then return c
X#      else {
X#  	chr == BS & fail
X#  	writes(chr)
X#  	input_string := getse(c || chr) | fail
X#  	if any('\n\r', input_string)
X#  	then fail else (return input_string)
X#      }
X#  
X#  end
X#  
X#  procedure print_screen(f,s)
X#  
X#      if /s then
X#  	begin := 1
X#      # Print top line, if one is supplied
X#      else {
X#  	iputs(igoto(getval("cm"), 1, 1))
X#  	write_ce(s ? tab(getval("co") | 0))
X#  	begin := 2
X#      }
X#  
X#      # Fill the screen with lines from f; clear and fail on EOF.
X#      every i := begin to getval("li") - 1 do {
X#  	iputs(igoto(getval("cm"), 1, i))
X#  	if not write_ce(read(f) ? tab(getval("co") | 0)) then {
X#  	    # Clear remaining lines on the screen.
X#  	    every j := i to getval("li") do {
X#  		iputs(igoto(getval("cm"), 1, j))
X#  		iputs(getval("ce"))
X#  	    }
X#  	    iputs(igoto(getval("cm"), 1, i))
X#  	    fail
X#  	}
X#      }
X#      return
X#  
X#  end
X#  
X#  procedure write_ce(s)
X#  
X#      normal()
X#      iputs(getval("ce")) |
X#  	writes(repl(" ",getval("co") - *s))
X#      writes(s)
X#      return
X#
X#  end
X#
X############################################################################
X#
X#  Requires: UNIX
X#
X#  Links: itlib.icn
X#
X############################################################################
X
X
Xglobal c_cc, current_mode		# what mode are we in, raw or cooked?
Xrecord termio_struct(vintr,vquit,verase,vkill)
X
Xprocedure getse(s)
X
X    # getse() - like getche, only for strings instead of single chars
X    #
X    # This procedure *must* be used instead of read(&input) if getch
X    # and/or getche are to be used, since these put the current tty
X    # line in raw mode.
X    #
X    # Note that the buffer can be initialized by calling getse with a
X    # string argument.  Note also that, as getse now stands, it will
X    # fail if the user backspaces over everything that has been input.
X    # This change does not coincide with its behavior in previous ver-
X    # sions.  It can be changed by commenting out the line "if *s < 1
SHAR_EOF
true || echo 'restore of getchlib.icn failed'
fi
echo 'End of  part 4'
echo 'File getchlib.icn is continued in part 5'
echo 5 > _shar_seq_.tmp
exit 0