(* ------------------------------------------------------------------------
  :Program.       MagicToolTypes.mod
  :Contents.      Piktogramm-ToolTypes/-DefaultTool-Manipulator/Filter/List
  :Author.        Franz Schwarz
  :Copyright.     Giftware (Freely distributable, yet copyrighted software.
  :Copyright.     If you like this magnificent;-) piece of software, you 
  :Copyright.     are encouraged to send the author a present, a nice
  :Copyright.     postcard, money, or something else pleasing the author.)
  :Language.      Oberon-2
  :Translator.    Amiga Oberon 3.00
  :History.       v1.0 fSchwarz 9.7.93
  :History.       v1.1 fSchwarz 2.8.93 added extensive DefaultTool support,
  :History.         removed WB multi-selection bug
  :History.       v1.2 fSchwarz 3.8.93 fixed DefaultTool report bug
  :History.       v1.3 fSchwarz 9.8.93 now works great with NIL
  :History.         DiskObject.toolTypes entries
  :History.       v1.4 fSchwarz 14.8.93 adapted for BlackMagic 1.10 with
  :History.         Argument Request feature
  :Support.       BlackMagic.
  :Bugs.          none known
  :Address.       Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
  :Address.       uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
  :Usage.         "LIST/S,REPLACE/S,REPLACEONLY=RO/S,DELETE/S,
  :Usage.          PATTERN=FILE/A,ALL/S,TOOLFILTER=TF/K,TOOL/K,
  :Usage.          TTYPES=TT/M,VERBOSITY=V/N/K"
------------------------------------------------------------------------ *)

(* $SET DEBUG *)

MODULE MagicToolTypes;

IMPORT
  b: BlackMagic, bv: BlackMagicVA, wb: Workbench, ic: Icon, I: Intuition,
  o: OberonLib, d: Dos, e: Exec, st: Strings,
  u: Utility, io (* for WB console *) , L: MagicToolTypesStrings
  (* $IF DEBUG *) , NoGuru (* $END *)
  ;

CONST
  versTag = "$VER: MagicToolTypes 1.4 (14.8.93) © Franz.Schwarz@mil.ka.sub.org - Giftware";


CONST
  templ = "LIST/S,REPLACE/S,REPLACEONLY=RO/S,DELETE/S,PATTERN=FILE/A,"
          "ALL/S,TOOLFILTER=TF/K,TOOL/K,TTYPES=TT/M,VERBOSITY=V/N/K";

  defaultToolFilter = "#?";
  
  emptyStr = "";

TYPE
  ArgsT = STRUCT
    list        : LONGINT;
    replace     : LONGINT;
    replaceOnly : LONGINT;
    delete      : LONGINT;
    file        : b.LongStrPtr;
    all         : LONGINT;
    toolFilter  : b.LongStrPtr;
    tool        : b.LongStrPtr;
    tt          : b.TTPtr;
    verbosity   : UNTRACED POINTER TO LONGINT;
  END;  

VAR
  Args   : ArgsT;
  itswild: BOOLEAN;
  all    : BOOLEAN;
  matp   : b.DynStrPtr;
  verb   : LONGINT;
  n      : LONGINT;

PROCEDURE Process (fnam: ARRAY OF CHAR): BOOLEAN;
VAR
  do          : wb.DiskObjectPtr;
  tt          : b.TTPtr;
  dtt         : b.DynTTPtr;
  deftool     : e.STRPTR;
  rda         : b.RDArgsWBPtr;
  dummy       : LONGINT;  
  i,j         : LONGINT;
  did, didthis: BOOLEAN;
  leave       : BOOLEAN;    
  PROCEDURE CleanUp();
  BEGIN
    b.FreeArgsWB (rda);
    IF do # NIL THEN 
      do.defaultTool := deftool; do.toolTypes := tt; ic.FreeDiskObject (do); 
    END;
    b.FreeDynTT (dtt);
  END CleanUp;  
  
