(*************************************************************************

:Program.    EdCmd2.mod
:Contents.   Commands for AmokEd
:Author.     Hartmut Goebel
:Language.   Oberon
:Translator. Amiga Oberon Compiler V2.00
:Imports.    SupLib (Hartmut Goebel)
:History.    V0.1, 23 Mar 1991 Hartmut Goebel
:History.    V1.0, 14 Apr 1991 Hartmut Goebel [hG]
:History.    V1.0b 28 Apr 1991 [hG] changed doNewWindow <- edL.TextInit
:History.    V1.0c 06 Jun 1991 [hG] +Vars lineno, colno
:History.    V1.1  12 Jun 1991 [hG] Scanf complited (SScanf v. V.Rudolph)
:History.    V1.1b 17 Jun 1991 [hG] eigener Screen möglich
:Date.       18 Oct 1991 21:36:31

*************************************************************************)

MODULE EdCmd2;
(* $Debug- *)
IMPORT
  cv:  Conversions,
  d:   Dos,
  e:   Exec,
  edD: EdDisplay,
  edE: EdErrors,
  edG: EdGlobalVars,
  edK: EdKeyboard,
  edL: EdLowLevel,
  eGd: EdGadgets,
  eMn: EdMenu,
  g:   Graphics,
  I:   Intuition,
  lst: EdLists,
  ol:  OberonLib,
  sl:  SupLib,
  str: Strings,
  sys: SYSTEM;

TYPE
  Variable = STRUCT (node: lst.Node)
    name: edG.StringPtr;
    string: edG.StringPtr;
  END;
  VarPtr = POINTER TO Variable;

  (* WICHTIG: Bei Änderungen Offsets in FindReplace.asm überprüfen!! *)
  FindReplaceStruct = STRUCT
    findStr: edG.StringPtr;
    line: edG.LinePtr;
    flen: INTEGER;
    pos: INTEGER;
  END;

CONST
  (* Flags für einzelne Kommandos *)
  replace*=0;
  previous*=1;
  oldStrings*=2;
  top*=0;
  height*=1;
  temp*=2;
  leftEdge*={top,height};

  ReplaceQuestion = "Replace? (y/n/a/q)";
  NoFindPattern = "No find pattern";
  NoReplacePattern = "No replace pattern";
  PatternNotFound = "Pattern Not Found";
  ReplaceLineTooLong = "Replace: Line Too Long";
  WindowTooBig = "window too big (try moving to upper left corner and retrying)";
  ExecuteFailed = "Execute failed!";

VAR
  VarList: lst.List;
  VarBuffer: ARRAY 14 OF CHAR;

(*-----------------------------------------------------------------------*)

PROCEDURE doUndo*;
BEGIN
  edD.TextLoad;
  edD.TextRedisplayCurrentLine;
END doUndo;


PROCEDURE doNull*; (* macht absolut nichts *)
BEGIN END doNull;


PROCEDURE doAbort*; (* subject of change *)
BEGIN
  edG.Rc := edE.AbortLevel;
END doAbort;


PROCEDURE doVersion*;
BEGIN
  edL.Title(edG.Version); edG.Rc := edE.cmdValid2;
END doVersion;

(*-----------------------------------------------------------------------*)

PROCEDURE doTLate*;
VAR
  ch: CHAR;
  long: LONGINT;
