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