1
2(********************************************************************)
3(*                                                                  *)
4(*  dirx.sd7      Make a directory listing                          *)
5(*  Copyright (C) 1994, 2004  Thomas Mertes                         *)
6(*                                                                  *)
7(*  This program is free software; you can redistribute it and/or   *)
8(*  modify it under the terms of the GNU General Public License as  *)
9(*  published by the Free Software Foundation; either version 2 of  *)
10(*  the License, or (at your option) any later version.             *)
11(*                                                                  *)
12(*  This program is distributed in the hope that it will be useful, *)
13(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
14(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
15(*  GNU General Public License for more details.                    *)
16(*                                                                  *)
17(*  You should have received a copy of the GNU General Public       *)
18(*  License along with this program; if not, write to the           *)
19(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
20(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
21(*                                                                  *)
22(********************************************************************)
23
24
25$ include "seed7_05.s7i";
26  include "stdio.s7i";
27  include "osfiles.s7i";
28  include "console.s7i";
29
30
31const func boolean: wildcard_match (in string: main_stri, in string: pattern) is func
32
33  result
34    var boolean: doesMatch is FALSE;
35
36  local
37    var integer: main_length is 0;
38    var integer: main_index is 1;
39    var string: pattern_tail is "";
40
41  begin
42    if pattern = "" then
43      doesMatch := main_stri = "";
44    else
45      case pattern[1] of
46        when {'*'}:
47          if pattern = "*" then
48            doesMatch := TRUE;
49          else
50            main_length := length(main_stri);
51            pattern_tail := pattern[2 .. ];
52            while main_index <= main_length and not doesMatch do
53              doesMatch := wildcard_match(main_stri[main_index .. ],
54                  pattern_tail);
55              incr(main_index);
56            end while;
57          end if;
58        when {'?'}:
59          if main_stri <> "" then
60            doesMatch := wildcard_match(main_stri[2 .. ], pattern[2 .. ]);
61          end if;
62        otherwise:
63          if main_stri <> "" and main_stri[1] = pattern[1] then
64            doesMatch := wildcard_match(main_stri[2 .. ], pattern[2 .. ]);
65          end if;
66      end case;
67    end if;
68  end func;
69
70
71const proc: main is func
72
73  local
74    var string: pattern is "";
75    var array string: names is 0 times "";
76    var integer: number_of_names is 0;
77    var integer: index is 0;
78    var integer: copy_index is 0;
79    var integer: width is 0;
80    var integer: num_lines is 0;
81    var integer: num_columns is 1;
82    var integer: line is 0;
83    var integer: column is 0;
84    var integer: num2 is 0;
85
86  begin
87    OUT := STD_CONSOLE;
88    if length(argv(PROGRAM)) = 0 then
89      names := readDir(".");
90    elsif length(argv(PROGRAM)) = 1 then
91      names := readDir(".");
92      pattern := argv(PROGRAM)[1];
93    else
94      names := argv(PROGRAM);
95(*  else
96      write("pattern? ");
97      readln(pattern); *)
98    end if;
99(*  write("directory? ");
100    names := readDir(getln(IN)); *)
101    number_of_names := length(names);
102    if pattern <> "" then
103      copy_index := 1;
104      for index range 1 to number_of_names do
105        if wildcard_match(names[index], pattern) then
106          names[copy_index] := names[index];
107          incr(copy_index);
108        end if;
109      end for;
110      number_of_names := pred(copy_index);
111    end if;
112    if number_of_names <> 0 then
113      width := 0;
114      for index range 1 to number_of_names do
115        if length(names[index]) > width then
116          width := length(names[index]);
117        end if;
118      end for;
119      if width < 80 then
120        num_columns := 80 div succ(width);
121      else
122        width := 0;
123      end if;
124      num2 := succ(pred(number_of_names) mod num_columns);
125      if num2 = num_columns then
126        decr(num2);
127      end if;
128      num_lines := succ(pred(number_of_names) div num_columns);
129      writeln;
130      for line range 1 to num_lines do
131        for column range 1 to num2 + 1 do
132          if num_columns * pred(line) + column <= number_of_names then
133            write(names[line + num_lines * pred(column)] rpad width);
134            if column <> num_columns then
135              write(" ");
136            end if;
137          end if;
138        end for;
139        for column range num2 + 2 to num_columns do
140          if num_columns * pred(line) + column <= number_of_names then
141            write(names[line + num_lines * num2 +
142                pred(num_lines) * pred(column - num2)] rpad width);
143            if column <> num_columns then
144              write(" ");
145            end if;
146          end if;
147        end for;
148        writeln;
149      end for;
150    end if;
151  end func;
152