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

:Program.    EdBlocks.mod
:Contents.   Routines for Block-Handling for AmokEd
:Author.     Hartmut Goebel
:Language.   Oberon
:Translator. Oberon Compiler V1.17.1
: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.       07 Jul 1991 18:37:49

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

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
  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 RETURN; END;
  txt := NIL;
  IF edG.Block.Owner#edG.Text THEN
    txt := edG.Text;
    edD.SwitchEdit(edG.Block.Owner);
  END;
  start := 0;
  IF start < edG.Block.SNum-edG.Text.topLine 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;
BEGIN
  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.TextRedisplay;
  IF txt#NIL THEN edD.SwitchEdit(txt); END;
END RedrawBlockOwner;


PROCEDURE doUnblock*;
BEGIN
  DisplayBlock(Off);
END doUnblock;


PROCEDURE doBlock*;
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 doBlock;


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
  NumDelLines: LONGINT;
BEGIN
  INCL(edG.Block.Owner.status,edG.modified);
  IF (edG.Block.Owner.line>=edG.Block.SNum)
  AND (edG.Block.Owner.line<=edG.Block.ENum) THEN
    edG.Block.Owner.actLinePtr := edG.Block.mark.tail.next(edG.Line);
  END;
  edL.FreeLines(edG.Block.Owner.lineList,edG.Block.mark.head,edG.Block.mark.tail);
  NumDelLines := edG.Block.ENum-edG.Block.SNum+1;
  DEC(edG.Block.Owner.numberOfLines,NumDelLines);
  IF edG.Block.Owner.line>edG.Block.SNum THEN
    IF edG.Block.Owner.line <= edG.Block.ENum THEN
      edG.Block.Owner.line := edG.Block.SNum;
    ELSE
      DEC(edG.Block.Owner.line,NumDelLines);
    END;
  END;
  IF edG.Block.Owner.actLinePtr=NIL THEN
    edG.Block.Owner.actLinePtr := edG.Block.Owner.lineList.tail;
  END;
END RemBlock;


PROCEDURE CopyBlock;
VAR
  Line, NewLine: edG.LinePtr;
  NumMovedLines: LONGINT;
  List: lst.List;
BEGIN
  INCL(edG.Text.status,edG.modified);
  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.cmdFailed; RETURN;
    END;
    IF Line = edG.Block.mark.tail THEN EXIT; END;
    Line := Line.next(edG.Line);
  END;
  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 doBDelete*;
BEGIN
  IF NOT BlockSpecified() THEN RETURN; END;
  edD.PutBackLine;
  RemBlock;
  IF edG.Text.lineList.head=NIL THEN
    edL.NewLine(edG.Text.actLinePtr,edG.ChunkSize); END;
  edD.TextLoad;
  RedrawBlockOwner;
END doBDelete;


PROCEDURE doBCopy*;
BEGIN
  IF NOT BlockSpecified() OR NOT NoMoveIntoBlock() THEN
    RETURN; END;
  edD.PutBackLine;
  CopyBlock;
  edD.TextLoad;
  edD.TextRedisplay; (* TextSync macht eh' keines *)
END doBCopy;


PROCEDURE doBMove*;
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.TextRedisplay; END;
END doBMove;


PROCEDURE HoldBlockLines*(Decrement: BOOLEAN);
VAR
  i: INTEGER;
BEGIN
  IF edG.Text.ExtPingPong # NIL THEN
    i := 0;
    REPEAT
      IF 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;
      END;
      INC(i);
    UNTIL i = eAD.NumExtPingPong;
  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
          doUnblock;
          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 doBSource*;
VAR
  ThisLine, EndLine: edG.LinePtr;
  Buffer: edG.StringPtr;
BEGIN
  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 doBSource;

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


PROCEDURE doPushMark*;
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 doPushMark;


PROCEDURE doPopMark*;
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 doPopMark;


PROCEDURE doSwapMark*;
VAR
  i: INTEGER;
  tmp: edG.BlockMark;
BEGIN
  doPushMark;
  IF edG.Rc = edE.cmdFailed 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;
  doPopMark;
END doSwapMark;


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


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