UNSAFE MODULE M3Path_ux EXPORTS M3Path;

(***************************************************************************)
(*                      Copyright (C) Olivetti 1989                        *)
(*                          All Rights reserved                            *)
(*                                                                         *)
(* Use and copy of this software and preparation of derivative works based *)
(* upon this software are permitted to any person, provided this same      *)
(* copyright notice and the following Olivetti warranty disclaimer are     *) 
(* included in any copy of the software or any modification thereof or     *)
(* derivative work therefrom made by any person.                           *)
(*                                                                         *)
(* This software is made available AS IS and Olivetti disclaims all        *)
(* warranties with respect to this software, whether expressed or implied  *)
(* under any law, including all implied warranties of merchantibility and  *)
(* fitness for any purpose. In no event shall Olivetti be liable for any   *)
(* damages whatsoever resulting from loss of use, data or profits or       *)
(* otherwise arising out of or in connection with the use or performance   *)
(* of this software.                                                       *)
(***************************************************************************)

IMPORT CharType, EnvVar, FileOp, PathNameStream, IO, OSError, PathName, SList, 
    Text, TextExtras, HashText;

REVEAL
  Elem = ElemPublic BRANDED OBJECT
    fileInfo: FileOp.Info := NIL;
    id: HashText.Id := NIL;
  OVERRIDES copy := PrivCopy;
  END;

(*PRIVATE*)
PROCEDURE FlushLine(s: IO.Stream) RAISES {IO.Error, IO.EndOfStream}=
  BEGIN
    EVAL IO.Skip(s, CharType.All - CharType.EndOfLine, unget := FALSE);
  END FlushLine;

VAR
  currentFirst_g := FALSE;
  currentFileInfo_g: FileOp.Info := NIL;
  explicit_g := FALSE;
  explicitList_g := SList.T{};
  defaultList_g := SList.T{};
  elemTable_g := HashText.New(32);

TYPE ReadOnlyState = REF BOOLEAN; (* kept in table *)

(*PUBLIC*)
PROCEDURE EnsureCurrentFirst() RAISES {}=
  BEGIN
    currentFirst_g := TRUE;
    (* get info on current dir *)
    IF currentFileInfo_g = NIL THEN
      TRY currentFileInfo_g := FileOp.GetInfo(CurrentDir, FALSE);
      EXCEPT OSError.E => (*;*)
      END;
    END;
  END EnsureCurrentFirst;

PROCEDURE AddDefault(t: TEXT; readOnly := TRUE) RAISES {}=
  BEGIN
    IF t = NIL THEN defaultList_g.head := NIL
    ELSE AddUniqueName("", t, readOnly, FALSE, defaultList_g);
    END;
  END AddDefault;

(*PUBLIC*)
PROCEDURE AddExplicit(t: TEXT; readOnly := TRUE) RAISES {}=
  BEGIN
    explicit_g := TRUE;
    IF t = NIL THEN explicitList_g.head := NIL;
    ELSE
        VAR
          index, sindex: CARDINAL := 0;
          l := Text.Length(t);
          name: TEXT;
          these := SList.T{};
	  this: SList.TextElem;
        BEGIN
          WHILE index < l DO
            IF NOT TextExtras.FindChar(t, ':', index) THEN
              index := l;
            END; (* if *)
            name := TextExtras.Extract(t, sindex, index);
	    this := NEW(SList.TextElem, text := name);
	    SList.AddFront(these, this);
	    sindex := index+1; index := sindex;
          END; (* while *)
	  this := these.head;
	  WHILE this # NIL DO
            AddUniqueName("", this.text, readOnly, FALSE, explicitList_g);
	    this := this.next;
	  END; (* while *)
        END;
    END;
  END AddExplicit;

PROCEDURE ReEnableM3Path() RAISES {}=
  BEGIN
    explicit_g := FALSE; explicitList_g.head := NIL;
  END ReEnableM3Path;


