MODULE Command;

(***************************************************************************)
(*                      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 Text, TextExtras, CharType, HashText, Fmt, TextTo;
IMPORT IO, IOErr, PathNameStream, TextStream, StdIO, Err;


TYPE
  Command = OBJECT
    next: Command;
    closure: Closure;
    name, help: Text.T;
  END;

CONST
  PromptTail = "> ";

VAR
  commandNames_g := HashText.CINew(0);
  commands_g: Command := NIL;
  prompt_g := "--" & PromptTail;


PROCEDURE SortedAdd(new: Command; VAR list: Command) RAISES {}=
  BEGIN
    IF (list = NIL) OR (Text.Compare(new.name, list.name) < 0) THEN
      new.next := list;
      list := new;
    ELSE
      SortedAdd(new, list.next);
    END;
  END SortedAdd;


(*PUBLIC*)
PROCEDURE BindClosure(name: Text.T; c: Closure; help: Text.T := NIL) RAISES {}=
  VAR
    id: HashText.Id;
    command: Command;
    l, index, lindex: CARDINAL;
    shortFormArray: REF ARRAY OF CHAR;
    shortForm: TEXT;
    ch: CHAR;
  BEGIN
    l := Text.Length(name);
    shortFormArray := NEW(REF ARRAY OF CHAR, l);
    index := 0; lindex := 0;
    WHILE index < l DO
      ch := Text.GetChar(name, index);
      IF CharType.IsUpper(ch) THEN
        shortFormArray[lindex] := CharType.ToLower(ch);
        INC(lindex);
      END;
      INC(index);
    END; (* while *)
    shortForm := Text.FromChars(SUBARRAY(shortFormArray^, 0, lindex));

    IF HashText.Enter(commandNames_g, name, id) THEN
      command := NEW(Command);
      command.closure := c;
      command.name := HashText.Key(commandNames_g, id);
      IF help = NIL THEN help := "" END;
      command.help := help;
      HashText.Associate(commandNames_g, id, command);
      SortedAdd(command, commands_g);
      IF Text.Length(shortForm) > 0 AND NOT Text.Equal(name, shortForm) THEN
        IF HashText.Enter(commandNames_g, shortForm, id) THEN
         HashText.Associate(commandNames_g, id, command);
        ELSE
          Err.Print(Fmt.F("Duplicated (short form of) command: \'%s\'\n",
	      shortForm),
              Err.Severity.Warning);
        END; (* if *)
      END; (* if *)
    ELSE
      Err.Print(Fmt.F("Duplicated command: \'%s\'\n", name),
          Err.Severity.Warning);
    END;
  END BindClosure;

PROCEDURE SetPrompt(p: TEXT) RAISES {}=
  BEGIN
    prompt_g := p & PromptTail;
  END SetPrompt;


TYPE
  SimpleClosure = Closure OBJECT
    proc: PROCEDURE() RAISES {}
  OVERRIDES
    apply := CallProc;
  END;


PROCEDURE CallProc(sc: SimpleClosure) RAISES {}=
  BEGIN
    sc.proc();
  END CallProc;


(* PUBLIC *)
PROCEDURE Bind(
    name: Text.T;
    proc: PROCEDURE() RAISES{};
    help: Text.T := NIL)
    RAISES {}=
  VAR
    sc: SimpleClosure;
  BEGIN
    sc := NEW(SimpleClosure);
    sc.proc := proc;
    BindClosure(name, sc, help);
  END Bind;


VAR
  quit_g: BOOLEAN;


PROCEDURE Help() RAISES {}=
  VAR
    command := commands_g;
  BEGIN
    IF command # NIL THEN
      WHILE command # NIL DO
        PutF("%-24s %s\n", command.name, command.help);
        command := command.next;
      END;
    ELSE
      Put("No commands available!\n");
    END;
  END Help;


PROCEDURE Quit() RAISES {}=
  BEGIN
    quit_g := TRUE;
  END Quit;


TYPE
  StreamStack = OBJECT
    next: StreamStack := NIL;
    s: IO.Stream;
  END;


VAR
  inStack_g, logStack_g: StreamStack := NIL;
  dontLog_g := FALSE;


PROCEDURE Open(
    name: Text.T;
    mode: IO.OpenMode;
    VAR ss: StreamStack)
    RAISES {}=
  VAR
    new: StreamStack;
  BEGIN
    TRY
      new := NEW(StreamStack, next := ss, s := PathNameStream.Open(name, mode));
      ss := new;
    EXCEPT
    | IO.Error(errant) =>
        Put(IOErr.DescribeAndClose(errant));
    END;
  END Open;


PROCEDURE Close(VAR ss: StreamStack) RAISES {}=
  BEGIN
    TRY
      IO.Close(ss.s);
      ss := ss.next;
    EXCEPT
    | IO.Error(errant) => IOErr.Close(errant);
    END; (* try *)
  END Close;


PROCEDURE Indirect() RAISES {}=
  VAR
    arg: Text.T;
  BEGIN
    dontLog_g := TRUE;
    IF GetArg(arg) THEN Open(arg, IO.OpenMode.Read, inStack_g) END;
  END Indirect;


PROCEDURE Log() RAISES {}=
  VAR
    arg: Text.T;
  BEGIN
    dontLog_g := TRUE;
    IF GetArg(arg) THEN Open(arg, IO.OpenMode.Write, logStack_g) END;
  END Log;


PROCEDURE EndLog() RAISES {}=
  BEGIN
    dontLog_g := TRUE;
    IF logStack_g = NIL THEN
      Put("Not logging\n");
    ELSE
      WITH name = IO.Name(logStack_g.s) DO
        IF name # NIL THEN
          PutF("Closing log \'%s\'\n", name);
        ELSE
          Put("Closing log\n");
        END;
      END;
      Close(logStack_g);
    END;
  END EndLog;

PROCEDURE Last() RAISES {}=
  BEGIN
    IF lastLine_g # NIL THEN
      WITH new = NEW(StreamStack, next := inStack_g,
                      s := TextStream.Open(lastLine_g)) DO
        inStack_g := new;
      END;
    END; (* if *)
  END Last;

PROCEDURE GetLine(): Text.T RAISES {IO.Error}=
  BEGIN
    LOOP
      VAR
        stdIn := inStack_g = NIL;
        in: IO.Stream;
      BEGIN
        IF stdIn THEN in := StdIO.In() ELSE in := inStack_g.s END;
        TRY
          WITH text = IO.GetText(
              in, terminate := CharType.EndOfLine + CharType.Set{';'},
	      unget := FALSE) DO
             (* reflect input, if not from 'StdIO.In' *)
            IF NOT stdIn THEN PutF("%s\n", text) END;
            RETURN text;
          END;
        EXCEPT
        | IO.EndOfStream =>
            IF stdIn THEN
              quit_g := TRUE;
              RETURN "";
            ELSE
              Close(inStack_g);
            END;
        END;
      END;
    END;
  END GetLine;


VAR
  line_g, lastLine_g: Text.T := NIL;
  linePos_g: CARDINAL := 0;

(*PUBLIC*)
PROCEDURE Argument(VAR arg: Text.T): BOOLEAN RAISES {}=
  TYPE
    State = {Initial, InNormalArg, InQuotedArg};
  VAR
    length := Text.Length(line_g);
    state := State.Initial;
    start: CARDINAL;
  BEGIN
    LOOP
      IF linePos_g >= length THEN
        IF state = State.Initial THEN RETURN FALSE ELSE EXIT END;
      ELSE
        WITH ch = Text.GetChar(line_g, linePos_g) DO
          IF CharType.IsWhitespace(ch) THEN
            IF state = State.InNormalArg THEN EXIT END;
            (* loop *)
          ELSIF ch = '\"' THEN
            IF state = State.Initial THEN
              start := linePos_g + 1;
              state := State.InQuotedArg;
            ELSE
              EXIT;
            END;
          ELSE
            IF state = State.Initial THEN
              start := linePos_g;
              state := State.InNormalArg;
            END;
          END;
          INC(linePos_g);
        END;
      END;
    END;
    arg := TextExtras.Extract(line_g, start, linePos_g);
    IF state = State.InQuotedArg THEN INC(linePos_g) END;
    RETURN TRUE;
  END Argument;


(*PUBLIC*)
PROCEDURE CardinalArgument(VAR card: CARDINAL): BOOLEAN RAISES {}=
  VAR
    arg: Text.T;
  BEGIN
    IF Argument(arg) THEN
      RETURN TextTo.BigCard(arg, card);
    ELSE
      RETURN FALSE;
    END;
  END CardinalArgument;


(*PUBLIC*)
PROCEDURE IntegerArgument(VAR integer: INTEGER): BOOLEAN RAISES {}=
  VAR
    arg: Text.T;
  BEGIN
    IF Argument(arg) THEN
      RETURN TextTo.BigInt(arg, integer);
    ELSE
      RETURN FALSE;
    END;
  END IntegerArgument;


(*PUBLIC*)
PROCEDURE RestOfLine(): Text.T RAISES {}=
  BEGIN
    RETURN TextExtras.Extract(line_g, linePos_g, Text.Length(line_g));
  END RestOfLine;


PROCEDURE LogLine() RAISES {}=
  VAR
    log := logStack_g;
  BEGIN
    IF log # NIL AND NOT dontLog_g THEN
      WITH line = Fmt.F("%s\n", line_g) DO
        TRY
          WHILE log # NIL DO IO.PutText(log.s, line); log := log.next END;
        EXCEPT
        | IO.Error(errant) => IOErr.Close(errant);
        END; (* try *)
      END;
    END;
  END LogLine;


PROCEDURE TidyUp() RAISES {}=
  BEGIN
    WHILE logStack_g # NIL DO Close(logStack_g) END;
    WHILE inStack_g # NIL DO Close(inStack_g) END;
    IO.Flush(StdIO.Out());
  END TidyUp;


(*PUBLIC*)
PROCEDURE Interact(s: IO.Stream := NIL) RAISES {IO.Error}=
  VAR
    t: Text.T;
    id: HashText.Id;
    command: Command;
  BEGIN
    quit_g := FALSE;
    IF s # NIL THEN inStack_g := NEW(StreamStack, s := s); END;
    REPEAT
      Put(prompt_g);
      IO.Flush(StdIO.Out());
      lastLine_g := line_g;
      line_g := GetLine();
      linePos_g := 0;
      dontLog_g := FALSE;
      IF Argument(t) THEN
        IF HashText.Lookup(commandNames_g, t, id) THEN
          command := HashText.Value(commandNames_g, id);
          command.closure.apply();
          LogLine();
        ELSE
          Put("Bad command: \'?\' to list commands\n");
        END;
      ELSE
        (* no command *)
      END;
    UNTIL quit_g;
    TidyUp();
  END Interact;


(*PUBLIC*)
PROCEDURE GetArg(VAR a: Text.T): BOOLEAN RAISES {}=
  BEGIN
    IF Argument(a) THEN RETURN TRUE; END;
    Put("Bad args\n");
    RETURN FALSE;
  END GetArg;


(*PUBLIC*)
PROCEDURE CardGetArg(VAR card: CARDINAL): BOOLEAN RAISES {}=
  BEGIN
    IF CardinalArgument(card) THEN RETURN TRUE; END;
    Put("Bad args\n");
    RETURN FALSE;
  END CardGetArg;


(*PUBLIC*)
PROCEDURE IntGetArg(VAR int: INTEGER): BOOLEAN RAISES {}=
  BEGIN
    IF IntegerArgument(int) THEN RETURN TRUE; END;
    Put("Bad args\n");
    RETURN FALSE;
  END IntGetArg;


(*PUBLIC*)
PROCEDURE Put(t: Text.T) RAISES {}=
  BEGIN
    IO.PutText(StdIO.Out(), t);
  END Put;


(*PUBLIC*)
PROCEDURE PutF(fmt: Text.T; t1, t2, t3, t4, t5: Text.T := NIL) RAISES {}=
  BEGIN
    IO.PutF(StdIO.Out(), fmt, t1, t2, t3, t4, t5);
  END PutF;


(*PUBLIC*)
PROCEDURE PutFN(fmt: Text.T; READONLY array: ARRAY OF TEXT) RAISES {}=
  BEGIN
    IO.PutFN(StdIO.Out(), fmt, array);
  END PutFN;

BEGIN
  Bind("?", Help, "give help information");
  Bind("Quit", Quit, "quit the program");
  Bind("Help", Help, "give help information");
  Bind("@", Indirect, "read commands from named file");
  Bind("Last", Last, "redo last command");
  Bind("StartLog", Log, "save all commands in named log file");
  Bind("EndLog", EndLog, "stop logging");
END Command.