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

:Program.    EdBlocks.mod
:Contents.   Routines for Block-Handling for AmokEd
:Author.     Hartmut Goebel
:Language.   Oberon
:Translator. Amiga Oberon Compiler V2.13
:History.    V0.1 12 Jan 1991 Hartmut Goebel [hG]
:History.    V1.0 14 Apr 1991 [hG]
:History.    V1.1 07 Jul 1991 [hG] +HoldExtPingPong in HoldBlockLines
:Date.       08 Feb 1992 15:09:56

************************************************************************)
(* $Debug- *)
MODULE EdBlocks;

IMPORT
  e: Exec,
  eAD: EdApplDefs,
  edD: EdDisplay,
  edE: EdErrors,
  edG: EdGlobalVars,
  edL: EdLowLevel,
  lst: EdLists,
  ol : OberonLib,
  sys: SYSTEM;

CONST
  BlockBegin = "Block Begin";
  BlockEnd = "Block End";
  BlockAlreadyMarked = "Block Already Marked";
  BlockUnmarked = "Block Unmarked";
  BlockNotSpecified = "Block Not Specified";
  CannotMoveIntoSelf = "Cannot Move into self";
  PushmarkStackLimitReached = "pushmark: stack limit reached";

  On = TRUE;
  Off = FALSE;


(* Schaltet Blockanzeige an oder aus (ggf. mit Unblock) *)
PROCEDURE DisplayBlock(on: BOOLEAN);
VAR
  start, lines: INTEGER;
  txt: edG.TextHeaderPtr;
BEGIN
(* $IFNOT ClearVars THEN *)
  txt := NIL;
  start := 0;
(* $END *)

  IF (edG.Block.ENum < 0) (* not specified *)
  OR (edG.iconMode IN edG.Block.Owner.status)
  OR (edG.Block.Owner.topLine+edG.Rows<edG.Block.SNum) (* not visible *)
  THEN
    IF NOT on THEN
      edG.Block.SNum := -1; edG.Block.ENum := -1;
    END;
    RETURN;
  END;
  IF edG.Block.Owner#edG.Text THEN
    txt := edG.Text;
    edD.SwitchEdit(edG.Block.Owner);
  END;
  IF edG.Text.topLine < edG.Block.SNum THEN
    start := SHORT(edG.Block.SNum-edG.Text.topLine) END;
  lines := edG.Rows;
  IF lines > edG.Block.ENum - edG.Block.SNum + 1 THEN
    lines := SHORT(edG.Block.ENum - edG.Block.SNum + 1); END;
  IF NOT on THEN
    edG.Block.SNum := -1; edG.Block.ENum := -1; END;
  edD.TextDisplaySeg(start,lines);
  IF txt#NIL THEN
    edD.SwitchEdit(txt); END;
END DisplayBlock;


(* Text-Refresh für Block.Owner mit Unblock (nach BDelete/BMove) *)
PROCEDURE RedrawBlockOwner;
VAR
  txt: edG.TextHeaderPtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  edG.Block.SNum := -1; edG.Block.ENum := -1;
  IF edG.iconMode IN edG.Block.Owner.status THEN RETURN END;
  txt := NIL;
  IF edG.Block.Owner#edG.Text THEN
    txt := edG.Text; edD.SwitchEdit(edG.Block.Owner); END;
  edD.TextSync(TRUE);
  IF txt#NIL THEN edD.SwitchEdit(txt); END;
END RedrawBlockOwner;


PROCEDURE dUnblock*;
BEGIN
  IF edG.Block.Owner # NIL THEN DisplayBlock(Off); END;
END dUnblock;


