(* *****************************************************************
** File    : PrjStats.PAS
** Created : 25.07.00
** Author  :
**
** Macro for FoldMaster
**
********************************************************************
** Version     Date      Change
** 1.48        25.07.00  Creation
** 1.53        05.11.01  Adding Logical LOC counting only ';'
**                       Setting local variables in Do_File_LOC to
**                       a defined start value
** **************************************************************-**)

PROGRAM Project_Statistics;

// Here you can add constants and variables.
// Variables defined in global scope will hold their contents
// until the macro file is unloaded. Functions may use global
// variables to store some information.
(*{{{  const*)
 const
   // global constants
   VK_F11            = $7A;   VK_F12            = $7B;
(*}}}*)
(*{{{  var*)
var
     pro_loc        : integer;
     pro_cl         : integer;
     pro_fs         : integer;
     output         : string;
     logical_LOC    : boolean;
(*}}}*)

// ------------------------------------------------------------------
// FUNCTIONS AND PROCEDURES
// ------------------------------------------------------------------
{ folgende Funktion dient zur Ausgabe der Zeit einer Datei
  in einen String }
(*{{{  FTimeStr(ftime : integer) : string;*)
{ ff_ftime:
Bits 0 to 4   The result of seconds divided by 2 (for example 10 here means 20 seconds)
Bits 5 to 10Minutes
Bits 11 to 15Hours
}
function FTimeStr(ftime : integer) : string;
var sec, min, hour : integer;
begin
   sec  := (ftime AND $1F) *2;
   min  := (ftime SHR 5)  AND $3F;
   hour := (ftime SHR 11) AND $1F;
   ftimestr := '';
   if (hour < 10) then swrite(ftimestr, '0');
   swrite(ftimestr, hour, ':');
   if (min < 10) then swrite(ftimestr, '0');
   swrite(ftimestr, min, ':');
   if (sec < 10) then swrite(ftimestr, '0');
   swrite(ftimestr, sec);
end;
(*}}}*)

{ folgende Funktion dient der Ausgabe des Datums einer Datei
  in einen String }
(*{{{  FDateStr(fdate : integer) : string;*)
{
ff_fdate:
Bits 0-4   Day
Bits 5-8   Month
Bits 9-15  Years since 1980 (for example 9 here means 1989)
}
function FDateStr(fdate : integer) : string;
var day, month, year : integer;
begin
   day   := (fdate AND $1F);
   month := (fdate SHR 5) AND $0F;
   year  := (fdate SHR 9) AND $7F;
   FDateStr := '';
   if (day < 10)   then swrite(FDateStr, '0');
   swrite(FDateStr, day,   '.');
   if (month < 10) then swrite(FDateStr, '0');
   swrite(FDateStr, month, '.', year + 1980);
end;
(*}}}*)


{ Unterprogramm
}
(*{{{  Do_File_LOC;*)
// Counting all lines which are not empty and are containing
// any source code. Suitable for any type of code.
procedure Do_File_LOC;
var loc     : integer;
    comment : integer;
    s       : string;
    n       : string;
begin
   StartOfText; FoldExpandAll;
   loc := 0; comment := 0;
   repeat
      s := GetLineNc(0);   // without comments
      n := GetLine;        // with comments
      //if (s <> '') then inc (loc);     // containing any relevant code
      if ((s <> '') AND (s <> '{') AND (s <> '}')) then begin
         inc (loc);     // containing any relevant code
      end;
      if (s <> n)  then inc (comment); // seems to be line with comments
   until (NOT IsLineDownOk);
   //writeln(GetModuleName, ' : ');
   //writeln('   ', loc:6,     ' LOC      ');
   //writeln('   ', comment:6, ' COMMENTS ');
   pro_loc := pro_loc + loc;
   pro_cl  := pro_cl  + comment;
   swrite (output, '(P)', loc:6, comment:6);
end;
(*}}}*)
(*{{{  Do_Logical_File_LOC_C_CPP;*)
// Only applicable for C or CPP files.
// Counting terminating semicolons ';' in header or source files
// ';' after } are ignored.
procedure Do_Logical_File_LOC_C_CPP;
var loc     : integer;
    comment : integer;
    s       : string;
    n       : integer;
    supress : boolean;
    lnum    : integer;
begin
   StartOfText; FoldExpandAll;
   loc     := 0;
   comment := 0;
   supress := false;
   lnum    := 0;
   repeat
      // Calculate Lines With Comments
      n := GetLineNum;
      if (lnum <> n) then begin
         // NewLine : Check for comments
         if (GetLineNc(0) <> GetLine) then inc (comment);
         lnum := n;
      end;
      s := GetSyntaxItem;
      if (s = '}') then supress := true;
      if ((NOT supress) AND (s = ';')) then inc (loc);
      supress := false;
      SyntaxRight;
   until (IsEndOfText);
   //writeln(GetModuleName, ' : ');
   //writeln('   ', loc:6,     ' LOC      ');
   //writeln('   ', comment:6, ' COMMENTS ');
   pro_loc := pro_loc + loc;
   pro_cl  := pro_cl  + comment;
   swrite (output, '(L)', loc:6, comment:6);
end;
(*}}}*)

