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