home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / usenet / altsrcs / 2 / 2387 / itlib.icn < prev   
Encoding:
Text File  |  1990-12-28  |  8.7 KB  |  288 lines
  1. ########################################################################
  2. #    
  3. #    Name:    itlib.icn
  4. #    
  5. #    Title:    Icon termlib-type tools
  6. #    
  7. #    Author:    Richard L. Goerwitz
  8. #
  9. #    Version: 1.23
  10. #
  11. #########################################################################
  12. #
  13. #  I place this and future versions of itlib in the public domain - RLG
  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.
  23. #
  24. #  Requires:  A unix platform & co-expressions.  There is an MS-DOS
  25. #  version, itlibdos.icn.
  26. #
  27. #  setname(term)
  28. #    Use only if you wish to initialize itermlib for a terminal
  29. #  other than what your current environment specifies.  "Term" is the
  30. #  name of the termcap entry to use.  Normally this initialization is
  31. #  done automatically, and need not concern the user.
  32. #
  33. #  getval(id)
  34. #    Works something like tgetnum, tgetflag, and tgetstr.  In the
  35. #  spirit of Icon, all three have been collapsed into one routine.
  36. #  Integer valued caps are returned as integers, strings as strings,
  37. #  and flags as records (if a flag is set, then type(flag) will return
  38. #  "true").  Absence of a given capability is signalled by procedure
  39. #  failure.
  40. #
  41. #  igoto(cm,destcol,destline) - NB:  default 1 offset (*not* zero)!
  42. #    Analogous to tgoto.  "Cm" is the cursor movement command for
  43. #  the current terminal, as obtained via getval("cm").  Igoto()
  44. #  returns a string which, when output via iputs, will cause the
  45. #  cursor to move to column "destcol" and line "destline."  Column and
  46. #  line are always calculated using a *one* offset.  This is far more
  47. #  Iconish than the normal zero offset used by tgoto.  If you want to
  48. #  go to the first square on your screen, then include in your program
  49. #  "iputs(igoto(getval("cm"),1,1))."
  50. #
  51. #  iputs(cp,affcnt)
  52. #    Equivalent to tputs.  "Cp" is a string obtained via getval(),
  53. #  or, in the case of "cm," via igoto(getval("cm"),x,y).  Affcnt is a
  54. #  count of affected lines.  It is only relevant for terminals which
  55. #  specify proportional (starred) delays in their termcap entries.
  56. #
  57. #  Bugs:  I have not tested these routines on terminals that require
  58. #  padding.  These routines WILL NOT WORK if your machines stty com-
  59. #  mand has no -g option (tisk, tisk).  This includes NeXT worksta-
  60. #  tions, and some others that I haven't had time to pinpoint.
  61. #
  62. ##########################################################################
  63. #
  64. #  Requires: UNIX, co-expressions
  65. #
  66. #  See also: iscreen.icn (a set of companion utilities)
  67. #
  68. ##########################################################################
  69.  
  70.  
  71. global tc_table, tty_speed
  72. record true()
  73.  
  74.  
  75. procedure check_features()
  76.  
  77.     local in_params, line
  78.     # global tty_speed
  79.  
  80.     initial {
  81.     find("unix",map(&features)) |
  82.         er("check_features","unix system required",1)
  83.     find("o-expres",&features) |
  84.         er("check_features","co-expressions not implemented - &$#!",1)
  85.     system("/bin/stty tabs") |
  86.         er("check_features","can't set tabs option",1)
  87.     }
  88.  
  89.     # clumsy, clumsy, clumsy, and probably won't work on all systems
  90.     tty_speed := getspeed()
  91.     return "term characteristics reset; features check out"
  92.  
  93. end
  94.  
  95.  
  96.  
  97. procedure setname(name)
  98.  
  99.     # Sets current terminal type to "name" and builds a new termcap
  100.     # capability database (residing in tc_table).  Fails if unable to
  101.     # find a termcap entry for terminal type "name."  If you want it
  102.     # to terminate with an error message under these circumstances,
  103.     # comment out "| fail" below, and uncomment the er() line.
  104.  
  105.     #tc_table is global
  106.     
  107.     check_features()
  108.  
  109.     tc_table := table()
  110.     tc_table := maketc_table(getentry(name)) | fail
  111.     # er("setname","no termcap entry found for "||name,3)
  112.     return "successfully reset for terminal " || name
  113.  
  114. end
  115.  
  116.  
  117.  
  118. procedure getname()
  119.  
  120.     # Getname() first checks to be sure we're running under Unix, and,
  121.     # if so, tries to figure out what the current terminal type is,
  122.     # checking successively the value of the environment variable
  123.     # TERM, and then the output of "tset -".  Terminates with an error
  124.     # message if the terminal type cannot be ascertained.
  125.  
  126.     local term, tset_output
  127.  
  128.     check_features()
  129.  
  130.     if not (term := getenv("TERM")) then {
  131.     tset_output := open("/bin/tset -","pr") |
  132.         er("getname","can't find tset command",1)
  133.     term := !tset_output
  134.     close(tset_output)
  135.     }
  136.     return \term |
  137.     er("getname","can't seem to determine your terminal type",1)
  138.  
  139. end
  140.  
  141.  
  142.  
  143. procedure er(func,msg,errnum)
  144.  
  145.     # short error processing utility
  146.     write(&errout,func,":  ",msg)
  147.     exit(errnum)
  148.  
  149. end
  150.  
  151.  
  152.  
  153. procedure getentry(name, termcap_string)
  154.  
  155.     # "Name" designates the current terminal type.  Getentry() scans
  156.     # the current environment for the variable TERMCAP.  If the
  157.     # TERMCAP string represents a termcap entry for a terminal of type
  158.     # "name," then getentry() returns the TERMCAP string.  Otherwise,
  159.     # getentry() will check to see if TERMCAP is a file name.  If so,
  160.     # getentry() will scan that file for an entry corresponding to
  161.     # "name."  If the TERMCAP string does not designate a filename,
  162.     # getentry() will scan /etc/termcap for the correct entry.
  163.     # Whatever the input file, if an entry for terminal "name" is
  164.     # found, getentry() returns that entry.  Otherwise, getentry()
  165.     # fails.
  166.  
  167.     local f, getline, line, nm, ent1, ent2
  168.  
  169.     # You can force getentry() to use a specific termcap file by cal-
  170.     # ling it with a second argument - the name of the termcap file
  171.     # to use instead of the regular one, or the one specified in the
  172.     # termcap environment variable.
  173.     /termcap_string := getenv("TERMCAP")
  174.  
  175.     if \termcap_string ? (not match("/"), pos(0) | tab(find("|")+1), =name)
  176.     then return termcap_string
  177.     else {
  178.  
  179.     # The logic here probably isn't clear.  The idea is to try to use
  180.     # the termcap environment variable successively as 1) a termcap en-
  181.     # try and then 2) as a termcap file.  If neither works, 3) go to
  182.     # the /etc/termcap file.  The else clause here does 2 and, if ne-
  183.     # cessary, 3.  The "\termcap_string ? (not match..." expression
  184.     # handles 1.
  185.  
  186.     if find("/",\termcap_string)
  187.     then f := open(termcap_string)
  188.     /f := open("/etc/termcap") |
  189.         er("getentry","I can't access your /etc/termcap file",1)
  190.  
  191.     getline := create read_file(f)
  192.     
  193.     while line := @getline do {
  194.         if line ? (pos(1) | tab(find("|")+1), =name, any(':|')) then {
  195.         entry := ""
  196.         while (\line | @getline) ? {
  197.             if entry ||:= 1(tab(find(":")+1), pos(0))
  198.             then {
  199.             close(f)
  200.             # if entry ends in tc= then add in the named tc entry
  201.             entry ?:= tab(find("tc=")) ||
  202.                 # recursively fetch the new termcap entry
  203.                 (move(3), getentry(tab(find(":"))) ?
  204.                     # remove the name field from the new entry
  205.                      (tab(find(":")+1), tab(0)))
  206.             return entry
  207.             }
  208.             else {
  209.             \line := &null # must precede the next line
  210.             entry ||:= trim(trim(tab(0),'\\'),':')
  211.             }
  212.         }
  213.         }
  214.     }
  215.     }
  216.  
  217.     close(f)
  218.     er("getentry","can't find and/or process your termcap entry",3)
  219.  
  220. end
  221.  
  222.  
  223.  
  224. procedure read_file(f)
  225.  
  226.     # Suspends all non #-initial lines in the file f.
  227.     # Removes leading tabs and spaces from lines before suspending
  228.     # them.
  229.  
  230.     local line
  231.  
  232.     \f | er("read_tcap_file","no valid termcap file found",3)
  233.     while line := read(f) do {
  234.     match("#",line) & next
  235.     line ?:= (tab(many('\t ')) | &null, tab(0))
  236.     suspend line
  237.     }
  238.  
  239.     fail
  240.  
  241. end
  242.  
  243.  
  244.  
  245. procedure maketc_table(entry)
  246.  
  247.     # Maketc_table(s) (where s is a valid termcap entry for some
  248.     # terminal-type): Returns a table in which the keys are termcap
  249.     # capability designators, and the values are the entries in
  250.     # "entry" for those designators.
  251.  
  252.     local k, v
  253.  
  254.     /entry & er("maketc_table","no entry given",8)
  255.     if entry[-1] ~== ":" then entry ||:= ":"
  256.     
  257.     /tc_table := table()
  258.  
  259.     entry ? {
  260.  
  261.     tab(find(":")+1)    # tab past initial (name) field
  262.  
  263.     while tab((find(":")+1) \ 1) ? {
  264.         &subject == "" & next
  265.         if k := 1(move(2), ="=")
  266.         then tc_table[k] := Decode(tab(find(":")))
  267.         else if k := 1(move(2), ="#")
  268.         then tc_table[k] := integer(tab(find(":")))
  269.         else if k := 1(tab(find(":")), pos(-1))
  270.         then tc_table[k] := true()
  271.         else er("maketc_table", "your termcap file has a bad entry",3)
  272.     }
  273.     }
  274.  
  275.     return tc_table
  276.  
  277. end
  278.  
  279.  
  280.  
  281. procedure getval(id)
  282.  
  283.     /tc_table := maketc_table(getentry(getname())) |
  284.     er("getval","can't make a table for your terminal",4)
  285.  
  286.     return \tc_table[id] | fail
  287.     # er("getval","the current terminal doesn't support "||id,7)
  288.