This Treescript program counts the no. of lines of code in all Pascal source files of the user-selected Delphi project file(s). It has exactly the same functionality as the previous Delphi code listing.
import (windows *)
import (ini-files *)
(class (public) Count-form extends Form
var (auto) (
Button sel-btn;
Button count-btn;
Label xlb-count;
Label xlb-proj-name;
Open-dialog open-dialog;
)
var (private) (
String ini-full-file-name;
String dpr-full-file-name;
String key-full-file-name;
String dpr-file-path;
list String dpr-file-list;
list String pas-file-list;
list String keyword-list;
list String dpr-files;
)
var (static) (
String def-sect ('Settings');
)
(proc (public static) main (String-list args)
var (
Count-form form1 (new Count-form);
)
)
(cons (public) Count-form
do (
= dpr-file-list (new list String);
= pas-file-list (new list String);
= key-file-list (new list String);
show;
)
)
(proc (auto) Count-form_activate (Event e)
var (
int i;
Ini-file ini-file;
String zcount-path;
)
do (
= (: xlb-count caption) '';
= zcount-path (extract-file-path
(: application exe-name));
= key-full-file-name (+ zcount-path 'Keywords.txt');
: keyword-list (load-from-file key-full-file-name);
for i keyword-list do (
= (: keyword-list i) (trim (lower-case
(: keyword-list i)));
if (== (: keyword-list i) '') then (
: keyword-list (delete i);
-- i;
);
);
= ini-full-file-name (+ zcount-path 'ZCount.ini');
= ini-file (new (Ini-file ini-full-file-name));
= dpr-files nil;
= dpr-full-file-name (: ini-file (read-string
def-sect 'Path' ''));
set-btns-and-labels;
)
)
(proc (private) set-btns-and-labels
do (
= (: count-btn enabled)
(file-exists dpr-full-file-name);
= (: xlb-count caption) '';
= (: xlb-proj-name caption) dpr-full-file-name;
= dpr-file-path (extract-file-path dpr-full-file-name);
);
)
(proc (auto) sel-btn_click (Event e)
var (
Ini-file ini-file;
)
do (
= (: open-dialog initial-dir)
(extract-file-path dpr-full-file-nams);
if (not (open-dialog execute)) then (
exit;
);
= dpr-full-file-name (open-dialog file-name);
= dpr-files (open-dialog files);
= ini-file (new (Ini-file ini-full-file-name));
: ini-file (write-string def-sect 'Path'
dpr-full-file-name);
set-btns-and-labels;
)
)
(proc (auto) count-btn_click (Event e)
var (
int line-count;
int i;
String full-file-name;
)
do (
= line-count 0;
= (: screen cursor) cr-hour-glass;
try (
if (== dpr-files nil) then (
= line-count (get-dpr-count dpr-full-file-name);
= (: xlb-count caption) line-count;
update;
)
else (
for i dpr-files do (
= full-file-name (: dpr-files i);
+= line-count (get-dpr-count full-file-name);
= (: xlb-count caption) line-count;
update;
);
);
)
finally (
= (: screen cursor) cr-default;
);
)
)
(func int get-dpr-count (String dpr-full-file-name)
var (
int line-count;
int (i j);
String buf;
String file-name;
String full-file-name;
String quote-str;
)
do (
= line-count 0;
= quote-str '\'';
: dpr-file-list (load-from-file dpr-full-file-name);
for i dpr-file-list do (
= buf (: dpr-file-list i);
= j (pos quote-str buf);
if (<= j 0) then (
continue;
);
= file-name (copy buf (+ j 1) (length buf));
= file-name (copy file-name 1
(- (pos quote-str file-name) 1));
= file-name (trim file-name);
= full-file-name (+ dpr-file-path file-name);
+= line-count (get-line-count full-file-name);
);
return line-count;
)
)
(func int get-line-count (String full-file-name)
var (
int i;
String buf;
int start-ln;
int end-ln;
int top-wspace-count;
int wspace-count;
)
do (
if (not (file-exists full-file-name)) then (
return 0;
);
: pas-file-list (load-from-file full-file-name);
= top-wspace-count 0;
= wspace-count 0;
= start-ln 1;
= end-ln (: pas-file-list count);
for i pas-file-list do (
= buf (trim (lower-case (: pas-file-list i)));
if (== buf 'implementation') then (
= start-ln (+ i 1);
)
elseif (== buf 'end.') then (
= end-ln (- i 1);
break;
)
elseif (not (is-white-space buf)) then ()
elseif (> start-ln 1) then (
++ wspace-count;
)
else (
++ top-wspace-count;
);
);
if (<= wspace-count 0) then (
= wspace-count top-wspace-count;
);
return (+ end-ln (- start-ln) (- wspace-count) 1);
)
)
(func boolean is-white-space (String buf)
var (
int i;
char ch;
String word-str;
boolean result;
)
do (
+= buf ' ';
= word-str '';
for i (1 (length buf)) do (
= ch (buf i);
if (in ch (.. 'a' 'z')) then (
+= word-str ch;
)
elseif (<> word-str '') then (
= result (>=
(: keyword-list (index-of word-str)) 0);
if (not result) then (
return false;
);
= word-str '';
)
elseif (not (in ch (' ' ';'))) then
return false;
)
else (
= word-str '';
);
);
return true;
)
)
)