PROCEDURE dBlock*;
BEGIN
  IF (edG.Block.SNum<0) OR (edG.Block.Owner#edG.Text) THEN
    edG.Block.SNum := edG.Text.line;
    lst.SetMark(edG.Block,edG.Text.actLinePtr,NIL);
    edG.Block.Owner := edG.Text;
    edG.Rc := edE.cmdValid2;
    edL.Title(BlockBegin);
  ELSIF edG.Block.ENum<0 THEN
    IF edG.Text.line < edG.Block.SNum THEN
      edG.Block.ENum := edG.Block.SNum;
      edG.Block.SNum := edG.Text.line;
      lst.SetMark(edG.Block,edG.Text.actLinePtr,edG.Block.mark.head);
    ELSE
      edG.Block.ENum := edG.Text.line;
      lst.SetMark(edG.Block,NIL,edG.Text.actLinePtr);
    END;
    DisplayBlock(On); (* nur hier ändert sich die Anzeige *)
    edG.Rc := edE.cmdValid2;
    edL.Title(BlockEnd);
  ELSE
    edG.Rc := edE.cmdFailed; edL.Title(BlockAlreadyMarked);
  END;
END dBlock;


PROCEDURE BlockSpecified*(): BOOLEAN;
BEGIN
  IF edG.Block.ENum<0 THEN
    edG.Rc := edE.cmdFailed; edL.Title(BlockNotSpecified);
    RETURN FALSE;
  END;
  RETURN TRUE;
END BlockSpecified;


PROCEDURE NoMoveIntoBlock(): BOOLEAN;
BEGIN
  IF (edG.Text.line>edG.Block.SNum)
  AND (edG.Text.line<=edG.Block.ENum) AND (edG.Block.Owner=edG.Text) THEN
    edG.Rc := edE.cmdFailed; edL.Title(CannotMoveIntoSelf);
    RETURN FALSE;
  END;
  RETURN TRUE;
END NoMoveIntoBlock;


PROCEDURE RemBlock;
VAR
  bOwner: edG.TextHeaderPtr;
  line, numDelLines: LONGINT;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  bOwner := edG.Block.Owner;
  INCL(bOwner.status,edG.modified);

  IF (bOwner.line>=edG.Block.SNum)
  AND (bOwner.line<=edG.Block.ENum) THEN
    bOwner.actLinePtr := edG.Block.mark.tail.next(edG.Line);
  END;
  IF (bOwner.topLine>=edG.Block.SNum) THEN
    bOwner.topLine := MIN(LONGINT); (* force TextSync to recalc!! *)
  END;
  edL.FreeLines(bOwner.lineList,edG.Block.mark.head,edG.Block.mark.tail);
  IF bOwner.actLinePtr=NIL THEN
    bOwner.actLinePtr := bOwner.lineList.tail;
  END;

  numDelLines := edG.Block.ENum-edG.Block.SNum+1;
  DEC(bOwner.numberOfLines,numDelLines);
  line := bOwner.line;
  IF line >= edG.Block.SNum THEN
    IF line <= edG.Block.ENum THEN
      line := edG.Block.SNum;
      IF line+1 > bOwner.numberOfLines THEN
        DEC(line);
      END;
    ELSE
      DEC(line,numDelLines);
    END;
    bOwner.line := line;
  END;
END RemBlock;


PROCEDURE CopyBlock;
VAR
  Line, NewLine: edG.LinePtr;
  NumMovedLines: LONGINT;
  List: lst.List;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  lst.Init(List);
  Line := edG.Block.mark.head(edG.Line);
  LOOP
    NewLine := edL.CreateLineCopy(Line);
    IF NewLine#NIL THEN
      lst.AddTail(List,NewLine);
    ELSE
      IF List.head#NIL THEN
        edL.FreeLines(List,List.head(edG.Line),List.tail(edG.Line)); END;
      edG.Rc := edE.cmdFailed5; RETURN;
    END;
    IF Line = edG.Block.mark.tail THEN EXIT; END;
    Line := Line.next(edG.Line);
  END;
  INCL(edG.Text.status,edG.modified);
  lst.AddMarkBefore(edG.Text.lineList,List,edG.Text.actLinePtr);
  edG.Text.actLinePtr := List.head(edG.Line);
  NumMovedLines := edG.Block.ENum-edG.Block.SNum+1;
  INC(edG.Text.numberOfLines,NumMovedLines);
  IF (edG.Text.line <= edG.Block.SNum) AND (edG.Block.Owner=edG.Text) THEN
    INC(edG.Block.SNum,NumMovedLines);
    INC(edG.Block.ENum,NumMovedLines);
    IF edG.Text.line = edG.Text.topLine THEN
      INC(edG.Text.topLine,NumMovedLines); END;
  END;
  IF edG.Text.line = edG.Text.topLine THEN
    edG.Text.topLinePtr := edG.Text.actLinePtr; END;
END CopyBlock;


PROCEDURE dBDelete*;
BEGIN
  IF NOT BlockSpecified() THEN RETURN; END;
  edD.PutBackLine;
  RemBlock;
  IF edG.Block.Owner.lineList.head=NIL THEN
    edL.TextUnInit(edG.Block.Owner);
  ELSE
    edD.TextLoad;
  END;
  RedrawBlockOwner;
END dBDelete;


PROCEDURE dBCopy*;
BEGIN
  IF NOT BlockSpecified() OR NOT NoMoveIntoBlock() THEN
    RETURN; END;
  edD.PutBackLine;
  CopyBlock;
  edD.TextLoad;
  edD.TextSync(TRUE);
END dBCopy;


PROCEDURE dBMove*;
BEGIN
  IF NOT BlockSpecified() OR NOT NoMoveIntoBlock() THEN
    RETURN; END;
  edD.PutBackLine;
  CopyBlock;
  RemBlock;
  edD.TextLoad;
  RedrawBlockOwner;
  IF edG.Block.Owner#edG.Text THEN edD.TextSync(TRUE); END;
END dBMove;


PROCEDURE HoldBlockLines*(Decrement: BOOLEAN);
VAR
  i: INTEGER;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  IF edG.Text.ExtPingPong # NIL THEN
    i := 0;
    LOOP;
      IF edG.Text.ExtPingPong[i].line = -1 THEN
        EXIT;
      ELSIF edG.Text.ExtPingPong[i].line>edG.Text.line THEN
        IF Decrement THEN
          DEC(edG.Text.ExtPingPong[i].line);
        ELSE
          INC(edG.Text.ExtPingPong[i].line);
        END;
      ELSIF (edG.Text.ExtPingPong[i].line = edG.Text.line) & Decrement THEN
        edG.Text.ExtPingPong[i].line := -2;
      END;
      INC(i);
      IF i = eAD.NumExtPingPong THEN EXIT; END;
    END;
  END;
  IF (edG.Text#edG.Block.Owner) OR (edG.Block.SNum<0)
  OR (edG.Text.line > edG.Block.ENum) THEN
    RETURN;
  END;
  IF (edG.Block.ENum >= 0) THEN
    IF Decrement THEN
      IF (edG.Text.line = edG.Block.ENum) THEN
        IF edG.Block.ENum = edG.Block.SNum THEN
          dUnblock;
          RETURN;
        END;
        edG.Block.mark.head := edG.Block.mark.head.prev;
      END;
      DEC(edG.Block.ENum);
    ELSE
      INC(edG.Block.ENum);
    END;
  END;
  IF edG.Block.SNum >= edG.Text.line THEN
    IF Decrement THEN
      IF (edG.Text.line = edG.Block.SNum) THEN
        edG.Block.mark.head := edG.Block.mark.head.next;
      ELSIF edG.Block.SNum > 0 THEN
        DEC(edG.Block.SNum);
      END;
    ELSIF edG.Block.SNum > edG.Text.line THEN
      INC(edG.Block.SNum);
    END;
  END;
END HoldBlockLines;


PROCEDURE dBSource*;
VAR
  ThisLine, EndLine: edG.LinePtr;
  Buffer: edG.StringPtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  IF NOT BlockSpecified() THEN RETURN; END;
  ol.New(Buffer,edG.MaxLineLength);
  IF Buffer=NIL THEN
    INCL(edG.Status,edG.memoryFail); edG.Rc := edE.cmdSevere;
    RETURN;
  END;
  edD.PutBackLine;
  ThisLine := edG.Block.mark.head(edG.Line);
  EndLine := edG.Block.mark.tail(edG.Line);
  DisplayBlock(Off);
  LOOP
    IF ThisLine=NIL THEN EXIT; END;
    e.CopyMemQuick(ThisLine(edG.Line).string^,Buffer^,edG.MaxLineLength);
    edG.ExecCmd(Buffer);
    IF ThisLine = EndLine THEN EXIT; END;
    ThisLine := ThisLine.next(edG.Line);
  END; (* LOOP *)
  DISPOSE(Buffer);
END dBSource;

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


PROCEDURE dPushMark*;
BEGIN
  IF BlockSpecified() THEN
    IF edG.BStackCurrDepth = edG.BlockStackSize THEN
      edL.Title(PushmarkStackLimitReached); edG.Rc := edE.cmdFailed;
      RETURN;
    END;
    edG.BStack[edG.BStackCurrDepth] := edG.Block;
    INC(edG.BStackCurrDepth);
    DisplayBlock(Off);
  END;
END dPushMark;


PROCEDURE dPopMark*;
BEGIN
  edD.PutBackLine;
  DisplayBlock(Off);  (* remove any existing block *)
  IF edG.BStackCurrDepth = 0 THEN (*  no error message on purpose *)
    RETURN;
  END;
  DEC(edG.BStackCurrDepth);
  edG.Block := edG.BStack[edG.BStackCurrDepth];
  IF (edG.Block.Owner = NIL)
  OR (edG.Block.ENum >= edG.Block.Owner.numberOfLines) THEN
    edG.Block.Owner := NIL;
    edG.Block.SNum := -1;
    edG.Block.ENum := -1;
  ELSE
    DisplayBlock(On);
  END;
END dPopMark;


PROCEDURE dSwapMark*;
VAR
  i: INTEGER;
  tmp: edG.BlockMark;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  dPushMark;
  IF edG.Rc >= edE.abortLevel THEN RETURN; END;
  i := edG.BStackCurrDepth - 2;
  IF i >= 0 THEN
    tmp := edG.BStack[i];
    edG.BStack[i] := edG.BStack[i+1];
    edG.BStack[i+1] := tmp;
  END;
  dPopMark;
END dSwapMark;


PROCEDURE dPurgeMark*;
BEGIN
  edG.BStackCurrDepth := 0;
END dPurgeMark;


BEGIN
  edG.Block.SNum := -1; edG.Block.ENum := -1;
  edG.BStackCurrDepth := 0;
END EdBlocks.