home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OL.LZH / PROCS.LZH / ITLIB.ICN < prev    next >
Text File  |  1991-07-13  |  13KB  |  461 lines
  1. ########################################################################
  2. #    
  3. #    Name:     itlib.icn
  4. #    
  5. #    Title:     Icon termlib-type tools
  6. #    
  7. #    Author:     Richard L. Goerwitz
  8. #
  9. #    Date:     June 3, 1991
  10. #
  11. #    Version: 1.28
  12. #
  13. #########################################################################
  14. #
  15. #  The following library represents a series of rough functional
  16. #  equivalents to the standard Unix low-level termcap routines.  They
  17. #  are not meant as exact termlib clones.  Nor are they enhanced to
  18. #  take care of magic cookie terminals, terminals that use \D in their
  19. #  termcap entries, or, in short, anything I felt would not affect my
  20. #  normal, day-to-day work with ANSI and vt100 terminals.  There are
  21. #  some machines with incomplete or skewed implementations of stty for
  22. #  which itlib will not work.  See the BUGS section below for work-
  23. #  arounds.
  24. #
  25. #  Requires:  A unix platform & co-expressions.  There is an MS-DOS
  26. #  version, itlibdos.icn.
  27. #
  28. #  setname(term)
  29. #    Use only if you wish to initialize itermlib for a terminal
  30. #  other than what your current environment specifies.  "Term" is the
  31. #  name of the termcap entry to use.  Normally this initialization is
  32. #  done automatically, and need not concern the user.
  33. #
  34. #  getval(id)
  35. #    Works something like tgetnum, tgetflag, and tgetstr.  In the
  36. #  spirit of Icon, all three have been collapsed into one routine.
  37. #  Integer valued caps are returned as integers, strings as strings,
  38. #  and flags as records (if a flag is set, then type(flag) will return
  39. #  "true").  Absence of a given capability is signalled by procedure
  40. #  failure.
  41. #
  42. #  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
  43. #    Analogous to tgoto.  "Cm" is the cursor movement command for
  44. #  the current terminal, as obtained via getval("cm").  Igoto()
  45. #  returns a string which, when output via iputs, will cause the
  46. #  cursor to move to column "destcol" and line "destline."  Column and
  47. #  line are always calculated using a *one* offset.  This is far more
  48. #  Iconish than the normal zero offset used by tgoto.  If you want to
  49. #  go to the first square on your screen, then include in your program
  50. #  "iputs(igoto(getval("cm"),1,1))."
  51. #
  52. #  iputs(cp,affcnt)
  53. #    Equivalent to tputs.  "Cp" is a string obtained via getval(),
  54. #  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
  55. #  count of affected lines.  It is only relevant for terminals which
  56. #  specify proportional (starred) delays in their termcap entries.
  57. #
  58. #  BUGS:  I have not tested these routines much on terminals that
  59. #  require padding.  These routines WILL NOT WORK if your machine's
  60. #  stty command has no -g option (tisk, tisk).  This includes 1.0 NeXT
  61. #  workstations, and some others that I haven't had time to pinpoint.
  62. #  If you are on a BSD box, try typing "sh -c 'stty -g | more'" it may
  63. #  be that your stty command is too clever (read stupid) to write its
  64. #  output to a pipe.  The current workaround is to replace every in-
  65. #  stance of /bin/stty with /usr/5bin/stty (or whatever your system
  66. #  calls the System V stty command) in this file.  If you have no SysV
  67. #  stty command online, try replaceing "stty -g 2>&1" below with, say,
  68. #  "stty -g 2>&1 1> /dev/tty."  If you are using mainly modern ter-
  69. #  minals that don't need padding, consider using iolib.icn instead of
  70. #  itlib.icn.
  71. #
  72. ##########################################################################
  73. #
  74. #  Requires: UNIX, co-expressions
  75. #
  76. #  See also: iscreen.icn (a set of companion utilities), iolib.icn
  77. #
  78. ##########################################################################
  79.  
  80.  
  81. global tc_table, tty_speed
  82. record true()
  83.  
  84.  
  85. procedure check_features()
  86.  
  87.     local in_params, line
  88.     # global tty_speed
  89.  
  90.     initial {
  91.     find("unix",map(&features)) |
  92.         er("check_features","unix system required",1)
  93.     find("o-expres",&features) |
  94.         er("check_features","co-expressions not implemented - &$#!",1)
  95.     system("/bin/stty tabs") |
  96.         er("check_features","can't set tabs option",1)
  97.     }
  98.  
  99.     # clumsy, clumsy, clumsy, and probably won't work on all systems
  100.     tty_speed := getspeed()
  101.     return "term characteristics reset; features check out"
  102.  
  103. end
  104.  
  105.  
  106.  
  107. procedure setname(name)
  108.  
  109.     # Sets current terminal type to "name" and builds a new termcap
  110.     # capability database (residing in tc_table).  Fails if unable to
  111.     # find a termcap entry for terminal type "name."  If you want it
  112.     # to terminate with an error message under these circumstances,
  113.     # comment out "| fail" below, and uncomment the er() line.
  114.  
  115.     #tc_table is global
  116.     
  117.     check_features()
  118.  
  119.     tc_table := table()
  120.     tc_table := maketc_table(getentry(name)) | fail
  121.     # er("setname","no termcap entry found for "||name,3)
  122.     return "successfully reset for terminal " || name
  123.  
  124. end
  125.  
  126.  
  127.  
  128. procedure getname()
  129.  
  130.     # Getname() first checks to be sure we're running under Unix, and,
  131.     # if so, tries to figure out what the current terminal type is,
  132.     # checking successively the value of the environment variable
  133.     # TERM, and then the output of "tset -".  Terminates with an error
  134.     # message if the terminal type cannot be ascertained.
  135.  
  136.     local term, tset_output
  137.  
  138.     check_features()
  139.  
  140.     if not (term := getenv("TERM")) then {
  141.     tset_output := open("/bin/tset -","pr") |
  142.         er("getname","can't find tset command",1)
  143.     term := !tset_output
  144.     close(tset_output)
  145.     }
  146.     return \term |
  147.     er("getname","can't seem to determine your terminal type",1)
  148.  
  149. end
  150.  
  151.  
  152.  
  153. procedure er(func,msg,errnum)
  154.  
  155.     # short error processing utility
  156.     write(&errout,func,":  ",msg)
  157.     exit(errnum)
  158.  
  159. end
  160.  
  161.  
  162.  
  163. procedure getentry(name, termcap_string)
  164.     local entry
  165.  
  166.     # "Name" designates the current terminal type.  Getentry() scans
  167.     # the current environment for the variable TERMCAP.  If the
  168.     # TERMCAP string represents a termcap entry for a terminal of type
  169.     # "name," then getentry() returns the TERMCAP string.  Otherwise,
  170.     # getentry() will check to see if TERMCAP is a file name.  If so,
  171.     # getentry() will scan that file for an entry corresponding to
  172.     # "name."  If the TERMCAP string does not designate a filename,
  173.     # getentry() will scan /etc/termcap for the correct entry.
  174.     # Whatever the input file, if an entry for terminal "name" is
  175.     # found, getentry() returns that entry.  Otherwise, getentry()
  176.     # fails.
  177.  
  178.     local f, getline, line, nm, ent1, ent2
  179.  
  180.     # You can force getentry() to use a specific termcap file by cal-
  181.     # ling it with a second argument - the name of the termcap file
  182.     # to use instead of the regular one, or the one specified in the
  183.     # termcap environment variable.
  184.     /termcap_string := getenv("TERMCAP")
  185.  
  186.     if \termcap_string ? (not match("/"), pos(1) | tab(find("|")+1), =name)
  187.     then return termcap_string
  188.     else {
  189.  
  190.     # The logic here probably isn't clear.  The idea is to try to use
  191.     # the termcap environment variable successively as 1) a termcap en-
  192.     # try and then 2) as a termcap file.  If neither works, 3) go to
  193.     # the /etc/termcap file.  The else clause here does 2 and, if ne-
  194.     # cessary, 3.  The "\termcap_string ? (not match..." expression
  195.     # handles 1.
  196.  
  197.     if find("/",\termcap_string)
  198.     then f := open(termcap_string)
  199.     /f := open("/etc/termcap") |
  200.         er("getentry","I can't access your /etc/termcap file",1)
  201.  
  202.     getline := create read_file(f)
  203.     
  204.     while line := @getline do {
  205.         if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then {
  206.         entry := ""
  207.         while (\line | @getline) ? {
  208.             if entry ||:= 1(tab(find(":")+1), pos(0))
  209.             then {
  210.             close(f)
  211.             # if entry ends in tc= then add in the named tc entry
  212.             entry ?:= tab(find("tc=")) ||
  213.                 # recursively fetch the new termcap entry
  214.                 (move(3), getentry(tab(find(":"))) ?
  215.                     # remove the name field from the new entry
  216.                      (tab(find(":")+1), tab(0)))
  217.             return entry
  218.             }
  219.             else {
  220.             \line := &null # must precede the next line
  221.             entry ||:= trim(trim(tab(0),'\\'),':')
  222.             }
  223.         }
  224.         }
  225.     }
  226.     }
  227.  
  228.     close(f)
  229.     er("getentry","can't find and/or process your termcap entry",3)
  230.  
  231. end
  232.  
  233.  
  234.  
  235. procedure read_file(f)
  236.  
  237.     # Suspends all non #-initial lines in the file f.
  238.     # Removes leading tabs and spaces from lines before suspending
  239.     # them.
  240.  
  241.     local line
  242.  
  243.     \f | er("read_tcap_file","no valid termcap file found",3)
  244.     while line := read(f) do {
  245.     match("#",line) & next
  246.     line ?:= (tab(many('\t ')) | &null, tab(0))
  247.     suspend line
  248.     }
  249.  
  250.     fail
  251.  
  252. end
  253.  
  254.  
  255.  
  256. procedure maketc_table(entry)
  257.  
  258.     # Maketc_table(s) (where s is a valid termcap entry for some
  259.     # terminal-type): Returns a table in which the keys are termcap
  260.     # capability designators, and the values are the entries in
  261.     # "entry" for those designators.
  262.  
  263.     local k, v
  264.  
  265.     /entry & er("maketc_table","no entry given",8)
  266.     if entry[-1] ~== ":" then entry ||:= ":"
  267.     
  268.     /tc_table := table()
  269.  
  270.     entry ? {
  271.  
  272.     tab(find(":")+1)    # tab past initial (name) field
  273.  
  274.     while tab((find(":")+1) \ 1) ? {
  275.         &subject == "" & next
  276.         if k := 1(move(2), ="=")
  277.         then tc_table[k] := Decode(tab(find(":")))
  278.         else if k := 1(move(2), ="#")
  279.         then tc_table[k] := integer(tab(find(":")))
  280.         else if k := 1(tab(find(":")), pos(-1))
  281.         then tc_table[k] := true()
  282.         else er("maketc_table", "your termcap file has a bad entry",3)
  283.     }
  284.     }
  285.  
  286.     return tc_table
  287.  
  288. end
  289.  
  290.  
  291.  
  292. procedure getval(id)
  293.  
  294.     /tc_table := maketc_table(getentry(getname())) |
  295.     er("getval","can't make a table for your terminal",4)
  296.  
  297.     return \tc_table[id] | fail
  298.     # er("getval","the current terminal doesn't support "||id,7)
  299.  
  300. end
  301.  
  302.  
  303.  
  304. procedure Decode(s)
  305.     local new_s, chr, chr2
  306.  
  307.     # Does things like turn ^ plus a letter into a genuine control
  308.     # character.
  309.  
  310.     new_s := ""
  311.  
  312.     s ? {
  313.  
  314.     while new_s ||:= tab(upto('\\^')) do {
  315.         chr := move(1)
  316.         if chr == "\\" then {
  317.         new_s ||:= {
  318.             case chr2 := move(1) of {
  319.             "\\" : "\\"
  320.             "^"  : "^"
  321.             "E"  : "\e"
  322.             "b"  : "\b"
  323.             "f"  : "\f"
  324.             "n"  : "\n"
  325.             "r"  : "\r"
  326.             "t"  : "\t"
  327.             default : {
  328.                 if any(&digits,chr2) then {
  329.                 char(integer("8r"||chr2||move(2 to 0 by -1))) |
  330.                     er("Decode","bad termcap entry",3)
  331.                 }
  332.                else chr2
  333.             }
  334.             }
  335.         }
  336.         }
  337.         else new_s ||:= char(ord(map(move(1),&lcase,&ucase)) - 64)
  338.     }
  339.     new_s ||:= tab(0)
  340.     }
  341.  
  342.     return new_s
  343.  
  344. end
  345.  
  346.  
  347.  
  348. procedure igoto(cm,col,line)
  349.  
  350.     local colline, range, increment, padding, str, outstr, chr, x, y
  351.  
  352.     if col > (tc_table["co"]) | line > (tc_table["li"]) then {
  353.     colline := string(\col) || "," || string(\line) | string(\col|line)
  354.     range := "(" || tc_table["co"]-1 || "," || tc_table["li"]-1 || ")"
  355.     er("igoto",colline || " out of range " || (\range|""),9)
  356.     } 
  357.  
  358.     # Use the Iconish 1;1 upper left corner & not the C-ish 0 offsets
  359.     increment := -1
  360.     outstr := ""
  361.     
  362.     cm ? {
  363.     while outstr ||:= tab(find("%")) do {
  364.         tab(match("%"))
  365.         if padding := integer(tab(any('23')))
  366.         then chr := (="d" | "d")
  367.         else chr := move(1)
  368.         if case \chr of {
  369.         "." :  outstr ||:= char(line + increment)
  370.         "+" :  outstr ||:= char(line + ord(move(1)) + increment)
  371.         "d" :  {
  372.             str := string(line + increment)
  373.             outstr ||:= right(str, \padding, "0") | str
  374.         }
  375.         }
  376.         then line :=: col
  377.         else {
  378.         case chr of {
  379.             "n" :  line := ixor(line,96) & col := ixor(col,96)
  380.             "i" :  increment := 0
  381.             "r" :  line :=: col
  382.             "%" :  outstr ||:= "%"
  383.             "B" :  line := ior(ishift(line / 10, 4), line % 10)
  384.             ">" :  {
  385.             x := move(1); y := move(1)
  386.             line > ord(x) & line +:= ord(y)
  387.             &null
  388.             }
  389.         } | er("goto","bad termcap entry",5)
  390.         }
  391.     }
  392.     return outstr || tab(0)
  393.     }
  394.  
  395. end
  396.  
  397.  
  398.  
  399. procedure iputs(cp, affcnt)
  400.  
  401.     local baud_rates, char_rates, i, delay, PC, char_time
  402.     static num_chars, char_times
  403.     # global tty_speed
  404.  
  405.     initial {
  406.     num_chars := &digits ++ '.'
  407.     char_times := table()
  408.     # Baud rates in decimal, not octal (as in termio.h)
  409.     baud_rates := [0,7,8,9,10,11,12,13,14,15]
  410.     char_rates := [0,333,166,83,55,41,20,10,10,10]
  411.     every i := 1 to *baud_rates do {
  412.         char_times[baud_rates[i]] := char_rates[i]
  413.     }
  414.     }
  415.  
  416.     type(cp) == "string" |
  417.     er("iputs","you can't iputs() a non-string value!",10)
  418.  
  419.     cp ? {
  420.     delay := tab(many(num_chars))
  421.     if ="*" then {
  422.         delay *:= \affcnt |
  423.         er("iputs","affected line count missing",6)
  424.     }
  425.     writes(tab(0))
  426.     }
  427.  
  428.     if (\delay, tty_speed ~= 0) then {
  429.     PC := tc_table["pc"] | "\000"
  430.     char_time := char_times[tty_speed] | (return "speed error")
  431.     delay := (delay * char_time) + (char_time / 2)
  432.     every 1 to delay by 10
  433.     do writes(PC)
  434.     }
  435.  
  436.     return
  437.  
  438. end
  439.  
  440.  
  441.  
  442. procedure getspeed()
  443.  
  444.     local stty_g, stty_output, c_cflag, o_speed
  445.  
  446.     stty_g := open("/bin/stty -g 2>&1","pr") |
  447.     er("getspeed","Can't access your stty command.",4)
  448.     stty_output := !stty_g
  449.     close(stty_g)
  450.  
  451.     \stty_output ? {
  452.     # tab to the third field of the output of the stty -g cmd
  453.         tab(find(":")+1) & tab(find(":")+1) &
  454.     c_cflag := integer("16r"||tab(find(":")))
  455.     } | er("getspeed","Unable to unwind your stty -g output.",4)
  456.  
  457.     o_speed := iand(15,c_cflag)
  458.     return o_speed
  459.  
  460. end
  461.