(* OPREFS OberonOpts -mdai OLinkOpts -mdais *)
(* ------------------------------------------------------------------------
  :Program.       SetEnv.mod
  :Contents.      SetEnv clone, supports dos V39 SAVE_to_envarc: feature.
  :Contents.      (use SAVE option) If you specify a var name without a
  :Contents.      string, SetEnv deletes the var (aka UnSetEnv)
  :Author.        Franz Schwarz
  :Copyright.     Freeware (freely distributable, copyrighted software)
  :Language.      Oberon-2
  :Translator.    Amiga Oberon 3.00
  :History.       v39.0 fSchwarz
  :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
  :Remark.        As of Amiga Oberon Release 3.00: possible odd pointers to
  :Remark.        array of char/byte: _don't_ compile with OddChk
  :Usage.         SetEnv NAME,SAVE/S,STRING/F
------------------------------------------------------------------------ *)

MODULE SetEnv;

IMPORT d: Dos, e: Exec, i: Intuition, y: SYSTEM, o: OberonLib (* , NoGuru *) ;

CONST versionStr = "\000$VER: Oberon-SetEnv 39.0 (8.5.93)";

CONST saveVar = 12; (* V39+ Dos: Affect ENVARC: as well as ENV: *)

CONST templ = "NAME,SAVE/S,STRING/F";

TYPE
  ArgT = STRUCT
    name  : e.STRPTR;
    save  : LONGINT;
    string: e.STRPTR;
  END;
  
VAR Rda: d.RDArgsPtr;
    Args: ArgT;
    Err: LONGINT;
    Flags: LONGSET;
    Eac: d.ExAllControlPtr;
    Buf: ARRAY 1000 OF y.BYTE;
    EARes: BOOLEAN;
    Ead: d.ExAllDataPtr;
    k: LONGINT;
    lock: d.FileLockPtr;
    dos : d.DosLibraryPtr;
    break: BOOLEAN;

PROCEDURE ExAllEnd      *{dos,-990}(lock{1}      : d.FileLockPtr;  (* V39 Dos *)
                                    buffer{2}    : ARRAY OF y.BYTE;
                                    size{3}      : LONGINT;
                                    data{4}      : LONGINT;
                                    ctrl{5}      : d.ExAllControlPtr);

BEGIN
  break := FALSE;
  dos := d.base;
  y.SETREG(0, y.ADR(versionStr));
  Flags:=LONGSET{d.globalOnly};
  o.Result:=20;
  IF d.dos.lib.version<37 THEN 
    IF d.Output()#NIL THEN 
      y.SETREG(0, d.Write(d.Output(), "Need AmigaOS 2.04 or higher!\n", 29));
    ELSE
      e.Alert(e.recovery+e.openLib+e.dosLib+e.anUnknown);
    END;
    HALT(20);
  END;
  IF o.wbStarted THEN
    i.DisplayBeep(NIL);
    HALT(20);
  END;
  Rda:=d.ReadArgs(templ, Args, NIL);
  IF Rda#NIL THEN
    o.Result := 10;
    IF Args.save # 0 THEN INCL (Flags, saveVar); END;
    IF Args.name # NIL THEN      
      IF Args.string = NIL THEN
        y.SETREG (0, d.DeleteVar(Args.name^, Flags)); o.Result := 0; 
      ELSE
        IF d.SetVar(Args.name^, Args.string^, -1, Flags) THEN o.Result := 0; END;
      END;
    ELSE (* Args.name # NIL *)
      IF Args.save = 0 THEN lock := d.Lock ("ENV:", d.accessRead);
      ELSE lock := d.Lock ("ENVARC:", d.accessRead); END;  
      IF lock # NIL THEN
        Eac := d.AllocDosObject (d.exAllControl, NIL);
        IF Eac # NIL THEN
          Eac.lastKey := 0; Eac.matchString := NIL; Eac.matchFunc := NIL;
          LOOP
            EARes := d.ExAll(lock, Buf, SIZE(Buf), d.type, Eac);
            IF ~EARes THEN IF d.IoErr() # d.noMoreEntries THEN EXIT; END; END;
            Ead := y.ADR (Buf);
            IF ~break THEN
              FOR k := 1 TO Eac.entries DO
                IF d.ctrlC IN d.CheckSignal (LONGSET{d.ctrlC}) THEN
                  break := TRUE;
                  d.PrintF ("*** Aborted\n");
                  IF dos.lib.version >= 39 THEN
                    ExAllEnd (lock, Buf, SIZE(Buf), d.type, Eac);
                    o.Result := 5;
                    EXIT;
                  END;    
                END; (* d.ctrlC IN .. *)
                IF (Ead.type < 0) & ~break THEN d.PrintF ("%s\n", Ead.name); END;
                Ead := Ead.next;
              END; (* FOR *)
            END; (* ~break *)  
            IF ~EARes THEN 
              IF break THEN o.Result := 5; ELSE o.Result := 0; END;
              EXIT;
            END; 
          END; (* LOOP *)  
          d.FreeDosObject (d.exAllControl, Eac);
        END; (* Eac # NIL *)
        d.UnLock (lock);  
      END; (* lock # NIL *)  
    END; (* Args.name # NIL *)
    d.FreeArgs (Rda);
  END; (* Rda # NIL *)
END SetEnv.