From: goer@ellis.uchicago.edu (Richard L. Goerwitz)
Subject: profiler, part3
Reply-To: goer@midway.uchicago.edu
Organization: University of Chicago Computing Organizations
Date: Sun, 13 Sep 1992 01:32:00 GMT


---- Cut Here and feed the following to sh ----
#!/bin/sh
# this is profile.03 (part 3 of a multipart archive)
# do not concatenate these parts, unpack them in order with /bin/sh
# file iolib.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 iolib.icn'
else
echo 'x - continuing file iolib.icn'
sed 's/^X//' << 'SHAR_EOF' >> 'iolib.icn' &&
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())) |
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    local new_s, chr, chr2
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, padding, 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	    if padding := integer(tab(any('23')))
X	    then chr := (="d" | "d")
X	    else 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, \padding, "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    # Writes cp to the screen.  Use this instead of writes() for
X    # compatibility with itlib (a UNIX-only version which can handle
X    # albeit inelegantly) terminals that need padding.
X
X    static num_chars
X    initial num_chars := &digits ++ '.'
X
X    type(cp) == "string" |
X	er("iputs","you can't iputs() a non-string value!",10)
X
X    cp ? {
X	if tab(many(num_chars)) & ="*" then
X	    stop("iputs:  iolib can't use terminals that require padding.")
X	writes(tab(0))
X    }
X
X    return
X
Xend
SHAR_EOF
echo 'File iolib.icn is complete' &&
true || echo 'restore of iolib.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= iscreen.icn ==============
if test -f 'iscreen.icn' -a X"$1" != X"-c"; then
	echo 'x - skipping iscreen.icn (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting iscreen.icn (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'iscreen.icn' &&
