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 / concord.icn < prev    next >
Text File  |  2000-07-29  |  3KB  |  124 lines
  1. ############################################################################
  2. #
  3. #    File:     concord.icn
  4. #
  5. #    Subject:  Program to produce concordance
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     October 9, 1994
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #     This program produces a simple concordance from standard input to standard
  18. #  output. Words less than three characters long are ignored.
  19. #
  20. #     There are two options:
  21. #
  22. #    -l n    set maximum line length to n (default 72), starts new line
  23. #    -w n    set maximum width for word to n (default 15), truncates
  24. #
  25. #     There are lots of possibilities for improving this program and adding
  26. #  functionality to it. For example, a list of words to be ignored could be
  27. #  provided.  The formatting could be made more flexible, and so on.
  28. #
  29. ############################################################################
  30. #
  31. #     Note that the program is organized to make it easy (via item()) to
  32. #  handle other kinds of tabulations.
  33. #
  34. ############################################################################
  35. #
  36. #  Links: options
  37. #
  38. ############################################################################
  39.  
  40. link options
  41.  
  42. global uses, colmax, namewidth, lineno
  43.  
  44. procedure main(args)
  45.    local opts, uselist, name, line, pad, i, j, fill
  46.  
  47.    opts := options(args, "l+w+")        # process options
  48.    colmax := \opts["l"] | 72
  49.    namewidth := \opts["w"] | 15
  50.  
  51.    pad := repl(" ", namewidth)
  52.    uses := table()
  53.    lineno := 0
  54.  
  55.    every tabulate(item(), lineno)        # tabulate all the citations
  56.  
  57.    uselist := sort(uses, 3)            # sort by uses
  58.    while fill := left(get(uselist), namewidth) do {
  59.       line := format(get(uselist))        # line numbers
  60.       while (*line + namewidth) > colmax do {    # handle long lines
  61.          line ?:= {
  62.             i := j := 0
  63.              every i := upto(' ') do {
  64.                 if i > (colmax - namewidth) then break
  65.                 else j := i
  66.                 }
  67.              write(fill, tab(j))
  68.              move(1)
  69.              fill := pad
  70.              tab(0)                # new value of line
  71.              }
  72.          }
  73.          if *line > 0 then write(fill, trim(line))
  74.       } 
  75.  
  76. end
  77.  
  78. #  Add to count of line number to citations for name.
  79. #
  80. procedure tabulate(name, lineno)
  81.  
  82.    /uses[name] := table(0)
  83.    uses[name][lineno] +:= 1
  84.  
  85.    return
  86.  
  87. end
  88.  
  89. #  Format the line numbers, breaking long lines as necessary.
  90. #
  91. procedure format(linenos)
  92.    local i, line
  93.  
  94.    linenos := sort(linenos, 3)
  95.    line := ""
  96.  
  97.    while line ||:= get(linenos) do
  98.       line ||:= ("(" || (1 < get(linenos)) || ") ") | " "
  99.  
  100.    return line
  101.  
  102. end
  103.  
  104. #  Get an item. Different kinds of concordances can be obtained by
  105. #  modifying this procedure.
  106. #
  107. procedure item()
  108.    local i, word, line
  109.  
  110.    while line := read() do {
  111.       lineno +:= 1
  112.       write(right(lineno, 6), "  ", line)
  113.       line := map(line)                # fold to lowercase
  114.       i := 1
  115.       line ? {
  116.          while tab(upto(&letters)) do {
  117.             word := tab(many(&letters))
  118.             if *word >= 3 then suspend word    # skip short words
  119.             }
  120.          }
  121.       }
  122.  
  123. end
  124.