home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / progs / iplkwic.icn < prev    next >
Text File  |  2001-05-02  |  4KB  |  139 lines
  1. ############################################################################
  2. #
  3. #    File:     iplkwic.icn
  4. #
  5. #    Subject:  Program to produce keywords in context for IPL
  6. #
  7. #    Author:   Stephen B. Wampler, modified by Ralph E. Griswold
  8. #
  9. #    Date:     May 2, 2001
  10. #
  11. ###########################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #
  18. #     NOTE:  This is a specialized version used for producing kwic listings
  19. #  for the Icon program library.
  20. #
  21. #     This is a simple keyword-in-context (KWIC) program. It reads from
  22. #  standard input and writes to standard output. The "key" words are
  23. #  aligned at a specified column, with the text shifted as necessary. Text
  24. #  shifted left is truncated at the left. Tabs and other characters whose
  25. #  "print width" is less than one may not be handled properly.
  26. #
  27. #  The following options are supported:
  28. #
  29. #    -c i    column at which keywords are aligned, default 30
  30. #    -h i    width of identifying column at left, default 20
  31. #
  32. #     Some noise words are omitted (see "exceptions" in the program text).
  33. #  If a file named except.wrd is open and readable in the current directory,
  34. #  the words in it are used instead.
  35. #
  36. #     This program is pretty simple.  Possible extensions include ways
  37. #  of specifying words to be omitted, more flexible output formatting, and
  38. #  so on.  Another "embellisher's delight".
  39. #
  40. ############################################################################
  41. #
  42. #  Links:  options
  43. #
  44. ############################################################################
  45.  
  46. link options
  47.  
  48. global line, loc, exceptions, width, tag, head
  49.  
  50. record pair(new, old)
  51.  
  52. procedure main(args)
  53.    local exceptfile, opts
  54.  
  55.    opts := options(args, "c+h+")
  56.    width := \opts["c"] | 30
  57.    head := \opts["h"] | 20
  58.  
  59.    if exceptfile := open("except.wrd") then {
  60.       exceptions := set()
  61.       every insert(exceptions, lcword(exceptfile))
  62.       close(exceptfile)
  63.       }
  64.    else
  65.       exceptions := set(["and", "for", "into", "all", "from", "get", "put",
  66.          "compute", "perform", "apply", "model", "value", "model", "operator",
  67.          "out", "problem", "produce", "such", "use", "operation"])
  68.  
  69.    every write(filter(kwic(&input)))
  70.  
  71. end
  72.  
  73. procedure kwic(file)
  74.    local index, word
  75.  
  76. #  Each word, in lowercase form, is a key in the table "index".
  77. #  The corresponding values are lists of the positioned lines
  78. #  for that word.  This method may use an impractically large
  79. #  amount of space for large input files.
  80.  
  81.    index := table()
  82.    every word := lcword(file) do {
  83.       if not member(exceptions,word) then {
  84.          /index[word] := []
  85.          index[word] := put(index[word],position())
  86.          }
  87.       }
  88.  
  89. #  Before the new sort options, it was done this way -- the code preserved
  90. #  as an example of "generators in action".
  91.  
  92. #  suspend !((!sort(index,1))[2])
  93.  
  94.    index := sort(index,3)
  95.    while get(index) do
  96.       suspend !get(index)
  97. end
  98.  
  99. procedure lcword(file)
  100.    local name, word
  101.    static chars
  102.  
  103.    initial {
  104.       chars := &letters ++ &digits ++ '\''
  105.       tag := table()
  106.       }
  107.  
  108.    every line := !file do {
  109.       line ?:= {
  110.          name := tab(find(": "))    # program name
  111.          move(2)            # skip trash
  112.          tab(0)                # rest is now line
  113.          }
  114.       tag[line] := name            # name for the line
  115.       line ? {
  116.          while tab(loc := upto(chars)) do {
  117.             word := map(tab(many(chars)))
  118.             if *word > 2 & not(any('(')) then suspend word
  119.             }
  120.           }
  121.       }
  122. end
  123.  
  124. procedure position()
  125.    local offset
  126.  
  127. #  Note that "line" and "loc" are global.
  128.  
  129.    offset := width - loc
  130.    if offset >= 0 then return pair(repl(" ",offset) || line, line)
  131.    else return pair(line[-offset + 1:0], line)
  132. end
  133.  
  134. procedure filter(result)
  135.  
  136.    return left(tag[result.old], head) || result.new
  137.  
  138. end
  139.