(*---------------------------------------------------------------------------
  :Program.    m2Maker
  :Author.     Thomas Stolze
  :Address.    Goslarsche Str. 32, 3000 Hannover 21, Germany
  :Phone.      (0)511 / 75 10 77
  :Version.    V2.0
  :Date.       16-Nov-90
  :Copyright.  Shareware
  :Language.   Modula-2
  :Translator. M2Amiga V3.32d
  :Contents.   Programming Utility.
  :Remark.     Supports the M2Amiga System (C) by A+L AG Switzerland
----------------------------------------------------------------------------*)

IMPLEMENTATION MODULE Routines;

IMPORT ExecD;
IMPORT IntuitionL;
IMPORT String;

FROM Arts            IMPORT Assert,BreakPoint;
FROM ASCII           IMPORT lf;
FROM Conversions     IMPORT ValToStr;
FROM DosD            IMPORT accessRead,FileLockPtr,Date;
FROM DosL            IMPORT CurrentDir,Delay,DeleteFile,Execute,
                            Input,IoErr,Lock,Output,Rename,UnLock;
FROM ExecD           IMPORT IOStdReqPtr,Message,MsgPortPtr;
FROM ExecL           IMPORT CloseDevice,CopyMem,DoIO,FindPort,GetMsg,
                            OpenDevice,PutMsg,ReplyMsg,WaitPort,Forbid,Permit;
FROM ExecSupport     IMPORT CreatePort,CreateStdIO,DeletePort,DeleteStdIO;
FROM FileRequester   IMPORT LoadDir,RefreshDisplay;
FROM FileSystem      IMPORT Close,Delete,File,Lookup,ReadChar,Response,
                            WriteBytes,WriteChar;
FROM GraphicsD       IMPORT jam2,RastPortPtr;
FROM GraphicsL       IMPORT RectFill,SetAPen,SetDrMd;
FROM Input           IMPORT inputName,writeEvent;
FROM InputEvent      IMPORT InputEvent,Class,Qualifiers,QualifierSet;
FROM InitIntuition   IMPORT prgPtr,PrintStatus,RefreshDrawings,
                            windowHeight;
FROM IntuitionD      IMPORT GadgetFlags,GadgetFlagSet,
                            IntuitionBasePtr,MenuItemFlags,
                            MenuItemFlagSet,ScreenPtr,WindowPtr;
FROM IntuitionL      IMPORT ActivateGadget,ActivateWindow,AddGadget,
                            BeginRefresh,
                            ClearMenuStrip,DisplayBeep,EndRefresh,
                            LockIBase,
                            MoveWindow,OffMenu,OnMenu,
                            RefreshGadgets,RefreshGList,RemoveGadget,
                            ScreenToFront,SetMenuStrip,SizeWindow,UnlockIBase,
                            WBenchToFront,WindowToFront,
                            AddGList,RemoveGList;
FROM RequesterWindow IMPORT DeleteFileRequester,RenameFileRequester,
			    M2EmacsRequester,M2LErrorRequester;
FROM String          IMPORT Compare,Concat,Copy,LastPos,Length,Occurs;
FROM SYSTEM          IMPORT ADDRESS,ADR,CAST,LONGSET;
FROM XCopy           IMPORT XCopy,XType,GetFileDosDate;

(*FROM InOut IMPORT WriteInt,WriteString,WriteLn;*)

TYPE TrojaPtr = POINTER TO Troja;
     Troja    = RECORD
                  msg    : Message;
                  ptr    : ADDRESS;      (* to memory *)
                  dum,                   (* unknown   *)
                  path   : ADDRESS;      (* Path      *);
                END;

TYPE InEvent  = RECORD
                  news  : Message;
                  event : InputEvent;
                END;

TYPE EditorCondition = (correct,notchanged,changed);

VAR projectLock,
    lock        : FileLockPtr;
    bigWindow   : BOOLEAN;
    inputPort,
    ReplyPort   : MsgPortPtr;
    inReqPtr    : IOStdReqPtr;
    news        : InputEvent;
    file        : File;

PROCEDURE Block(rport : RastPortPtr; col,x1,y1,x2,y2 : INTEGER);
BEGIN
  SetAPen(rport,col); SetDrMd(rport,jam2); RectFill(rport,x1,y1,x2,y2);
END Block;

PROCEDURE SwitchGadget(on : BOOLEAN; id : INTEGER);
VAR pos  : INTEGER;
BEGIN
  pos:=RemoveGadget(prgPtr^.window,ADR(prgPtr^.GadgetArray[id]));
  IF on THEN
     INCL(prgPtr^.GadgetArray[id].flags,selected)
  ELSE
     EXCL(prgPtr^.GadgetArray[id].flags,selected)
  END;
  WITH prgPtr^.GadgetArray[id] DO
    Block(prgPtr^.window^.rPort,prgPtr^.GadgetArray[id].gadgetText^.backPen,
          leftEdge,topEdge,leftEdge+width-1,topEdge+height-1);
  END;
  pos:=AddGadget(prgPtr^.window,ADR(prgPtr^.GadgetArray[id]),pos);
  RefreshGList(ADR(prgPtr^.GadgetArray[id]),prgPtr^.window,NIL,1);