BEGIN
  IF NOT edL.StrToInt(edG.Arg[0],long) OR (long > 255) THEN
    edG.Rc := edE.cmdError; edL.Title(edG.BadArgument);
    RETURN;
  END;
  ch := edG.LineBuffer[edG.Text.pos];
  IF ch = 0X THEN
    ch := 20X; END;
  IF edG.Arg[0][0] < "0" THEN (* mit Vorzeichen => relativ *)
    ch := CHR(ORD(edG.LineBuffer[edG.Text.pos])+long);
  ELSE
    ch := CHR(long);
  END;
  IF ch # 0X THEN
    IF edG.LineBuffer[edG.Text.pos] = 0X THEN (* letztes Zeichen *)
      INC(edG.LineBufferLen);
      edG.LineBuffer[edG.LineBufferLen] := 0X;
    END;
    edG.LineBuffer[edG.Text.pos] := ch;
    IF NOT (edG.NoScreenUpdate > 0) THEN
      edL.MoveToCursor;
      edD.SetPen(edG.Text.line);
      edG.Arg[1] := sys.ADR(edG.LineBuffer[edG.Text.pos]);
      g.Text(edG.RPort,edG.Arg[1]^,1);
    END;
  END;
END doTLate;

(*-----------------------------------------------------------------------*)

PROCEDURE doScanf*;
CONST
  StrLen = 80;