X############################################################################
X#
X#	Name:	 iscreen.icn
X#
X#	Title:	 Icon screen functions
X#
X#	Author:	 Richard L. Goerwitz
X#
X#	Version: 1.28
X#
X############################################################################
X#
X#  This and future version of iscreen are placed in the public domain - RLG
X#
X############################################################################
X#  
X#      This file contains some rudimentary screen functions for use with
X#  itlib.icn (termlib-like routines for Icon).
X#
X#      clear()              - clears the screen (tries several methods)
X#      emphasize()          - initiates emphasized (usu. = reverse) mode
X#      boldface()           - initiates bold mode
X#      blink()              - initiates blinking mode
X#      normal()             - resets to normal mode
X#      message(s)           - displays message s on 2nd-to-last line
X#      underline()          - initiates underline mode
X#      status_line(s,s2,p)  - draws status line s on the 3rd-to-last
X#        screen line; if s is too short for the terminal, s2 is used;
X#        if p is nonnull then it either centers, left-, or right-justi-
X#        fies, depending on the value, "c," "l," or "r."
X#      clear_emphasize()    - horrible way of clearing the screen to all-
X#        emphasize mode; necessary for many terminals
X#
X############################################################################
X#
X#  Requires: UNIX
X#
X#  Links: itlib.icn (or your OS-specific port of itlib)
X#
X#  See also: boldface.icn
X#
X############################################################################
X
X
Xprocedure clear()
X
X    # Clears the screen.  Tries several methods.
X    local i
X
X    normal()
X    if not iputs(getval("cl"))
X    then iputs(igoto(getval("cm"),1,1) | getval("ho"))
X    if not iputs(getval("cd"))
X    then {
X	every i := 1 to getval("li") do {
X	    iputs(igoto(getval("cm"),1,i))
X	    iputs(getval("ce"))
X	}
X	iputs(igoto(getval("cm"),1,1))
X    }
X    return
X
Xend
X
X
X
Xprocedure boldface()
X    
X    static bold_str, cookie_str
X    initial {
X	if bold_str := getval("md")
X	then cookie_str := repl(getval("le"|"bc") | "\b", getval("mg"))
X	else {
X	    # One global procedure value substituted for another.
X	    boldface := emphasize
X	    return emphasize()
X	}
X    }	    
X 
X    normal()
X    iputs(\bold_str)
X    iputs(\cookie_str)
X    return
X
Xend
X
X
X
Xprocedure blink()
X    
X    static blink_str, cookie_str
X    initial {
X	if blink_str := getval("mb")
X	then cookie_str :=
X		 repl(getval("le"|"bc") | "\b", getval("mg"))
X	else {
X	    # One global procedure value substituted for another.
X	    blink := emphasize
X	    return emphasize()
X	}
X    }	    
X 
X    normal()
X    iputs(\blink_str)
X    iputs(\cookie_str)
X    return
X
Xend
X
X
X
Xprocedure emphasize()
X    
X    static emph_str, cookie_str
X    initial {
X	if emph_str := getval("so")
X	then cookie_str := repl(getval("le"|"bc") | "\b", getval("sg"))
X	else {
X	    if emph_str := getval("mr")
X	    then cookie_str := repl(getval("le"|"bc") | "\b", getval("mg"))
X	    else if emph_str := getval("us")
X	    then cookie_str := repl(getval("le"|"bc") | "\b", getval("ug"))
X	}
X    }	    
X 
X    normal()
X    iputs(\emph_str)
X    iputs(\cookie_str)
X    return
X
Xend
X
X
X
Xprocedure underline()
X    
X    static underline_str, cookie_str
X    initial {
X	if underline_str := getval("us")
X	then cookie_str := repl(getval("le"|"bc") | "\b", getval("ug"))
X    }
X
X    normal()
X    iputs(\underline_str)
X    iputs(\cookie_str)
X    return
X
Xend
X
X
X
Xprocedure normal(mode)
X
X    static UN_emph_str, emph_cookie_str,
X	UN_underline_str, underline_cookie_str,
X	UN_bold_str, bold_cookie_str
X
X    initial {
X
X	# Find out code to turn off emphasize (reverse video) mode.
X	if UN_emph_str := getval("se") then
X	    # Figure out how many backspaces we need to erase cookies.
X	    emph_cookie_str := repl(getval("le"|"bc") | "\b", getval("sg"))
X	else UN_emph_str := ""
X
X	# Finally, figure out how to turn off underline mode.
X	if UN_underline_str := (UN_emph_str ~== getval("ue")) then
X	    underline_cookie_str := repl(getval("le"|"bc")|"\b", getval("ug"))
X	else UN_underline_str := ""
X
X	# Figure out how to turn off boldface mode.
X	if UN_bold_str := 
X	    (UN_underline_str ~== (UN_emph_str ~== getval("me"))) then
X	    # Figure out how many backspaces we need to erase cookies.
X	    bold_cookie_str := repl(getval("le"|"bc") | "\b", getval("mg"))
X	else UN_bold_str := ""
X
X    }	    
X    
X    iputs("" ~== UN_emph_str) &
X	iputs(\emph_cookie_str)
X
X    iputs("" ~== UN_underline_str) &
X	iputs(\underline_cookie_str)
X
X    iputs("" ~== UN_bold_str) &
X	iputs(\bold_cookie_str)
X
X    return
X
Xend
X
X
X
Xprocedure status_line(s,s2,p)
X
X    # Writes a status line on the terminal's third-to-last line
X    # The only necessary argument is s.  S2 (optional) is used
X    # for extra narrow screens.  In other words, by specifying
X    # s2 you give status_line an alternate, shorter status string
X    # to display, in case the terminal isn't wide enough to sup-
X    # port s.  If p is nonnull, then the status line is either
X    # centered (if equal to "c"), left justified ("l"), or right
X    # justified ("r").
X
X    local width
X
X    /s := ""; /s2 := ""; /p := "c"
X    width := getval("co")
X    if *s > width then {
X	(*s2 < width, s := s2) |
X	    er("status_line","Your terminal is too narrow.",4)
X    }
X
X    case p of {
X	"c"    : s := center(s,width)
X	"l"    : s := left(s,width)
X	"r"    : s := right(s,width)
X	default: stop("status_line:  Unknown option "||string(p),4)
X    }
X
X    iputs(igoto(getval("cm"), 1, getval("li")-2))
X    emphasize(); writes(s)
X    normal()
X    return
X
Xend
X
X
X
Xprocedure message(s)
X
X    # Display prompt s on the second-to-last line of the screen.
X    # I hate to use the last line, due to all the problems with
X    # automatic scrolling.
X
X    /s := ""
X    normal()
X    iputs(igoto(getval("cm"), 1, getval("li")))
X    iputs(getval("ce"))
X    normal()
X    iputs(igoto(getval("cm"), 1, getval("li")-1))
X    iputs(getval("ce"))
X    writes(s[1:getval("co")] | s)
X    return
X
Xend
X
X
X
Xprocedure clear_underline()
X
X    # Horrible way of clearing the screen to all underline mode, but
X    # the only apparent way we can do it "portably" using the termcap
X    # capability database.
X
X    local i
X
X    underline()
X    iputs(igoto(getval("cm"),1,1))
X    if getval("am") then {
X	underline()
X        every 1 to (getval("li")-1) * getval("co") do
X	    writes(" ")
X    }
X    else {
X	every i := 1 to getval("li")-1 do {
X	    iputs(igoto(getval("cm"), 1, i))
X	    underline()
X	    writes(repl(" ",getval("co")))
X	}
X    }
X    iputs(igoto(getval("cm"),1,1))
X
Xend
X
X
X
Xprocedure clear_emphasize()
X
X    # Horrible way of clearing the screen to all reverse-video, but
X    # the only apparent way we can do it "portably" using the termcap
X    # capability database.
X
X    local i
X
X    emphasize()
X    iputs(igoto(getval("cm"),1,1))
X    if getval("am") then {
X	emphasize()
X        every 1 to (getval("li")-1) * getval("co") do
X	    writes(" ")
X    }
X    else {
X	every i := 1 to getval("li")-1 do {
X	    iputs(igoto(getval("cm"), 1, i))
X	    emphasize()
X	    writes(repl(" ",getval("co")))
X	}
X    }
X    iputs(igoto(getval("cm"),1,1))
X
Xend
SHAR_EOF
true || echo 'restore of iscreen.icn failed'
rm -f _shar_wnt_.tmp
fi
# ============= Makefile.dist ==============
if test -f 'Makefile.dist' -a X"$1" != X"-c"; then
	echo 'x - skipping Makefile.dist (File already exists)'
	rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting Makefile.dist (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'Makefile.dist' &&
X# Don't change this unless you're sure of what you're doing.
XPROGNAME = profile
X
X# You may need to change this (new users, use icont).
XICONC = /usr/icon/v8/bin/icont
X# ICONC = /usr/icon/v8/bin/iconc
X
X# If your system has old-style terminals attached (ones that require
X# padding), use itlib instead of iolib.  Otherwise, delete itlib.icn.
X# ITLIB = itlib
XITLIB = iolib
X
X# Please edit these to reflect your local file structure & conventions.
XDESTDIR = /usr/local/bin
XOWNER = bin
XGROUP = bin
X
XSHELL = /bin/sh
XMAKE = /bin/make
X
X# Please don't change these.
XSRC = $(PROGNAME).icn $(ITLIB).icn iscreen.icn
X
X# I hope you won't have to use this.
X# DEBUGFLAG = -t
X
X$(PROGNAME): $(SRC)
X	$(ICONC) $(DEBUGFLAG) -o $(PROGNAME) $(SRC)
X
X# Pessimistic assumptions regarding the environment (in particular,
X# I don't assume you have the BSD "install" shell script).
Xinstall: $(PROGNAME)
X	test -d $(DESTDIR) || (mkdir $(DESTDIR) && chmod 755 $(DESTDIR))
X	cp $(PROGNAME) $(DESTDIR)/
X	chgrp $(GROUP) $(DESTDIR)/$(PROGNAME)
X	chown $(OWNER) $(DESTDIR)/$(PROGNAME)
X	@echo "Installation done."
X	@echo ""
X
Xclean:
X	-rm -f *~ *.u?
X	-rm -f $(PROGNAME)
SHAR_EOF
true || echo 'restore of Makefile.dist failed'
rm -f _shar_wnt_.tmp
fi
rm -f _shar_seq_.tmp
echo You have unpacked the last part
exit 0
-- 

   -Richard L. Goerwitz              goer%midway@uchicago.bitnet
   goer@midway.uchicago.edu          rutgers!oddjob!ellis!goer
Newsgroups: comp.lang.icon