END SwitchGadget;

PROCEDURE GetDosErr;
VAR err  : LONGINT;
    str  : ARRAY [0..30] OF CHAR;
    num  : ARRAY [0.. 4] OF CHAR;
    bool : BOOLEAN;
BEGIN
  err:=IoErr();
  CASE err OF
    100..231,233..500:
       str:=("DOS Error: "); ValToStr(err,FALSE,num,10,4," ",bool);
       Concat(str,num); PrintStatus(str);
  ELSE
     PrintStatus("Ok.");
  END;
END GetDosErr;

PROCEDURE TestForFile(name : ADDRESS): BOOLEAN;
VAR lock : FileLockPtr;
BEGIN
  lock:=Lock(name,accessRead);
  IF lock # NIL THEN UnLock(lock); RETURN TRUE ELSE RETURN FALSE END;
END TestForFile;

PROCEDURE TestForProject(pjt,dir : ARRAY OF CHAR; VAR result : ARRAY OF CHAR);
VAR test : ARRAY [0..255] OF CHAR;
BEGIN
  Copy(test,pjt); Concat(test,dir);
  IF TestForFile(ADR(test)) THEN Copy(result,test); ELSE Copy(result,pjt) END;
END TestForProject;

PROCEDURE MakePath(dir,file : ARRAY OF CHAR; VAR path : ARRAY OF CHAR);
VAR i : INTEGER;
BEGIN
  i:=Length(dir); Copy(path,dir);
  IF i > 0 THEN
     IF (path[i-1] # ":") AND (path[i-1] # "/") THEN Concat(path,"/") END;
  END;
  Concat(path,file);
END MakePath;

PROCEDURE FilterLastDir(str : ARRAY OF CHAR; VAR dir : ARRAY OF CHAR);
VAR i,j,k : INTEGER;
BEGIN
   i:=Length(str); j:=0; k:=0;
   REPEAT DEC(i) UNTIL ((i < 0) OR (str[i] = ":")) OR (str[i] = "/");

   FOR k:=i+1 TO Length(str) DO dir[j]:=str[k]; INC(j); END;

   MakePath(dir,"",dir);
END FilterLastDir;

PROCEDURE MakeExecuteStr(str,insert : ARRAY OF CHAR; VAR exec : ARRAY OF CHAR);
VAR i,j,k : INTEGER;
    file  : ARRAY [0..31] OF CHAR;
BEGIN
  i:=0; j:=0; k:=0;
  REPEAT
    CASE str[i] OF
      "#": IF str[i+1] # "?" THEN
              exec[j]:=str[i]; INC(i); INC(j);
           ELSE
              INC(i,2);
              REPEAT
                exec[j]:=insert[k]; INC(j); INC(k);
              UNTIL (insert[k] = 00C) OR (j > HIGH(exec));
           END;
    | "*": FilterLastDir(insert,file); INC(k,Length(insert)-Length(file)+1);
           INC(i,1);
              REPEAT
                exec[j]:=insert[k]; INC(j); INC(k);
              UNTIL (insert[k] = 00C) OR (j > HIGH(exec));
    ELSE
      exec[j]:=str[i]; INC(i); INC(j);
    END;
  UNTIL (str[i-1] = 00C) OR (j > HIGH(exec));
  exec[j-1]:=00C;
END MakeExecuteStr;

PROCEDURE ExecuteStr(exec : ADDRESS);
VAR err : LONGINT;
BEGIN
  err:=Execute(exec,NIL,NIL);
  IF err # 0 THEN GetDosErr ELSE PrintStatus("Ok.") END;
END ExecuteStr;

PROCEDURE DeleteAFile;
VAR bool    : BOOLEAN;
    delete  : ARRAY [0..255] OF CHAR;
BEGIN
  IF DeleteFileRequester(prgPtr^.FR.file) THEN
     MakePath(prgPtr^.FR.dirPath,prgPtr^.FR.file,delete);
     IF NOT DeleteFile(ADR(delete)) THEN GetDosErr ELSE PrintStatus("Ok.") END;
        Concat(delete,".info");
     bool:=DeleteFile(ADR(delete));
     prgPtr^.FR.file:="";
     LoadDir(ADR(prgPtr^.FR));
  END;
END DeleteAFile;

PROCEDURE RenameAFile;
VAR bool    : BOOLEAN;
    oldName : ARRAY [0..31] OF CHAR;
    rename,
    oldPath : ARRAY [0..255] OF CHAR;
BEGIN
  Copy(oldName,prgPtr^.FR.file);
  MakePath(prgPtr^.FR.dirPath,prgPtr^.FR.file,oldPath);
  IF RenameFileRequester(prgPtr^.FR.file) THEN
     MakePath(prgPtr^.FR.dirPath,prgPtr^.FR.file,rename);
     IF NOT Rename(ADR(oldPath),ADR(rename)) THEN
        GetDosErr ELSE PrintStatus("Ok.");
     END;
        Concat(oldPath,".info"); Concat(rename,".info");
     bool:=Rename(ADR(oldPath),ADR(rename));
     prgPtr^.FR.file:="";
     LoadDir(ADR(prgPtr^.FR));
  ELSE
     Copy(prgPtr^.FR.file,oldName);
  END;
END RenameAFile;

PROCEDURE StartModuleTool;
VAR dummy,
    path   : ARRAY [0..255] OF CHAR;
BEGIN
  SwitchGadget(TRUE,19);
   dummy:=("M2:ModuleTOOL "); MakePath(prgPtr^.FR.dirPath,prgPtr^.FR.file,path);
   Concat(dummy,path); ExecuteStr(ADR(dummy));
  SwitchGadget(FALSE,19);
END StartModuleTool;

PROCEDURE FindEditor(): ScreenPtr;
VAR base   : IntuitionBasePtr;
    screen : ScreenPtr;
    name   : ARRAY [0..23] OF CHAR;
    ilock  : LONGCARD;
BEGIN
  base:=ADR(IntuitionL);
  ilock:=LockIBase(0);
    screen:=base^.firstScreen;
  UnlockIBase(ilock);

  WHILE (screen # NIL) DO
    CopyMem(screen^.title,ADR(name),22); name[22]:=00C;
    IF Compare("Amiga Modula-2 Editor,",name) = 0 THEN
       RETURN screen;
    ELSE
       screen:=screen^.nextScreen;
    END;
  END;
  RETURN NIL;
END FindEditor;

PROCEDURE Editor;
VAR file,
    dummy : ARRAY [0..255] OF CHAR;
    resid : ARRAY [0..150] OF CHAR;
    pos   : INTEGER;
    s     : ScreenPtr;
BEGIN
  SwitchGadget(TRUE,4); PrintStatus("Started Editor !"); file:=("");
  s:=FindEditor();

  IF s = NIL THEN
     Copy(resid,prgPtr^.BufferString[4]);
     IF (checked IN prgPtr^.MenuArray[27].flags) THEN
         pos:=Occurs(resid,0,"M2:",FALSE);
         IF pos > -1 THEN String.Delete(resid,0,3); Delay(10) END;
     END;
     MakePath(prgPtr^.FR.dirPath,prgPtr^.FR.file,file);
     MakeExecuteStr(resid,file,dummy);

     IF (checked IN prgPtr^.MenuArray[16].flags) THEN
        Copy(file,dummy); dummy:=("Run "); Concat(dummy,file);
     END;

     ExecuteStr(ADR(dummy));
  ELSE
     ScreenToFront(s);
  END;
  SwitchGadget(FALSE,4);
END Editor;

PROCEDURE SendCommand(w         : WindowPtr;
                      command   : CARDINAL;
                      qualifier : QualifierSet;
                      code      : CARDINAL);
BEGIN
  news.nextEvent:=NIL;
  news.class:=rawkey;
  news.subClass:=null;
  news.qualifier:=qualifier;
  news.code:=code;

  inReqPtr^.command:=command;
  inReqPtr^.message.replyPort:=ReplyPort;
  inReqPtr^.length:=SIZE(InputEvent);
  inReqPtr^.data:=ADR(news);

  Forbid();
    ActivateWindow(w); DoIO(inReqPtr);
  Permit();

  Assert(inReqPtr^.error = 0,ADR("I/O Error !"));
END SendCommand;

PROCEDURE DisplayNoEnding;
VAR pos : INTEGER;
BEGIN
  Copy(prgPtr^.BufferString[0],prgPtr^.FR.file);
  pos:=LastPos(prgPtr^.BufferString[0],Length(prgPtr^.BufferString[0]),".");
  IF pos # -1 THEN prgPtr^.BufferString[0,pos]:=00C; END;
  RefreshGList(ADR(prgPtr^.GadgetArray[0]),prgPtr^.window,NIL,1);
END DisplayNoEnding;

PROCEDURE CheckEditorFile(wb,change : BOOLEAN; w : WindowPtr): EditorCondition;
VAR msgPort : MsgPortPtr;
    path    : ARRAY [0..150] OF CHAR;
    result  : EditorCondition;

  PROCEDURE ComparePath;
  VAR ptr  : TrojaPtr;
      file : ARRAY [0..31] OF CHAR;
  BEGIN
    SendCommand(w,writeEvent,QualifierSet{control},0DH);
    WaitPort(msgPort); ptr:=CAST(TrojaPtr,GetMsg(msgPort));
    IF ptr # NIL THEN
       CopyMem(ptr^.path,ADR(path),149); ReplyMsg(ptr);
       FilterLastDir(path,file); file[Length(file)-1]:=00C;

       IF Compare(file,prgPtr^.FR.file) # 0 THEN
          result:=notchanged;
          IF change THEN   (* not equal but corrected *)
             Copy(prgPtr^.FR.file,file); result:=changed;
          END;

          RefreshGList(ADR(prgPtr^.GadgetArray[21]),prgPtr^.window,NIL,10);
          DisplayNoEnding;
       ELSE
          result:=correct;
       END;
    ELSE
      result:= correct; (* no message ??! *)
    END;
  END ComparePath;

BEGIN
  IF wb THEN
     RETURN correct;
  ELSE
     msgPort:=CreatePort(ADR("m2c"),30);
       IF (msgPort # NIL) THEN ComparePath; DeletePort(msgPort); END;
     RETURN result;
  END;
END CheckEditorFile;

PROCEDURE Compiler(wb : BOOLEAN): BOOLEAN;
VAR file,
    dummy    : ARRAY [0..255] OF CHAR;
    resid    : ARRAY [0..150] OF CHAR;
    pos      : INTEGER;
    s        : ScreenPtr;
    bool     : BOOLEAN;
    ed       : EditorCondition;
BEGIN
  SwitchGadget(TRUE,5); PrintStatus("Started Compiler !");

  IF NOT wb THEN
     s:=FindEditor();
     IF (s # NIL) THEN ed:=CheckEditorFile(wb,TRUE,s^.firstWindow); END;
  END;

  IF (selected IN prgPtr^.GadgetArray[16].flags) THEN
      MakePath(prgPtr^.BufferString[3],"",file);
      TestForProject(file,"txt/",file);
  ELSE
      MakePath(prgPtr^.FR.dirPath,"",file);
  END;
  Concat(file,prgPtr^.FR.file);

  IF NOT wb THEN
     s:=FindEditor();
     IF s # NIL THEN
        Concat(file,"E");
        IF TestForFile(ADR(file)) THEN bool:=DeleteFile(ADR(file)); END;
        file[Length(file)-1]:=00C;
        SendCommand(s^.firstWindow,writeEvent,QualifierSet{lShift},50H);(*F1*)
        Delay(5);
     END;
  END;

  Copy(resid,prgPtr^.BufferString[5]);
  IF (checked IN prgPtr^.MenuArray[25].flags) THEN
      pos:=Occurs(resid,0,"M2:",FALSE);
      IF pos > -1 THEN String.Delete(resid,0,3); Delay(15); END;
  END;
  MakeExecuteStr(resid,file,dummy);

  IF TestForFile(ADR(file)) THEN
     ExecuteStr(ADR(dummy));
     SwitchGadget(FALSE,5);

     Concat(file,("E"));
     IF TestForFile(ADR(file)) THEN
        s:=FindEditor();
        IF s # NIL THEN
           CASE CheckEditorFile(wb,FALSE,s^.firstWindow) OF
             correct:     Editor;
           | notchanged:  Editor;
               IF (s # NIL) THEN M2EmacsRequester(ADR(prgPtr^.FR.file),s) END;
           ELSE
           END;
        END;
        RETURN FALSE
     ELSE
       s:=FindEditor();
       IF (s # NIL) THEN
         SendCommand(s^.firstWindow,writeEvent,QualifierSet{lShift},51H); (*F2*)
         SendCommand(s^.firstWindow,writeEvent,QualifierSet{},51H);
       END;

     END;
     RETURN TRUE;
  ELSE
    SwitchGadget(FALSE,5);
    DisplayBeep(NIL); bool:=WBenchToFront(); PrintStatus("File not found!");
  END;
  RETURN FALSE;
END Compiler;

PROCEDURE Linker(wb : BOOLEAN): BOOLEAN;
VAR file,
    file2,
    dummy : ARRAY [0..255] OF CHAR;
    resid : ARRAY [0..150] OF CHAR;
    pos   : INTEGER;
    i     : INTEGER;
    aDate,
    bDate : Date;
    bool  : BOOLEAN;
    s     : ScreenPtr;
BEGIN
  SwitchGadget(TRUE,6); PrintStatus("Started Linker !"); file:=("");

  IF (selected IN prgPtr^.GadgetArray[14].flags) THEN i:=1 ELSE i:=0 END;
  IF (selected IN prgPtr^.GadgetArray[16].flags) THEN
      MakePath(prgPtr^.BufferString[3],"",file);
      TestForProject(file,"obj/",file);
  ELSE
      MakePath(prgPtr^.FR.dirPath,"",file);
  END;
  Concat(file,prgPtr^.BufferString[i]);

  IF (selected IN prgPtr^.GadgetArray[16].flags) THEN
      MakePath(prgPtr^.BufferString[3],"",file2);
      TestForProject(file2,"bin/",file2);
  ELSE
     MakePath(prgPtr^.FR.dirPath,"",file2); i:=0;
  END;
  Concat(file2,prgPtr^.BufferString[i]);

    Copy(resid,prgPtr^.BufferString[6]);
    IF (checked IN prgPtr^.MenuArray[26].flags) THEN
       pos:=Occurs(resid,0,"M2:",FALSE);
       IF pos > -1 THEN String.Delete(resid,0,3); Delay(15) END;
    END;

  IF GetFileDosDate(file2,aDate) THEN

     MakeExecuteStr(resid,file,dummy);
     ExecuteStr(ADR(dummy)); SwitchGadget(FALSE,6);

     IF GetFileDosDate(file2,bDate) THEN

        IF bDate.days > aDate.days THEN
           RETURN TRUE;
        ELSE
           IF bDate.minute > aDate.minute THEN
              RETURN TRUE;
           ELSE
              IF bDate.tick > aDate.tick THEN
                 RETURN TRUE;
              END;
           END;
        END;
     END;
  END;

  IF wb THEN
     M2LErrorRequester(ADR(prgPtr^.BufferString[i]),NIL);
  ELSE
     Editor; s:=FindEditor();
     IF (s # NIL) THEN M2LErrorRequester(ADR(prgPtr^.BufferString[i]),s) END;
  END;

  RETURN FALSE;
END Linker;

PROCEDURE Save;
VAR src,
    dest,
    project : ARRAY [0..255] OF CHAR;
    dir     : ARRAY [0..31] OF CHAR;
BEGIN
  SwitchGadget(TRUE,13); PrintStatus("Save File !");

  MakePath(prgPtr^.FR.dirPath,prgPtr^.FR.file,src);
  IF (selected IN prgPtr^.GadgetArray[16].flags) THEN
      IF (selected IN prgPtr^.GadgetArray[16].flags) THEN
         FilterLastDir(prgPtr^.BufferString[3],dir);
         MakePath(prgPtr^.BufferString[2],dir,dest); dest[Length(dest)-1]:=00C;
         IF NOT TestForFile(ADR(dest)) THEN
            MakeExecuteStr(prgPtr^.BufferString[7],dest,project);
            ExecuteStr(ADR(project));
         END;
        TestForProject(dest,"/txt",dest);
     END;
  ELSE
     Copy(dest,prgPtr^.BufferString[2]);
  END;
  IF NOT XCopy(src,dest,single) THEN GetDosErr END;

  SwitchGadget(FALSE,13);
END Save;

PROCEDURE Run;
VAR file : ARRAY [0..255] OF CHAR;
    i    : INTEGER;
    bool : BOOLEAN;
BEGIN
  SwitchGadget(TRUE,7); PrintStatus("Started Program !"); file:=("");

  IF (selected IN prgPtr^.GadgetArray[14].flags) THEN i:=1 ELSE i:=0 END;
  IF (selected IN prgPtr^.GadgetArray[16].flags) THEN
      MakePath(prgPtr^.BufferString[3],"",file);
      TestForProject(file,"bin/",file);
  ELSE
     MakePath(prgPtr^.FR.dirPath,"",file); i:=0;
  END;
  Concat(file,prgPtr^.BufferString[i]);
  IF (checked IN prgPtr^.MenuArray[15].flags) THEN Save END;

  bool:=WBenchToFront();
  ExecuteStr(ADR(file)); SwitchGadget(FALSE,7);
END Run;

PROCEDURE Make(wb : BOOLEAN);
BEGIN
  SwitchGadget(TRUE,8);
    IF Compiler(wb) THEN IF Linker(wb) THEN Run END; END;
  SwitchGadget(FALSE,8);
END Make;

PROCEDURE Print;
VAR file,
    dummy : ARRAY [0..255] OF CHAR;
BEGIN
  SwitchGadget(TRUE,15); PrintStatus("Started Printutility !");

  MakePath(prgPtr^.FR.dirPath,prgPtr^.FR.file,file);
  MakeExecuteStr(prgPtr^.BufferString[11],file,dummy);

  ExecuteStr(ADR(dummy)); SwitchGadget(FALSE,15);
END Print;

PROCEDURE Project(test : BOOLEAN);
VAR file,
    dummy : ARRAY [0..255] OF CHAR;
    lock  : FileLockPtr;
    bool  : BOOLEAN;

    PROCEDURE DeleteLock;
    BEGIN
      lock:=CurrentDir(projectLock); IF lock # NIL THEN UnLock(lock); END;
      projectLock:=NIL;
    END DeleteLock;
BEGIN
  ClearMenuStrip(prgPtr^.window);
  bool:=(selected IN prgPtr^.GadgetArray[16].flags);
  IF NOT test THEN bool:=NOT bool END;

  IF bool THEN
     SwitchGadget(TRUE,16);
     IF TestForFile(ADR(prgPtr^.BufferString[3])) THEN
        PrintStatus("Project initialised !");
     ELSE
        PrintStatus("Project opened !");
        MakeExecuteStr(prgPtr^.BufferString[7],prgPtr^.BufferString[3],dummy);
        ExecuteStr(ADR(dummy));
     END;
     INCL(prgPtr^.MenuArray[9].flags,itemEnabled);
     INCL(prgPtr^.MenuArray[18].flags,itemEnabled);
     INCL(prgPtr^.MenuArray[31].flags,itemEnabled);
     IF projectLock # NIL THEN DeleteLock END;
     lock:=Lock(ADR(prgPtr^.BufferString[3]),accessRead);
     projectLock:=CurrentDir(lock);
     FastLister;
  ELSE
     PrintStatus("Project terminated !");
     EXCL(prgPtr^.MenuArray[9].flags,itemEnabled);
     EXCL(prgPtr^.MenuArray[18].flags,itemEnabled);
     EXCL(prgPtr^.MenuArray[31].flags,itemEnabled);
     DeleteLock; SwitchGadget(FALSE,16);
  END;
  Assert(SetMenuStrip(prgPtr^.window,prgPtr^.menuStripPtr),
         ADR("Menu not initialisied"));
END Project;

PROCEDURE NewShell;
VAR dummy : ARRAY [0..20] OF CHAR;
BEGIN
  dummy:=("NewShell"); ExecuteStr(ADR(dummy));
END NewShell;

PROCEDURE New;
VAR bool : BOOLEAN;
BEGIN
  SwitchGadget(TRUE,18);
    prgPtr^.BufferString[0]:=("");
    RefreshGList(ADR(prgPtr^.GadgetArray[0]),prgPtr^.window,NIL,1);
    bool:=ActivateGadget(ADR(prgPtr^.GadgetArray[0]),prgPtr^.window,NIL);
  SwitchGadget(FALSE,18);
END New;

PROCEDURE EditMakeFile;
VAR file,
    dummy : ARRAY [0..255] OF CHAR;
BEGIN
  MakePath(prgPtr^.BufferString[3],"m2Maker.mke",file);
  MakeExecuteStr(prgPtr^.BufferString[4],file,dummy);
  ExecuteStr(ADR(dummy));
END EditMakeFile;

PROCEDURE CompileProject(start : ARRAY OF CHAR; all : BOOLEAN);
VAR file,
    dummy    : ARRAY [0..255] OF CHAR;
    input    : File;
    bool,err : BOOLEAN;

  PROCEDURE ReadARow(VAR name : ARRAY OF CHAR);
  VAR pos       : INTEGER;
      ch        : CHAR;
      filefound : BOOLEAN;
  BEGIN
    pos:=0; ch:=00C; filefound:=FALSE;
    REPEAT
      ReadChar(input,ch);
       CASE ch OF
          "!"..":","<".."}" : name[pos]:=ch; INC(pos); filefound:=TRUE;
       |  lf  : IF pos > 0 THEN filefound:=TRUE ELSE filefound:=FALSE END;
       |  ";" : REPEAT ReadChar(input,ch) UNTIL (ch = lf) OR (input.eof);
       |  " " :
       ELSE
         IF NOT input.eof THEN
            err:=TRUE; PrintStatus("Error in m2Maker.mke !");
         END;
       END;
    UNTIL ((ch = lf) AND filefound) OR input.eof;
    IF pos  >  0 THEN name[pos]:=00C ELSE name[0]:=00C END;
    IF input.eof THEN err:=TRUE END;
  END ReadARow;

  PROCEDURE Proceed(read : BOOLEAN);
  BEGIN
    WHILE (((input.res = done) AND ((NOT input.eof) AND bool)) AND NOT err) DO
      IF read THEN ReadARow(file) END;
      IF NOT err THEN
         Copy(prgPtr^.FR.file,file);
           RefreshGadgets(ADR(prgPtr^.GadgetArray[21]),prgPtr^.window,NIL);
           DisplayNoEnding;
         bool:=Compiler(TRUE); read:=TRUE;
      END;
    END;
  END Proceed;

BEGIN
  PrintStatus("Compile Project !"); bool:=TRUE; err:=FALSE;
  MakePath(prgPtr^.BufferString[3],"m2Maker.mke",dummy);

  Lookup(input,dummy,1024,FALSE);
    IF (input.res = done) THEN
       IF all THEN
          Proceed(TRUE);
       ELSE
         ReadARow(file);
         WHILE (Compare(file,start) # 0) AND (NOT input.eof) DO
           ReadARow(file);
         END;
         IF NOT input.eof THEN
            Proceed(FALSE);
         ELSE
            PrintStatus("Startfile not found !");
         END;
      END;
    ELSE
      PrintStatus("m2Maker.mke file not found !");
    END;
 Close(input);
END CompileProject;

PROCEDURE SmallWindow;
VAR pos  : INTEGER;
    bool : BOOLEAN;
BEGIN
  IF bigWindow THEN
     bigWindow:=FALSE;
     WITH prgPtr^.window^ DO
       MoveWindow(prgPtr^.window,-1 * leftEdge,-1 * topEdge);
       SizeWindow(prgPtr^.window,-280,28-windowHeight); Delay(5);
     END;
     BeginRefresh(prgPtr^.window);
       WindowToFront(prgPtr^.window); Delay(5);
     EndRefresh(prgPtr^.window,bool);
     Delay(5);
  ELSE
     bigWindow:=TRUE;
     Block(prgPtr^.window^.rPort,0,3,12,637,windowHeight-3);
     pos:=RemoveGList(prgPtr^.window,ADR(prgPtr^.GadgetArray[0]),32);
     WITH prgPtr^.window^ DO
       MoveWindow(prgPtr^.window,-1 * leftEdge,-1 * topEdge);
       SizeWindow(prgPtr^.window,280,windowHeight-28); Delay(5);
     END;
     WindowToFront(prgPtr^.window); Delay(5);
     BeginRefresh(prgPtr^.window);
       RefreshDrawings; RefreshDisplay(ADR(prgPtr^.FR)); Delay(5);
     EndRefresh(prgPtr^.window,bool);
     Delay(5);
     pos:=AddGList(prgPtr^.window,ADR(prgPtr^.GadgetArray[0]),pos,32,NIL);
     RefreshGadgets(ADR(prgPtr^.GadgetArray[0]),prgPtr^.window,NIL);
  END;
END SmallWindow;

PROCEDURE BonusTrack(str : ARRAY OF CHAR);
VAR file,
    dummy : ARRAY [0..255] OF CHAR;
    i     : INTEGER;
BEGIN
  PrintStatus("Started User Track");

  MakePath(prgPtr^.FR.dirPath,prgPtr^.FR.file,file);
  MakeExecuteStr(str,file,dummy);

  ExecuteStr(ADR(dummy));
END BonusTrack;

PROCEDURE ExclChecked(nr : CARDINAL);
VAR bool : BOOLEAN;
BEGIN
 ClearMenuStrip(prgPtr^.window);
   EXCL(prgPtr^.MenuArray[nr].flags,checked);
 bool:=SetMenuStrip(prgPtr^.window,prgPtr^.menuStripPtr);
END ExclChecked;

PROCEDURE InclChecked(nr : CARDINAL);
VAR bool : BOOLEAN;
BEGIN
 ClearMenuStrip(prgPtr^.window);
   INCL(prgPtr^.MenuArray[nr].flags,checked);
 bool:=SetMenuStrip(prgPtr^.window,prgPtr^.menuStripPtr);
END InclChecked;

PROCEDURE ByeByeFastLister;
VAR msg        : InEvent;
    ptr,
    replyPort  : MsgPortPtr;
BEGIN
  ptr:=FindPort(ADR("FastLister_Port"));
  IF (ptr # NIL) THEN
     replyPort:=CreatePort(NIL,0);
     IF replyPort # NIL THEN
        msg.event.code:=45H;                               (* ESC *)
        msg.event.qualifier:=QualifierSet{lShift,control};
        msg.news.node.type:=ExecD.message;
        msg.news.length:=SIZE(InputEvent);
        msg.news.replyPort:=replyPort;

        PutMsg(ptr,ADR(msg));

       WHILE (FindPort(ADR("FastLister_Port")) # NIL) DO END;
       DeletePort(replyPort);
    END;
    PrintStatus("FastLister removed.");
  END;
END ByeByeFastLister;

PROCEDURE FastLister;
VAR dummy : ARRAY [0..255] OF CHAR;
BEGIN
  ByeByeFastLister;
  PrintStatus("Install FastLister !");
    dummy:=("Run M2:FastLister "); Concat(dummy,prgPtr^.BufferString[12]);
  ExecuteStr(ADR(dummy));
END FastLister;

PROCEDURE ByeByeCompiler;
VAR base     : IntuitionBasePtr;
    w        : WindowPtr;
    name     : ARRAY [0..30] OF CHAR;
    ilock    : LONGCARD;
    notFound,
    bool     : BOOLEAN;
BEGIN
  base:=ADR(IntuitionL); w:=NIL; bool:=WBenchToFront();
  ilock:=LockIBase(0);
    w:=base^.firstScreen^.firstWindow;
  UnlockIBase(ilock);
  notFound:=TRUE;
  WHILE (w # NIL) AND notFound DO
    CopyMem(w^.title,ADR(name),27); name[27]:=00C;
    IF Compare("Interactive Compiler m2:m2c",name) = 0 THEN
       notFound:=FALSE;
    ELSE
       w:=w^.nextWindow;
    END;
  END;
  IF w # NIL THEN
     SendCommand(w,writeEvent,QualifierSet{},43H); ExclChecked(17);
     PrintStatus("Inactive Compiler removed.");
  END;
END ByeByeCompiler;

PROCEDURE ByeByeDebug;
BEGIN
 ExecuteStr(ADR(prgPtr^.BufferString[9])); ExclChecked(29);
 PrintStatus("Debugger removed.");
END ByeByeDebug;

PROCEDURE ByeByePool;
VAR base     : IntuitionBasePtr;
    w        : WindowPtr;
    name     : ARRAY [0..30] OF CHAR;
    ilock    : LONGCARD;
    notFound,
    bool     : BOOLEAN;
BEGIN
  base:=ADR(IntuitionL); w:=NIL; bool:=WBenchToFront();
  ilock:=LockIBase(0);
    w:=base^.firstScreen^.firstWindow;
  UnlockIBase(ilock);
  notFound:=TRUE;
  WHILE (w # NIL) AND notFound DO
    CopyMem(w^.title,ADR(name),27); name[27]:=00C;
    IF Compare("Interactive Pool m2:m2Pool",name) = 0 THEN
       notFound:=FALSE;
    ELSE
       w:=w^.nextWindow;
    END;
  END;
  IF w # NIL THEN
     SendCommand(w,writeEvent,QualifierSet{},43H); ExclChecked(28);
     PrintStatus("Interactive Pool removed.");
  END;

END ByeByePool;

PROCEDURE ByeByeM2Ohm;
VAR msg        : InEvent;
    ptr,
    replyPort  : MsgPortPtr;
BEGIN
  ptr:=FindPort(ADR("OHM"));
  IF (ptr # NIL) THEN
     replyPort:=CreatePort(NIL,0);
     IF replyPort # NIL THEN
        msg.event.code:=45H;                               (* ESC *)
        msg.event.qualifier:=QualifierSet{lAlt};
        msg.news.node.type:=ExecD.message;
        msg.news.length:=SIZE(InputEvent);
        msg.news.replyPort:=replyPort;

        PutMsg(ptr,ADR(msg));

       WHILE (FindPort(ADR("OHM")) # NIL) DO END;
       DeletePort(replyPort);
    END;
    PrintStatus("M2Ohm removed."); ExclChecked(30);
  END;
END ByeByeM2Ohm;

PROCEDURE InteractiveCompiler;
VAR file   : File;
    actual : LONGINT;
    dummy,
    scan   : ARRAY [0..100] OF CHAR;

    PROCEDURE Scan;
    VAR i : INTEGER;
    BEGIN
      i:=0;
      WHILE (prgPtr^.BufferString[5,i] # 00C) AND
            (prgPtr^.BufferString[5,i] # "#")     DO
            scan[i]:=prgPtr^.BufferString[5,i]; INC(i);
      END;
      scan[i]:=00C;
    END Scan;
BEGIN
  IF (checked IN prgPtr^.MenuArray[17].flags) THEN
     IF FindPort(ADR("m2c")) = NIL THEN
        PrintStatus("Start Compiler interactive !");
        Lookup(file,"T:m2Maker.m2c",1024,TRUE);
        IF file.res = done THEN
           scan:=(""); Scan;
           WriteBytes(file,ADR(scan),Length(scan),actual); WriteChar(file,lf);
           WriteBytes(file,ADR("EndCli >NIL: "),15,actual); WriteChar(file,lf);
           Close(file);
        dummy:=('Newshell "NEWCON:0/0/320/24/Interactive Compiler m2:m2c"')+
                ' FROM T:m2Maker.m2c';
           ExecuteStr(ADR(dummy));
           WindowToFront(prgPtr^.window); Delay(5);
        ELSE
           PrintStatus("Compiler installation failed !");
        END;
     END;
  ELSE
    ByeByeCompiler;
  END;
END InteractiveCompiler;

PROCEDURE KeyMaker;
VAR file,
    dummy : ARRAY [0..255] OF CHAR;
    i     : INTEGER;
    in    : BOOLEAN;
BEGIN
  PrintStatus("Started Keycompilation !"); file:=(""); in:=FALSE;

  IF (selected IN prgPtr^.GadgetArray[14].flags) THEN i:=1 ELSE i:=0 END;
      MakePath(prgPtr^.FR.dirPath,"",file);
  IF (selected IN prgPtr^.GadgetArray[16].flags) THEN
      TestForProject(file,"txt/",file);
  END;
  IF (checked IN prgPtr^.MenuArray[17].flags) THEN ByeByeCompiler; in:=TRUE END;

  MakePath(prgPtr^.FR.dirPath,prgPtr^.BufferString[i],file);
  MakeExecuteStr(prgPtr^.BufferString[13],file,dummy);

  ExecuteStr(ADR(dummy));

  IF in THEN InclChecked(17); InteractiveCompiler; END;
END KeyMaker;

BEGIN
  bigWindow:=TRUE;

  inputPort:=CreatePort(NIL,0);
    Assert(inputPort # NIL,ADR("Couldn't open MsgPort"));
  inReqPtr:=CreateStdIO(inputPort);
    Assert(inReqPtr # NIL,ADR("StdIO not installed !"));
  ReplyPort:=CreatePort(NIL,0);
    Assert(ReplyPort # NIL,ADR("Couldn't open MsgPort"));

  OpenDevice(ADR(inputName),0,inReqPtr,LONGSET{});

CLOSE
  IF projectLock # NIL THEN
     lock:=CurrentDir(projectLock); IF lock # NIL THEN UnLock(lock); END;
  END;

  ByeByeFastLister; ByeByeCompiler; ByeByeDebug; ByeByePool; ByeByeM2Ohm;

  IF inReqPtr # NIL THEN
     CloseDevice(inReqPtr); DeleteStdIO(inReqPtr);   inReqPtr:=NIL;
  END;
  IF inputPort   # NIL THEN DeletePort(inputPort);   inputPort:=NIL;   END;
  IF ReplyPort   # NIL THEN DeletePort(ReplyPort);   ReplyPort:=NIL;   END;

  Lookup(file,"T:m2Maker.m2c",0,FALSE);
    IF file.res = done THEN Delete(file); END; Close(file);

  Lookup(file,"T:m2Maker.m2d",0,FALSE);
    IF file.res = done THEN Delete(file); END; Close(file);

  Lookup(file,"T:m2Maker.m2p",0,FALSE);
    IF file.res = done THEN Delete(file); END; Close(file);

END Routines.