(*PUBLIC*)
PROCEDURE Read(
    dir := CurrentDir;
    name := FileName;
    doTransitiveClosure := TRUE)
    : SList.T
    RAISES {IO.Error, BadDirName}=
  VAR
    result := SList.T{};
  BEGIN
    IF explicit_g THEN
      Append(result, explicitList_g);
    ELSE
      IF NOT doTransitiveClosure THEN result := ReadOneDir(dir, name);
      ELSE result :=  ReadAllDirs(dir, name);
      END;
    END; (* if *)
    IF currentFirst_g THEN
      VAR elem :=  CheckUnique(result, CurrentDir, currentFileInfo_g, FALSE);
      BEGIN
        IF elem # NIL THEN
          SList.Remove(result, elem);
        ELSE
          VAR readOnly := FALSE;
              id := TableEnter(CurrentDir, readOnly);
          BEGIN
            elem := NEW(Elem, text := CurrentDir, unexpanded := CurrentDir,
                        fileInfo := currentFileInfo_g, readOnly := readOnly,
                        id := id)
          END;
        END; (* if *)
        SList.AddFront(result, elem);
      END; (* begin *)
    END;
    Append(result, defaultList_g);
    RETURN result;
  END Read;

PROCEDURE TableEnter(text: TEXT; VAR (*inout*) readOnly: BOOLEAN): HashText.Id=
  VAR id: HashText.Id;
    ros: ReadOnlyState;
  BEGIN
    (* If we have seen this directory already, update "readOnly" to the
       stored value, else set the stored value to "readOnly". *)
    IF HashText.Enter(elemTable_g, text, id) THEN
      ros := NEW(ReadOnlyState);
      ros^ := readOnly;
      HashText.Associate(elemTable_g, id, ros);
    ELSE
      ros := HashText.Value(elemTable_g, id);
      readOnly := ros^
    END;
    RETURN id;
  END TableEnter;


PROCEDURE Append(VAR result: SList.T; list: SList.T) RAISES {}=
  BEGIN
    IF list.head # NIL THEN
      VAR elem: Elem := list.head;
      BEGIN
        WHILE elem # NIL DO
          IF CheckUnique(result, elem.text, elem.fileInfo, elem.readOnly) = NIL THEN
            SList.AddRear(result, elem.copy());
          END; (* if *)
          elem := elem.next;
        END; (* while *)
      END;
    END;
  END Append;

(*PRIVATE*)
PROCEDURE ReadOneDir(
    dir := "";
    name := FileName)
    : SList.T
    RAISES {IO.Error, BadDirName}=
  VAR
    result := SList.T{};
  BEGIN
    AddOneDir("", Concat(dir, name), result);
    RETURN result;
  END ReadOneDir;

(*PRIVATE*)
PROCEDURE AddOneDir(
    relativeTo := "";
    m3pathName := FileName;
    VAR result: SList.T)
    RAISES {IO.Error, BadDirName}=
  VAR
    s := PathNameStream.Open(m3pathName, IO.OpenMode.Read, TRUE);
    readOnly := FALSE;
    name: TEXT;
  BEGIN
    IF s # NIL THEN
      TRY (*finally close *)
        LOOP
          TRY
	    name := ReadName(s, readOnly);
	    AddUniqueName(relativeTo, name, readOnly, list := result);
          EXCEPT IO.EndOfStream => EXIT;
          END;
        END; (*loop through file *)
      FINALLY IO.Close(s, TRUE);
      END;
    END;
  END AddOneDir;

(*PRIVATE*)
PROCEDURE ReadName(
    s: IO.Stream;
    VAR (*out*) readOnly: BOOLEAN)
    : Text.T
    RAISES {IO.Error, IO.EndOfStream} =
  BEGIN
    readOnly := FALSE;
    TRY
      WHILE IO.Skip(s, CharType.SpaceOrTab)
            IN SET OF CHAR{'#'} + CharType.EndOfLine DO
        FlushLine(s);
      END;
      VAR result := IO.GetText(s);
      BEGIN
      	IF CharType.ToUpper(IO.Skip(s, CharType.SpaceOrTab)) = 'R' THEN
	  readOnly := TRUE;
	END; (* if *)
        RETURN result;
      END;
    FINALLY FlushLine(s);
    END;
  END ReadName;

