goer@SOPHIST.UCHICAGO.EDU (Richard Goerwitz) (06/27/90)
I've been asked by several people to post the following software, des-
pite its preliminary nature. That's fine with me. I've been using it
for a while now, and there are sections of code I just won't ever have
the opportunity of testing in my current range of computing environ-
ments. I can use all the bug reports I can get.
Sorry about the annoying disclaimer included below. Some recent con-
tacts with the legal staff of an outfit using software posted here
has led me to think it sensible a) to copyright everything, however
trivial, b) to make absolutely clear the free and unrestricted nature
of the code, and c) to disclaim any responsibility for anything that
might occur in conjunction with its (ab)use.
Note: Contrary to my usual practices, I've packed this as a shar
archive. It's 400 lines of code, too. If anyone feels that one of
the source newsgroups might be a better place, please let me know.
-Richard L. Goerwitz goer%sophist@uchicago.bitnet
goer@sophist.uchicago.edu rutgers!oddjob!gide!sophist!goer
#!/bin/sh
# This is a shell archive (shar 3.24)
# made 06/27/1990 06:12 UTC by richard@zenu (goer@sophist.uchicago.edu)
#
# existing files WILL be overwritten
# This format requires very little intelligence at unshar time.
# "echo" and "sed" will be needed.
#
# ============= itlib024.icn ==============
echo "x - extracting itlib024.icn (Text)"
sed 's/^X//' << 'SHAR_EOF' > itlib024.icn &&
X########################################################################
X#
X# Name: itermlib.icn
X#
X# Title: Icon termlib-type tools
X#
X# Author: Richard L. Goerwitz
X#
X# Date: June 19, 1990 (version 0.24 - beta test)
X#
X########################################################################
X#
X# Copyright (c) 1990, Richard L. Goerwitz, III
X#
X# This software is intended for free and unrestricted distribution.
X# I place only two conditions on its use: 1) That you clearly mark
X# any additions or changes you make to the source code, and 2) that
X# you do not delete this message therefrom. In order to protect
X# myself from spurious litigation, it must also be stated here that,
X# because this is free software, I, Richard Goerwitz, make no claim
X# about the applicability or fitness of this software for any
X# purpose, and expressly disclaim any responsibility for any damages
X# that might be incurred in conjunction with its use.
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# work. If anyone enhances these routines, I'd deeply appreciate it
X# if they would share their changes with me and/or the rest of the
X# Icon community.
X#
X# Requires: A unix platform & co-expressions. Certainly the
X# package could be altered for use with MS-DOS and other systems.
X# Please contact me if advice on how to do this is needed.
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(id) 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. Make "cm" 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 input
X# "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##########################################################################
X
X
Xglobal tc_table, tty_speed
Xrecord true()
X
X
Xprocedure check_features()
X
X local in_params, yes_tabs, 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 in_params := open("/bin/stty 2>&1","pr") |
X (ospeed := &null, fail)
X every line := !in_params do {
X yes_tabs := find("tabs",line) #unused
X line ? {
X tty_speed := (tab(find("speed")+5), tab(many(' ')),
X integer(tab(many(&digits))))
X }
X }
X close(in_params)
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 := 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)
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 termcap_string, f, getline, line
X
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 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(0) | tab(find("|")+1), =name) then {
X entry := ""
X while (\line | @getline) ? {
X if not (entry ||:= 1(tab(find("\\")), pos(-1)))
X then close(f) & (return entry || &subject)
X \line := &null
X }
X }
X }
X }
X
X close(f)
X fail
X
Xend
X
X
X
Xprocedure read_file(fname)
X
X # Suspends all non #-initial lines in the file named "fname."
X # Removes leading tabs and spaces from lines before suspending
X # them.
X
X local intext, line
X
X intext := open(fname) |
X er("read_tcap_file","can't open "||fname,3)
X while line := read(intext) do {
X match("#",line) & next
X suspend line ? (tab(many('\t ')), tab(0))
X }
X
X close(intext)
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 tc_table := table()
X entry ? {
X
X tab(find(":")+1) # tab past initial (name) field
X while tab(find(":")+1) ? {
X
X if k := 1(move(2), ="=")
X then insert(tc_table, k, decode(tab(find(":"))))
X else if k := 1(move(2), ="#")
X then insert(tc_table, k, integer(tab(find(":"))))
X else if k := 1(tab(find(":")), pos(-1))
X then insert(tc_table, k, true())
X else er("maketc_table", "your termcap file has a bad entry",3)
X
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","terminal doesn't support "||id,7)
X
Xend
X
X
X
Xprocedure decode(s)
X
X new_s := ""
X
X s ? {
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,chr)
X then char(integer("8r"||chr2||move(2))) |
X er("decode","bad termcap entry",3)
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, outstr, chr, x, y
X
X if col > (tc_table["co"]) | line > (tc_table["li"]) then {
X colline := string(col) || "," || string(line)
X range := "(" || tc_table["co"]-1 || "," || tc_table["li"]-1 || ")"
X er("igoto",colline || " out of range " || range,9)
X }
X
X # use iconish 1 offset, rather than C-ish 0
X find("%i",cm) | (col +:= 1, line +:= 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)
X "+" : line +:= ord(move(1))
X "d" : {
X outstr ||:=
X right(string(line), integer(tab(any('23'))), "0") |
X string(line)
X }
X }
X then line :=: col
X else {
X case chr of {
X "n" : line := ixor(line,96) & col := ixor(col,96)
X "i" : &null
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 := [0,300,600,1200,1800,2400,4800,9600,19200]
X char_rates := [0,333,166,83,55,41,20,10,5]
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
SHAR_EOF
exit 0