(*{{{  File_LOC*)
{ File_LOC
}
procedure File_LOC;
begin
   output := '';
   Lock;
   if (logical_LOC) then begin
      Do_Logical_File_LOC_C_CPP;
   end else begin
      Do_File_LOC;
   end;
   UnLock;
   MacroConsoleOpen;
   writeln(GetModuleName, ' > ', output);
end;
(*}}}*)
(*{{{  Project_LOC;*)
{ Unterprogramm
}
procedure Project_LOC;
var s  : string;
    i  : integer;
    fs : integer;
    fn : string;
    f  : Text;
    fwidth : integer; // width of FileNames
    ftime  : integer;
    fdate  : integer;
begin
   ProjectShow; StartOfText; MacroConsoleClear;
   TempStoreClear(0);
   pro_loc := 0;
   pro_cl  := 0;
   pro_fs  := 0;

   // Determine maximum length of filename
   fwidth := 0; i := 0;
   repeat
      fn := IterateProjectModules(false, i);
      if (fn <> '') then begin
         if (Length(fn) > fwidth) then fwidth := Length(fn);
      end;
      inc(i);
   until (fn = '');

   // Trimm fwidth
   incx(fwidth, 9);

   // Count
   i := 0;
   repeat
      fn := IterateProjectModules(false, i);
      output := '';
      if ((fn <> '') AND (fn <> GetProjectName))then begin
         // Prepare Outputstring
         swrite(output, i:4, ': ', fn);
         output := strfill(output, fwidth);

         // calculate file statistics
         Assign(f,fn); Reset(f); fs := FileSize(f); close(f);
         pro_fs := pro_fs + fs;
         ftime  := FileTime(fn);
         fdate  := FileDate(fn);
         swrite(output, FTimeStr(ftime), '|', FDateStr(fdate), ' ');

         // open and process File
         FileOpen(fn);
         if (IsModuleOpen(fn)) then begin
            s := strupr(GetModuleSyntax);
            if ((s <> 'DEFAULT') AND (s <> 'PLAIN')) then begin
               if (logical_LOC) then begin
                  Lock; Do_Logical_File_LOC_C_CPP; UnLock;
               end else begin
                  Lock; Do_File_LOC; UnLock;
               end;
            end;
            FileClose;
         end;
         TempStoreAddLine(0, output);
         writeln(output);
      end;
      inc(i);
   until (fn = '');
   writeln('-SUMMARY --------------------------');
   writeln(i:7,      ' Files');
   writeln(pro_loc:7,' Lines of Code');
   writeln(pro_cl:7, ' Lines with comments');
   writeln(pro_fs:7, ' Bytes in Files');

   // Sort TempStore
   TempStoreSort(0, fwidth+20);

   // Add Summary
   TempStoreAddLine(0, '-SUMMARY --------------------------');
   s := ''; swrite(s, i:7,      ' Files');              TempStoreAddLine(0, s);
   s := ''; swrite(s, pro_loc:7,' Lines of Code');      TempStoreAddLine(0, s);
   s := ''; swrite(s, pro_cl:7, ' Lines with Comments');TempStoreAddLine(0, s);
   s := ''; swrite(s, pro_fs:7, ' Bytes in Files');     TempStoreAddLine(0, s);

   // Paste contents of tempstore to file
   s := GetProjectName;
   FileNameSetName(s, 'stats');
   FileNameSetExt (s, '.txt');
   FileOpen(s);
   if (IsModuleOpen(s)) then begin
      FileCheckOut;
      TempStorePaste(0);
   end;
end;
(*}}}*)

(*{{{  SetLogicalCount*)
{ SetLogicalCount
}
procedure SetLogicalCount;
begin
   logical_LOC := true;
   if (BoxWarning('Project Stats', 'Logical LOC set') = 0) then;
end;
(*}}}*)
(*{{{  SetPhysicalCount*)
{ SetPhysicalCount
}
procedure SetPhysicalCount;
begin
   logical_LOC := false;
   if (BoxWarning('Project Stats', 'Physical LOC set') = 0) then;
end;
(*}}}*)



// ------------------------------------------------------------------
// MAIN BLOCK
// ------------------------------------------------------------------
BEGIN
   // if the macro file itself is executed this block will be
   // executed. Here you can call other procedures and
   // functions as necessary.
   logical_LOC := false;
   MacroMenuAdd('Project_LOC', 'Project Statistics');
   MacroMenuAdd('File_LOC',    'File Statistics');
   MacroMenuAdd('');
   MacroMenuAdd('SetLogicalCount',    'Set logical LOC');
   MacroMenuAdd('SetPhysicalCount',   'Set physical LOC');
   //KeyMapsetMacro('Logical_File_LOC_C_CPP', VK_F12, 0);
END.