(*PRIVATE*)
PROCEDURE ReadAllDirs(
    dir, m3PathName: Text.T)
    : SList.T
    RAISES {IO.Error, BadDirName}=
  VAR
    initialList := SList.T{};
  BEGIN
    AddOneDir("", Concat(dir, m3PathName), initialList);
    DirWalk(dir, m3PathName, initialList);
    RETURN initialList;
  END ReadAllDirs;

(*PRIVATE*)
PROCEDURE DirWalk(
    relativeTo: Text.T;
    m3PathName: Text.T;
    VAR listSoFar: SList.T)
    RAISES {IO.Error, BadDirName}=
  VAR
    pathElem: Elem := listSoFar.head;
  BEGIN
    WHILE pathElem # NIL DO
      AddOneDir(
          pathElem.text,
          Concat(relativeTo, Concat(pathElem.text, m3PathName)),
          listSoFar);
      pathElem := pathElem.next;
    END; (*while*)
  END DirWalk;


(*PRIVATE*)
PROCEDURE Concat(head, tail: Text.T): Text.T RAISES {} =
  BEGIN
    IF IsLocalDir(tail) THEN RETURN head;
    ELSIF IsLocalDir(head) THEN RETURN tail;
    ELSE RETURN StripDotDot(PathName.Full(head, tail));
    END;
  END Concat;

CONST
  SDotS = "/./";
  SDotDotS = "/../";

(*PRIVATE*)
PROCEDURE StripDotDot(t: TEXT): TEXT RAISES {}=
  VAR a, b: CARDINAL := 0;
  BEGIN
    LOOP
      IF TextExtras.FindSub(t, SDotDotS, b) THEN
        IF FindPreDirSepChar(t, b, a) THEN
      	  t := TextExtras.Extract(t, 0, a) & (* includes '/' *)
	       TextExtras.Extract(t, b+4, Text.Length(t));
          (* step 'b', but 't' has shrunk! *)
	  b := a-1;
	ELSE
	  INC(b, 4);
        END; 
      ELSE
      	RETURN t;
      END; (* if *)
    END; (* loop *)
  END StripDotDot;

(*PRIVATE*)
PROCEDURE FindPreDirSepChar(t: TEXT; b: CARDINAL; 
    VAR (*out*) a: CARDINAL): BOOLEAN RAISES {}=
  BEGIN
    (* t[b] begins "/../", look back for preceding "/". *)
    a := b;
    WHILE a > 0 DO
      IF Text.GetChar(t, a-1) = PathName.DirSepCh() THEN
        VAR n := TextExtras.Extract(t, a-1, b+1);
	BEGIN
          IF Text.Equal(n, SDotS) OR Text.Equal(n, SDotDotS) THEN
            RETURN FALSE
	  ELSE
	    RETURN TRUE;
	  END; (* if *)
	END;
      END;
      DEC(a);
    END; (* while *)
    RETURN FALSE;
  END FindPreDirSepChar;

PROCEDURE IsLocalDir(dir: Text.T): BOOLEAN RAISES {} =
  BEGIN
    RETURN (Text.Length(dir) = 0) OR Text.Equal(dir, PathName.Current());
  END IsLocalDir;

(*PRIVATE*)
PROCEDURE AddUniqueName(
    dir, name: Text.T;
    readOnly := FALSE;
    append := TRUE;
    VAR list: SList.T)
    RAISES {BadDirName} =
  VAR
    expName := EnvVar.Expand(name); (* full name, expanded *)
    dirName: Text.T; (* full name, unexpanded *)
  BEGIN
    (* concat dir & name, both expanded and not *)
    IF Text.Length(expName) > 0
       AND Text.GetChar(expName, 0) = PathName.DirSepCh() THEN
      dirName := name;
    ELSE
      dirName := Concat(dir, name);
      expName := Concat(dir, expName);
    END;
    IF Text.Length(expName) # 0 AND NOT PathName.Valid(expName) THEN
      RAISE BadDirName(expName);
    END; 
    VAR
      fileInfo: FileOp.Info := NIL;
    BEGIN
      TRY fileInfo := FileOp.GetInfo(expName, FALSE);
      EXCEPT OSError.E => (*;*)
      END;
      IF CheckUnique(list, expName, fileInfo, readOnly) = NIL THEN
        VAR
          id := TableEnter(expName, readOnly);
        BEGIN
          WITH elem = NEW(Elem,
                          text := expName,
                          unexpanded := dirName,
	                  readOnly := readOnly,
                          fileInfo := fileInfo, id := id) DO
            IF append THEN SList.AddRear(list, elem);
            ELSE SList.AddFront(list, elem);
            END;
          END;
        END;
      END; (* if *)
    END; (* var fileInfo, elem *)
  END AddUniqueName;