(* $CopyArrays- *)
BEGIN
  IF ((verb >= 1) & ~((Args.list # 0) & (n = 1) & ~(itswild OR all))) OR
     (verb >= 2) THEN
    bv.FLPrintF (NIL, NIL, b.GetStr (L.fmtFile)^, b.StrIndex (fnam, 0)); 
  END;
  do := NIL; tt := NIL; dtt := NIL; deftool := NIL; rda := NIL; 
  did := FALSE; leave := FALSE;
  do := ic.GetDiskObject (fnam);
  IF do = NIL THEN 
    CleanUp(); 
    IF itswild OR all OR (n > 1) THEN RETURN TRUE; ELSE RETURN FALSE; END;
  END;  
  IF ~b.DynAppendTT (dtt, "", {b.createEmpty}) THEN CleanUp(); RETURN FALSE; END;
  tt := do.toolTypes; deftool := do.defaultTool;
  IF do.defaultTool = NIL THEN do.defaultTool := b.StrIndexA (emptyStr, 0); END;
  LOOP
    IF Args.toolFilter = b.StrIndex (defaultToolFilter, 0) THEN EXIT; END;
    CASE do.type OF wb.disk, wb.project:
      IF d.MatchPatternNoCase (matp^, do.defaultTool^) THEN EXIT; END;
    ELSE END;  
    CleanUp(); RETURN TRUE;
  END;  
  rda := b.ReadArgsTT ("", dummy, tt, b.TTAPtr (dtt), {});
  IF rda = NIL THEN CleanUp(); RETURN FALSE; END;  
  IF (Args.list # 0) & (verb >= 1) THEN
    CASE do.type OF wb.disk, wb.project:
      bv.FLPrintF (NIL, NIL, b.GetStr (L.fmtDefaultTool)^, deftool); did := TRUE;
    ELSE END;  
  END;  
  LOOP FOR i := 0 TO MAX (LONGINT) DO
    IF Args.tt # NIL THEN 
      IF Args.tt [i] = NIL THEN EXIT; END; 
    ELSE
      IF leave THEN EXIT; END;
      leave := TRUE;
    END;  
    j := -1; didthis := FALSE;
    LOOP
      IF d.CheckSignal (LONGSET{d.ctrlC}) # LONGSET{} THEN
        i := d.SetIoErr (d.break); CleanUp(); RETURN FALSE; 
      END;
      IF (Args.replace # 0) OR (Args.replaceOnly # 0) OR (Args.delete # 0) OR (Args.list # 0) THEN
        LOOP
          INC (j);          
          IF rda.ttRest [j] = NIL THEN j := -1; EXIT; END;
          IF Args.tt = NIL THEN EXIT; END;
          IF b.CmpToolNames (rda.ttRest [j]^, Args.tt [i]^) THEN 
            IF (Args.delete = 0) & (Args.list = 0) THEN EXIT; END;
            IF b.GetToolValue (Args.tt [i]^)^ = "" THEN EXIT; END;
            IF u.Stricmp (b.GetToolValue (Args.tt [i]^)^, 
                          b.GetToolValue (rda.ttRest [j]^)^) = 0 THEN EXIT; END;
          END;  
        END; (* LOOP *)
      END;  
      IF Args.delete # 0 THEN
        IF j >= 0 THEN
          IF verb >= 2 THEN bv.FLPrintF (NIL, NIL, b.GetStr (L.fmtDelete)^, rda.ttRest [j]); END;  
          IF ~b.RemDynTTEntry (rda.ttRest, j) THEN CleanUp(); RETURN FALSE; END;
          DEC (j);
          did := TRUE; didthis := TRUE;
        ELSE
          EXIT;
        END;  
      ELSIF Args.list # 0 THEN
        IF j >= 0 THEN
          IF verb >= 1 THEN bv.FLPrintF (NIL, NIL, b.GetStr (L.fmtList)^, rda.ttRest [j]); END;
          did := TRUE; didthis := TRUE;
        ELSE
          IF Args.tt = NIL THEN did := TRUE; END;            
          EXIT;
        END;          
      ELSIF (((Args.replaceOnly # 0) & (j >= 0)) OR 
             (Args.replaceOnly = 0)) & (Args.tt # NIL) THEN
        IF j >= 0 THEN 
          IF verb >= 2 THEN bv.FLPrintF (NIL, NIL, b.GetStr (L.fmtReplace)^, rda.ttRest [j], Args.tt [i]); END;  
          IF ~b.WriteTTEntry (rda.ttRest, j, Args.tt [i]^, {}) THEN CleanUp(); RETURN FALSE; END;
          did := TRUE; didthis := TRUE;
        ELSE
          IF ~didthis THEN
            IF verb >= 2 THEN bv.FLPrintF (NIL, NIL, b.GetStr (L.fmtAdd)^, Args.tt [i]); END;  
            IF ~b.WriteTTEntry (rda.ttRest, -1, Args.tt [i]^, {}) THEN CleanUp(); RETURN FALSE; END;
            did := TRUE; didthis := TRUE;
          END;  
          EXIT;
        END; (* IF *) 
      ELSE  
        EXIT;
      END; (* IF *)
    END; (* LOOP *)
  END; EXIT; END; (* LOOP FOR i *)  
  IF (Args.tool # NIL) & (Args.list = 0) THEN 
    CASE do.type OF wb.disk, wb.project:
      do.defaultTool := b.StrIndexA (Args.tool^, 0);
      IF verb >=2 THEN bv.FLPrintF (NIL, NIL, b.GetStr (L.fmtReplaceDefTool)^, deftool, do.defaultTool); END;
      did := TRUE;
    ELSE END;  
  END;
  IF did & (Args.list = 0) THEN
    IF verb >=1 THEN bv.FLPrintF (NIL, NIL, "%s", b.GetStr (L.msgWriteBack)); END;
    do.toolTypes := b.TTAPtr (rda.ttRest);
    IF ~ic.PutDiskObject (fnam, do) THEN CleanUp(); RETURN FALSE; END;
  ELSIF did & (Args.list # 0) & (verb < 1) THEN  
    bv.FLPrintF (NIL, NIL, "\"%s\"\n", b.StrIndex (fnam, 0));
  END;  
  CleanUp();
  RETURN TRUE;
END Process;

VAR
  i,j : LONGINT;
  Rda : b.RDArgsPtr;
  MyAp: d.AnchorPathPtr;
  ds  : b.DynStrPtr;
  ret : LONGINT;
  l   : LONGINT;
  fl  : SET;
  rdaarr : b.DynTTPtr;
  rdaarr1: UNTRACED POINTER TO ARRAY MAX (LONGINT) DIV 4-1 OF 
             UNTRACED POINTER TO b.RDArgsPtr;

BEGIN
  rdaarr := NIL;
  IF ~b.InitDynStr (ds) THEN HALT (d.fail); END;
  IF o.wbStarted THEN n := o.wbenchMsg(wb.WBStartup).numArgs-1; ELSE n := 1; END;
  IF n > 0 THEN i := 1; ELSE i := 0; END;
  fl := {b.doCD, b.ignoreProject, b.argFile, b.allowAskArg, b.askEmptyOnAlways};
  WHILE i <= n DO
    Rda := b.ReadArgs (templ, Args, i, fl);
    IF Rda = NIL THEN HALT (d.fail); END;
    IF ~b.DynAppendTT (rdaarr, Rda, {b.noNulTerm}) THEN HALT (d.fail); END;
    Rda := NIL;
    EXCL (fl, b.allowAskArg);
    IF Args.toolFilter = NIL THEN 
      Args.toolFilter :=  b.StrIndex (defaultToolFilter, 0);
    END;  
    IF ~b.DynExpand (matp, 4 * st.Length (Args.toolFilter^)) THEN HALT (d.fail); END;
    IF d.ParsePatternNoCase (Args.toolFilter^, matp^, LEN (matp^)) < 0 THEN HALT (d.fail); END;
    l := 0;
    IF Args.replace # 0 THEN INC (l); END; IF Args.replaceOnly # 0 THEN INC (l); END;
    IF Args.delete # 0 THEN INC (l); END; IF Args.list # 0 THEN INC (l); END;    
    IF (l>1) OR ((Args.list # 0) & (Args.tool # NIL)) THEN
      i := d.SetIoErr (d.tooManyArgs); HALT (d.fail);
    END;  
    IF (Args.tt = NIL) & (Args.tool = NIL) & (Args.delete = 0) & (Args.list = 0) THEN
      i := d.SetIoErr (d.requiredArgMissing); HALT (d.fail);
    END;
    verb := 1;
    IF Args.verbosity # NIL THEN
      IF (Args.verbosity^ < 0) OR (Args.verbosity^ > 2) THEN 
        i := d.SetIoErr (d.badNumber); HALT (d.fail); 
      END;
      verb := Args.verbosity^;
    END;  
    IF i=1 THEN IF ((verb>=1) & (Args.list = 0)) OR (verb>=2) THEN 
      bv.FLPrintF (NIL, NIL, "%s\n", b.StrIndex (versTag, 6)); 
    END; END;    
    NEW (MyAp); (* e.public bit set by BlackMagic *)
    MyAp.breakBits := LONGSET{d.ctrlC};
    ret := d.MatchFirst (Args.file^, MyAp^);
    itswild := d.itsWild IN MyAp.flags;
    IF ~itswild & (Args.all = 0) THEN 
      d.MatchEnd (MyAp^);
      COPY ("", ds^);
      IF ~b.DynAppend (ds, Args.file^) THEN HALT (d.fail); END;
      IF b.Strlastnicmp (ds^, ".info", 5) THEN ds [st.Length (ds^)-5] := '\000'; END;
      IF ~Process (ds^) THEN HALT (d.fail); END;
      ret := d.noMoreEntries;
    ELSE
      WHILE ret = 0 DO
        IF MyAp.info.dirEntryType > 0 THEN
          all := TRUE;
          IF (Args.all # 0) & ~(d.didDir IN MyAp.flags) THEN INCL (MyAp.flags, d.doDir); END;
          EXCL (MyAp.flags, d.didDir); 
        ELSIF MyAp.info.dirEntryType < 0 THEN
          COPY ("", ds^);
          IF ~b.Strlastnicmp (".info", MyAp.info.fileName, 5) THEN
            IF ~b.WBArgToFNam (ds, MyAp.last.lock, b.StrIndex (MyAp.info.fileName, 0)^, {}) THEN 
              d.MatchEnd (MyAp^); HALT (d.fail); 
            END;            
            IF ~Process (ds^) THEN d.MatchEnd (MyAp^); HALT (d.fail); END; 
          END;
        END; 
        ret := d.MatchNext (MyAp^);
      END; (* WHILE *)  
      d.MatchEnd (MyAp^);
    END;  
    IF d.CheckSignal (LONGSET{d.ctrlC}) # LONGSET{} THEN
      IF ret = d.noMoreEntries THEN ret := d.break; END;
    END;  
    IF ret # d.noMoreEntries THEN l := d.SetIoErr (ret); HALT (d.fail); END;
    DISPOSE (MyAp);
    INC (i);
  END; (* WHILE *)

CLOSE
  b.FreeArgs (Rda);
  rdaarr1 := b.AddPtr (b.TTAPtr (rdaarr), 0);
  IF rdaarr1 # NIL THEN
    i := 0;
    WHILE rdaarr1[i] # NIL DO INC (i); END;
    FOR j := i-1 TO 0 BY -1 DO
      b.FreeArgs (rdaarr1[j]^);
    END; (* FOR *)  
  END; (* IF *)  
  IF o.Result # 0 THEN 
    IF d.PrintFault (d.IoErr(), b.GetStr (L.headerFailed)^) THEN END;
  ELSIF ((verb>=1) & (Args.list = 0)) OR (verb>=2) THEN 
    bv.FLPrintF (NIL, NIL, "%s", b.GetStr (L.msgFinished));
  END;    
END MagicToolTypes.