summaryrefslogtreecommitdiff
path: root/ipl/progs/concord.icn
blob: d1c0ad3793d329ee2d4befd1fb593e251d4f7328 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
############################################################################
#
#	File:     concord.icn
#
#	Subject:  Program to produce concordance
#
#	Author:   Ralph E. Griswold
#
#	Date:     October 9, 1994
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#     This program produces a simple concordance from standard input to standard
#  output. Words less than three characters long are ignored.
#
#     There are two options:
#
#	-l n	set maximum line length to n (default 72), starts new line
#	-w n	set maximum width for word to n (default 15), truncates
#
#     There are lots of possibilities for improving this program and adding
#  functionality to it. For example, a list of words to be ignored could be
#  provided.  The formatting could be made more flexible, and so on.
#
############################################################################
#
#     Note that the program is organized to make it easy (via item()) to
#  handle other kinds of tabulations.
#
############################################################################
#
#  Links: options
#
############################################################################

link options

global uses, colmax, namewidth, lineno

procedure main(args)
   local opts, uselist, name, line, pad, i, j, fill

   opts := options(args, "l+w+")		# process options
   colmax := \opts["l"] | 72
   namewidth := \opts["w"] | 15

   pad := repl(" ", namewidth)
   uses := table()
   lineno := 0

   every tabulate(item(), lineno)		# tabulate all the citations

   uselist := sort(uses, 3)			# sort by uses
   while fill := left(get(uselist), namewidth) do {
      line := format(get(uselist))		# line numbers
      while (*line + namewidth) > colmax do {	# handle long lines
         line ?:= {
            i := j := 0
             every i := upto(' ') do {
                if i > (colmax - namewidth) then break
                else j := i
                }
             write(fill, tab(j))
             move(1)
             fill := pad
             tab(0)				# new value of line
             }
         }
         if *line > 0 then write(fill, trim(line))
      } 
 
end

#  Add to count of line number to citations for name.
#
procedure tabulate(name, lineno)

   /uses[name] := table(0)
   uses[name][lineno] +:= 1

   return

end

#  Format the line numbers, breaking long lines as necessary.
#
procedure format(linenos)
   local i, line

   linenos := sort(linenos, 3)
   line := ""

   while line ||:= get(linenos) do
      line ||:= ("(" || (1 < get(linenos)) || ") ") | " "

   return line

end

#  Get an item. Different kinds of concordances can be obtained by
#  modifying this procedure.
#
procedure item()
   local i, word, line

   while line := read() do {
      lineno +:= 1
      write(right(lineno, 6), "  ", line)
      line := map(line)				# fold to lowercase
      i := 1
      line ? {
         while tab(upto(&letters)) do {
            word := tab(many(&letters))
            if *word >= 3 then suspend word	# skip short words
            }
         }
      }

end