PROCEDURE CheckUnique(list: SList.T; name: TEXT;
                      fileInfo: FileOp.Info;
                      readOnly: BOOLEAN): Elem=
(* Checks if the file denoted by "name, fileInfo" is
   already on "list". If so, returns the "Elem",
   else "NIL". *)
  VAR
    elem: Elem := list.head;
    id: HashText.Id := TableEnter(name, readOnly);
  BEGIN
    WHILE elem # NIL DO
      IF PSame(elem, id, fileInfo) THEN
	(* not unique, don't add, but make writable pervasive *)
	IF NOT readOnly AND elem.readOnly THEN
          elem.readOnly := FALSE;
          VAR ros: ReadOnlyState := HashText.Value(elemTable_g, id);
          BEGIN
            ros^ := FALSE;
          END;
        END;
        RETURN elem;
      ELSE elem := elem.next;
      END;
    END; (* while list *)
    RETURN NIL;
  END CheckUnique;

PROCEDURE PSame(elem: Elem; id: HashText.Id;
                fileInfo: FileOp.Info): BOOLEAN=
  BEGIN
    RETURN elem.id = id (* I.e. Text.Equal(elem.text, name) *)
           OR ((fileInfo # NIL)
              AND (elem.fileInfo # NIL)
              AND FileOp.Same(elem.fileInfo, fileInfo))     
  END PSame;


PROCEDURE Same(e1, e2: Elem): BOOLEAN RAISES {}=
  BEGIN
    WITH pe1 = NARROW(e1, Elem), pe2 = NARROW(e2, Elem) DO
      RETURN PSame(pe1, pe2.id, pe2.fileInfo);
    END; (* with *)
  END Same;

PROCEDURE PrivCopy(self: Elem): Elem RAISES {}=
  BEGIN
    RETURN NEW(Elem, text := self.text,
               unexpanded := self.unexpanded,
               readOnly := self.readOnly,
               fileInfo := self.fileInfo,
               id := self.id);
  END PrivCopy;

PROCEDURE ElemFrom(dir: TEXT): Elem RAISES {}=
  VAR
    fileInfo: FileOp.Info := NIL;
    readOnly := TRUE;
    id := TableEnter(dir, readOnly);
  BEGIN
    TRY fileInfo := FileOp.GetInfo(dir, FALSE);
    EXCEPT OSError.E => (*;*)
    END;
    RETURN NEW(Elem, text := dir, unexpanded := dir, fileInfo := fileInfo,
               readOnly := readOnly, id := id);
  END ElemFrom;

EXCEPTION ElemNotInHashTable;

PROCEDURE SetReadOnly(elem: Elem; ro := TRUE) RAISES {}=
  VAR id: HashText.Id;
  BEGIN
    elem.readOnly := ro;
    IF HashText.Lookup(elemTable_g, elem.text, id) THEN
      VAR ros: ReadOnlyState := HashText.Value(elemTable_g, id);
      BEGIN
        ros^ := ro;
      END;
      CheckROInList(explicitList_g, elem);
      CheckROInList(defaultList_g, elem);
    ELSE RAISE ElemNotInHashTable;
    END;
  END SetReadOnly;

PROCEDURE CheckROInList(list: SList.T; elem: Elem) RAISES {}=
  VAR dir: Elem := list.head;
  BEGIN
    WHILE dir # NIL DO
      IF elem = dir THEN RETURN
      ELSIF PSame(dir, elem.id, elem.fileInfo) THEN
        dir.readOnly := elem.readOnly;
      END; (* if *)
      dir := dir.next;
    END; (* while *)
  END CheckROInList;


BEGIN
END M3Path_ux.