[alt.sources] itlib part 1 of 3

goer@ellis.uchicago.edu (Richard L. Goerwitz) (12/21/90)

Here are a set of termlib-like routines for Icon programmers.
An MS-DOS implementation is included.

-Richard (goer@sophist.uchicago.edu)

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 12/17/1990 16:50 UTC by goer@sophist.uchicago.edu
# Source directory /u/richard/Itermlib
#
# existing files will NOT be overwritten unless -c is specified
# This format requires very little intelligence at unshar time.
# "if test", "cat", "rm", "echo", "true", and "sed" may be needed.
#
# This is part 1 of a multipart archive                                    
# do not concatenate these parts, unpack them in order with /bin/sh        
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   8538 -r--r--r-- getchlib.icn
#  12240 -r--r--r-- itlib.icn
#   4418 -r--r--r-- iscreen.icn
#  14586 -r--r--r-- itlibdos.icn
#   2391 -r--r--r-- termcap.dos
#
if test -r _shar_seq_.tmp; then
	echo 'Must unpack archives in sequence!'
	echo Please unpack part `cat _shar_seq_.tmp` next
	exit 1
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
X    # then fail" below, and uncommenting the line "if *s < 1 then
X    # next."
X
X    local chr
X    static BS
X    initial {
X	BS := getval("bc") | "\b"
X	if not getval("bs") then {
X	    reset_tty()
X	    stop("Your terminal can't backspace!")
X	}
X    }
X
X    /s := ""
X    repeat {
X	case chr := getch() | fail of {
X	    "\r"|"\n"    : return s
X	    c_cc.vkill   : {
X		if *s < 1 then next
X		every 1 to *s do writes(BS)
X		s := ""
X	    }
X	    c_cc.verase   : {
X		# if *s < 1 then next
X		writes(BS) & s := s[1:-1]
X		if *s < 1 then fail
X	    }
X	    default: writes(chr) & s ||:= chr
X	}
X    }
X
Xend
X
X
X
Xprocedure setup_tty()
X    change_tty_mode("setup")
X    return
Xend
X
X
X
Xprocedure reset_tty()
X
X    # Reset (global) mode switch to &null to show we're in cooked mode.
X    current_mode := &null
X    change_tty_mode("reset")
X    return
X
Xend
X
X
X
Xprocedure getch()
X
X    local chr
X
X    # If the global variable current_mode is null, then we have to
X    # reset the terminal to raw mode.
X    if /current_mode := 1 then
X	setup_tty()
X
X    chr := reads(&input)
X    case chr of {
X	c_cc.vintr : reset_tty() & stop()  # shouldn't hard code this in
X	c_cc.vquit  : reset_tty() & stop()
X	default : return chr
X    }
X
Xend
X
X
X
Xprocedure getche()
X
X    local chr
X
X    # If the global variable current_mode is null, then we have to
X    # reset the terminal to raw mode.
X    if /current_mode := 1 then
X	setup_tty()
X
X    chr := reads(&input)
X    case chr of {
X	c_cc.vintr  : reset_tty() & stop()
X	c_cc.vquit  : reset_tty() & stop()
X	default : writes(chr) & return chr
X    }
X
Xend
X
X
X
Xprocedure change_tty_mode(switch)
X
X    # global c_cc   (global record containing values for kill, etc. chars)
X    local get_term_params, i
X    static reset_string
X    initial {
X	getval("li")    # check to be sure itlib is set up
X	find("unix",map(&features)) |
X	    stop("change_tty_mode:  These routines must run under Unix.")
X	get_term_params := open("/bin/stty -g 2>&1","pr")
X	reset_string := !get_term_params
X	close(get_term_params)
X	reset_string ? {
X	    # tab upto the fifth field of the output of the stty -g cmd
X	    # fields of stty -g seem to be the same as those of the
X	    # termio struct, except that the c_line field is missing
X	    every 1 to 4 do tab(find(":")+1)
X	    c_cc := termio_struct("\x03","\x1C","\x08","\x15")
X	    every i := 1 to 3 do {
X		c_cc[i] := char(integer("16r"||tab(find(":"))))
X		move(1)
X	    }
X	    c_cc[i+1] := char(integer("16r"||tab(0)))
X	}
X    }
X
X    if switch == "setup"
X    then system("/bin/stty -echo raw")
X    else system("/bin/stty "||reset_string)
X
X    return
X
Xend
SHAR_EOF
true || echo 'restore of getchlib.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= itlib.icn ==============
if test -f 'itlib.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping itlib.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting itlib.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'itlib.icn' &&
X########################################################################
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)
SHAR_EOF
true || echo 'restore of itlib.icn failed'
fi
echo 'End of  part 1'
echo 'File itlib.icn is continued in part 2'
echo 2 > _shar_seq_.tmp
exit 0