VAR
  i,j:INTEGER;
  maxWidth:INTEGER;
  allAllowed:BOOLEAN;
  negAllowed:BOOLEAN;
  allowedChars:ARRAY StrLen OF CHAR;
  fmtLen:INTEGER;
  argLen:INTEGER;
  argStr: edG.StringPtr;

  PROCEDURE IsAllowed(ch:CHAR):BOOLEAN;
  VAR
    i:INTEGER;
  BEGIN
    IF ch = ' ' THEN RETURN FALSE END;
    IF allAllowed THEN RETURN TRUE END;
    i := 0;
    WHILE (allowedChars[i] # ch) AND
          (allowedChars[i] # 0X) DO
      INC(i);
    END; (* WHILE *)
    IF allowedChars[i] = 0X THEN
      RETURN negAllowed
    ELSE
      RETURN NOT negAllowed;
    END;(* IF *)
  END IsAllowed;

  PROCEDURE BadArgument;
  BEGIN
    edG.Rc := edE.cmdError; edL.Title(edG.BadArgument);
  END BadArgument;

BEGIN
  i := 0;
  argStr := sys.ADR(edG.LineBuffer[edG.Text.pos]);
  fmtLen := str.Length(edG.Arg[0]^);
  argLen := str.Length(argStr^);;
  DISPOSE(edG.ScanStr);

  (* scan format string *)

  (* skip leading garbage *)
  i := 0;
  WHILE (i < fmtLen) AND (edG.Arg[0][i] # '%') DO
    INC(i); END;
  IF i = fmtLen THEN
    BadArgument; RETURN;
  END;

  (* check for '*' (ignore argument) *)
  INC(i);
  IF edG.Arg[0][i] = '*' THEN RETURN END;

  (* calculate maximal width of string *)
  maxWidth := 0;
  WHILE (i < fmtLen) AND
        (edG.Arg[0][i] >= '0') AND
        (edG.Arg[0][i] <= '9') DO
    maxWidth := maxWidth * 10 + ORD(edG.Arg[0][i])-ORD('0');
    INC(i);
  END; (* WHILE *)
  IF i = fmtLen THEN
    BadArgument; RETURN;
  END;
  IF maxWidth = 0 THEN maxWidth := edG.MaxLineLength-1 END;

  (* is conversion-specifier 's' or '[..]' ? *)
  IF edG.Arg[0][i] = 's' THEN
    allAllowed := TRUE;
  ELSIF edG.Arg[0][i] = '[' THEN
    allAllowed := FALSE;
    negAllowed := FALSE;

    (* check for negation flags '~' and '^' *)
    INC(i);
    IF (edG.Arg[0][i] = '~') OR (edG.Arg[0][i] = '^') THEN
      negAllowed := TRUE;
      INC(i);
    END; (* IF *)

    j := 0;
    allowedChars := "";
    WHILE (i < fmtLen) AND
          (j < (StrLen-1)) AND
          (edG.Arg[0][i] # ']') DO
      allowedChars[j] := edG.Arg[0][i];
      INC(i);
      INC(j);
    END; (* WHILE *)
    allowedChars[j] := 0X;
    IF edG.Arg[0][i] # ']' THEN
      BadArgument; RETURN;
    END;
  ELSE
    BadArgument; RETURN;
  END; (* IF *)

  (* scan argument string *)

  (* skip leading blanks in argStr *)
  i := 0;
  WHILE (i < argLen) AND (argStr[i] = ' ') DO
    INC(i); END;

  j := 0;
  WHILE (i < argLen) AND
        (j < maxWidth) AND
        IsAllowed(argStr[i]) DO
    INC(i);
    INC(j);
  END; (* WHILE *)

  ol.New(edG.ScanStr,j+1);
  IF edG.ScanStr=NIL THEN
    INCL(edG.Status,edG.memoryFail); edG.Rc := edE.cmdSevere;
    RETURN;
  END;
  e.CopyMem(edG.LineBuffer[edG.Text.pos],edG.ScanStr^,j);
  edG.ScanStr[j] := 0X;
  edL.Title(edG.ScanStr^); edG.Rc := edE.cmdValid2;
END doScanf;

(*-------------------------------------------------------------------------*)

PROCEDURE ReleaseVar(var: lst.NodePtr);
BEGIN
  lst.Remove(VarList,var);
  DISPOSE(var(Variable).string);
  (*DISPOSE(var(Variable).name);  wird mit var alocciert *)
  DISPOSE(var);
END ReleaseVar;


PROCEDURE doSet*;
VAR
  var: lst.NodePtr;
  len: INTEGER;

  PROCEDURE SetString;
  BEGIN
    len := str.Length(edG.Arg[1]^)+1;
    ol.New(var(Variable).string,len);
    IF var(Variable).string = NIL THEN
      edG.Rc := edE.cmdSevere; INCL(edG.Status,edG.memoryFail);
      ReleaseVar(var);
      RETURN;
    END;
    e.CopyMem(edG.Arg[1]^,var(Variable).string^,len);
  END SetString;

BEGIN
  var := VarList.head;
  WHILE var # NIL DO
    IF var(Variable).name^ = edG.Arg[0]^ THEN
      DISPOSE(var(Variable).string);
      SetString;
      RETURN;
    END;
    var := var.next;
  END;
  len := str.Length(edG.Arg[0]^)+1;
  ol.New(var,sys.SIZE(Variable)+len);
  IF var = NIL THEN
    edG.Rc := edE.cmdSevere; INCL(edG.Status,edG.memoryFail);
    RETURN;
  END;
  (* $TypeChk- *)
  sys.INIT(var(Variable)); (* $TypeChk= *)
  var(Variable).name := sys.VAL(LONGINT,var)+sys.SIZE(Variable);
  e.CopyMem(edG.Arg[0]^,var(Variable).name^,len);
  lst.AddTail(VarList,var);
  SetString;
END doSet;


PROCEDURE doSetEnv*;
BEGIN
  IF NOT sl.SetDEnv(edG.Arg[0]^,edG.Arg[1]^) THEN
    edG.Rc := edE.cmdSevere;
  END;
END doSetEnv;


PROCEDURE doUnsetEnv*;
BEGIN
  IF NOT sl.UnSetDEnv(edG.Arg[0]^) THEN
    edG.Rc := edE.cmdSevere;
  END;
END doUnsetEnv;


PROCEDURE doUnset*;
VAR
  var: lst.NodePtr;
  len: INTEGER;
BEGIN
  var := VarList.head;
  WHILE var # NIL DO
    IF var(Variable).name^ = edG.Arg[0]^ THEN
      ReleaseVar(var);
      RETURN;
    END;
    var := var.next;
  END;
END doUnset;


PROCEDURE FreeVars;
VAR
  var: lst.NodePtr;
BEGIN
  WHILE VarList.head#NIL DO
    var := VarList.head;
    VarList.head := var.next;
    ReleaseVar(var);
  END;
END FreeVars;


(* search order: (1) intern variables, (2) ENV:, (3) key-macros *)

PROCEDURE GetVar*(find: edG.StringPtr): edG.StringPtr;
VAR
  var: lst.NodePtr;
  string, string2: edG.StringPtr;
  len: INTEGER;
BEGIN
  IF    find^ = "findstr"  THEN RETURN edG.FindStr;
  ELSIF find^ = "repstr"   THEN RETURN edG.ReplaceStr;
  ELSIF find^ = "scanf"    THEN RETURN edG.ScanStr;
  ELSIF find^ = "filename" THEN RETURN sys.ADR(edG.Text.name);
  ELSIF find^ = "rexxport" THEN RETURN sys.ADR(edG.AEdrxPort);
  ELSIF find^ = "colno"    THEN
    IF cv.IntToString(LONG(edG.Text.pos+1),VarBuffer,12) THEN END;
    RETURN sys.ADR(VarBuffer);
  ELSIF find^ = "lineno"    THEN
    IF cv.IntToString(edG.Text.line+1,VarBuffer,12) THEN END;
    RETURN sys.ADR(VarBuffer);
  END;
  var := VarList.head;
  WHILE var # NIL DO
    IF var(Variable).name^ = find^ THEN
      RETURN var(Variable).string; END;
    var := var.next;
  END;
  string2 := sl.GetDEnv(find^);
  IF string2 # NIL THEN
    (*string := edL.CopyString(string2);
    DISPOSE(string2); (* _muß_ DISPOSE sein, wg. Environment.mod *)*)
    INCL(edG.Status,edG.disposeString);
    RETURN string2;
  END;
  string2 := edK.KeySpectroMacro(find);
  IF string2 = NIL THEN string2 := eMn.MenuToMacro(find); END;
  RETURN string2;
END GetVar;

(*-----------------------------------------------------------------------*)

PROCEDURE doFindStr*;
VAR
  sp: POINTER TO edG.StringPtr;
  len: INTEGER;
BEGIN
  IF replace IN edG.ArgSet THEN sp := sys.ADR(edG.ReplaceStr);
                  ELSE sp := sys.ADR(edG.FindStr); END;
  DISPOSE(sp^);
  sp^ := edL.CopyString(edG.Arg[0]);
END doFindStr;

(*-----------------------------------------------------------------------*)

PROCEDURE Next{"FindNext"}(VAR findStruct{8}:FindReplaceStruct): LONGINT;
PROCEDURE Prev{"FindPrev"}(VAR findStruct{8}:FindReplaceStruct): LONGINT;

PROCEDURE Replace;
VAR
  Rlen,Flen: INTEGER;
BEGIN
  Rlen := str.Length(edG.ReplaceStr^);
  Flen := str.Length(edG.FindStr^);
  IF NOT(edG.LineBufferLen+Rlen-Flen<edG.MaxLineLength) THEN
    edG.Rc := edE.cmdError; edL.Title(ReplaceLineTooLong); RETURN;
  END;
  str.Delete(edG.LineBuffer,edG.Text.pos,Flen);
  str.Insert(edG.LineBuffer,edG.Text.pos,edG.ReplaceStr^);
  INC(edG.Text.pos,Rlen);
  edD.PutBackLine;
  edD.TextRedisplayCurrentLine;
END Replace;


PROCEDURE doFind*;
VAR
  LineChg: LONGINT;
  FindData: FindReplaceStruct;
BEGIN
  edD.PutBackLine;
  IF NOT (oldStrings IN edG.ArgSet) THEN
    DISPOSE(edG.FindStr);
    edG.FindStr := edL.CopyString(edG.Arg[0]);
    IF replace IN edG.ArgSet THEN
      DISPOSE(edG.ReplaceStr);
      edG.ReplaceStr := edL.CopyString(edG.Arg[1]);
      IF edG.multiMode IN edG.Status THEN EXCL(edG.ArgSet,replace); END;
    END;
    IF edG.memoryFail IN edG.Status THEN RETURN; END;
  END;
  IF edG.FindStr = NIL THEN
    edG.Rc := edE.cmdError; edL.Title(NoFindPattern); RETURN; END;
  IF (replace IN edG.ArgSet) AND (edG.ReplaceStr = NIL) THEN
    edG.Rc := edE.cmdError; edL.Title(NoReplacePattern); RETURN; END;
  FindData.findStr := edG.FindStr; FindData.flen := str.Length(edG.FindStr^);
  FindData.line := edG.Text.actLinePtr; FindData.pos := edG.Text.pos+1;
  LOOP
    IF previous IN edG.ArgSet THEN LineChg := Prev(FindData);
                              ELSE LineChg := Next(FindData); END;
    IF (LineChg < 0) THEN
      edG.Rc := edE.cmdFailed; edL.Title(PatternNotFound);
      RETURN;
    END;
    edG.Text.actLinePtr := FindData.line; edG.Text.pos := FindData.pos;
    IF previous IN edG.ArgSet THEN DEC(edG.Text.line,LineChg);
                              ELSE INC(edG.Text.line,LineChg); END;
    edD.TextLoad;
    edD.TextSync;

    IF replace IN edG.ArgSet THEN
      Replace;
    ELSIF edG.multiMode IN edG.Status THEN
      edL.Title(ReplaceQuestion); edG.Rc := edE.cmdValid2;
    END;
    IF ~((edG.multiMode IN edG.Status) & (replace IN edG.ArgSet))
    OR (edG.Rc >= edE.AbortLevel) THEN
      EXIT; END;
    IF edL.BreakCheck() THEN edG.Rc := edE.cmdFailed; EXIT; END;
    INC(FindData.pos,str.Length(edG.ReplaceStr^));
  END;
END doFind;

(*-----------------------------------------------------------------------*)

(**** multi-replace ***)

PROCEDURE doMultiReplace*;
BEGIN
  INCL(edG.Status,edG.multiMode);
  doFind;
END doMultiReplace;


PROCEDURE MultiReplace*(IMsg: I.IntuiMessagePtr);
VAR
  Buffer: ARRAY 2 OF CHAR;
  Blen: INTEGER;
BEGIN
  Blen := SHORT(sl.DeadKeyConvert(IMsg,Buffer,2,NIL));
  IF Blen = 1 THEN
     CASE Buffer[0] OF
     "a": Replace;
          IF edG.Rc < edE.AbortLevel THEN
            edG.ArgSet := {replace,oldStrings};
            doFind;
            EXCL(edG.Status,edG.multiMode);
          END;|
     "y": Replace;
          edG.ArgSet := {oldStrings};
          doFind;|
     "n": edG.ArgSet := {oldStrings};
          doFind;|
     "q",03X:  (* Ctrl-C *)
          EXCL(edG.Status,edG.multiMode);
          edG.Rc := edE.cmdValid1;  (* ob das so sinnvoll ist? *)
          edL.WindowTitle;
          RETURN;
     ELSE
     END;
  END;
  IF edG.Rc >= edE.AbortLevel THEN EXCL(edG.Status,edG.multiMode);
  ELSIF edG.multiMode IN edG.Status THEN edL.Title(ReplaceQuestion); END;
END MultiReplace;

(*-------------------------------------------------------------------------*)

PROCEDURE doNewWindow*;
VAR
  newText: edG.TextHeaderPtr;
  nw: I.NewWindow;
BEGIN
  nw := edG.StdWindow;
  e.CopyMemQuick(edG.Config.edges,nw.leftEdge,sys.SIZE(edG.Config.edges));
  IF edG.TempHeight#0 THEN
    nw.height := edG.TempHeight; edG.TempHeight := 0;
  END;
  IF edG.TempWidth #0 THEN
    nw.width  := edG.TempWidth; edG.TempWidth := 0;
  END;
  IF edG.Screen # NIL THEN
    nw.screen := edG.Screen;
    nw.type := I.customScreen;
  END;
  newText := edL.TextInit(nw);
  IF newText=NIL THEN
    INCL(edG.Status,edG.memoryFail); edG.Rc := edE.cmdSevere;
    RETURN;
  END;
  edD.SwitchEdit(newText);
END doNewWindow;


(* set LeftEdge/TopEdge/Width/Height/tempWidth/tempHeight *)
PROCEDURE doWinEdges*;
VAR
  ip: POINTER TO INTEGER;
  long: LONGINT;
BEGIN
  IF temp IN edG.ArgSet THEN
    IF height IN edG.ArgSet THEN ip := sys.ADR(edG.TempHeight);
                   ELSE ip := sys.ADR(edG.TempWidth); END;
  ELSE
    IF (leftEdge-edG.ArgSet={}) THEN ip := sys.ADR(edG.Config.edges.left);
    ELSIF top IN edG.ArgSet     THEN ip := sys.ADR(edG.Config.edges.top);
    ELSIF height IN edG.ArgSet THEN ip := sys.ADR(edG.Config.edges.height);
                      ELSE ip := sys.ADR(edG.Config.edges.width); END;
  END;
  IF edL.StrToInt(edG.Arg[0],long) AND (long < MAX(INTEGER)) THEN
    ip^ := ABS(SHORT(long));
  ELSE
    edL.Title(edG.BadArgument); edG.Rc := edE.cmdError;
  END;
END doWinEdges;


PROCEDURE doResize*;
VAR
  Win: I.WindowPtr;
  cols, rows: LONGINT;
  width, height: INTEGER;
BEGIN
  IF NOT (edL.StrToInt(edG.Arg[0],cols))
  OR NOT (edL.StrToInt(edG.Arg[1],rows)) THEN
    edL.Title(edG.BadArgument); edG.Rc := edE.cmdError;
  END;
  Win := edG.Text.window;
  width := (SHORT(cols)*Win.rPort.font.xSize)+Win.borderLeft+Win.borderRight;
  height:= (SHORT(rows)*Win.rPort.font.ySize)+Win.borderTop+Win.borderBottom;
  IF (width < 16) OR (height < 16)
  OR (width > Win.wScreen.width - Win.leftEdge)
  OR (height > Win.wScreen.height - Win.topEdge) THEN
    edL.Title(WindowTooBig); edG.Rc := edE.cmdError;
    RETURN;
  END;
  I.SizeWindow(Win,width-Win.width, height-Win.height);
  edD.SetWindowParams;
  d.Delay(50*2); (* wait 2 seconds *)
END doResize;

(*-------------------------------------------------------------------------*)

PROCEDURE doMyPri*;
VAR
  long: LONGINT;
BEGIN
  IF edL.StrToInt(edG.Arg[0],long) AND (long<=MAX(SHORTINT))
  AND (long>=MIN(SHORTINT)) THEN
    IF e.SetTaskPri(e.FindTask(NIL),SHORT(SHORT(long))) = 0 THEN END;
  ELSE
    edL.Title(edG.BadArgument); edG.Rc := edE.cmdError;
  END;
END doMyPri;


PROCEDURE doExecute*;
VAR
  OldLock: d.FileLockPtr;
BEGIN
  OldLock := d.CurrentDir(edG.Text.dirLock);
  IF NOT d.Execute(edG.Arg[0]^,NIL,NIL) THEN
    edG.Rc := edE.cmdFailed; edL.Title(ExecuteFailed); END;
  OldLock := d.CurrentDir(OldLock);
END doExecute;

(*-------------------------------------------------------------------------*)

BEGIN
  lst.Init(VarList);
  edG.FindStr := NIL; edG.ReplaceStr := NIL; edG.ScanStr := NIL;
  edG.Screen := NIL;

CLOSE
  IF edG.Screen # NIL THEN I.OldCloseScreen(edG.Screen); END;
  FreeVars;
END EdCmd2.