Liren Large Software Subsidy 16/16.iso/w/w048/2.ddi/MSSRC.ARC/MSTEXT.PAS

Pascal/Delphi Source File | 1987-12-21 | 46.7 KB | 1,661 lines

{                            MSTEXT.PAS
                               MS 4.0
                Copyright (c) 1985, 87 by Borland International, Inc.         }

{$I msdirect.inc}

unit MsText;
  {-Text processing commands}

interface

uses
  Crt,                       {Basic video operations - standard unit}
  Dos,                       {DOS interface - standard unit}
  Errors,                    {Runtime error handler}
  MsVars,                    {Global types and declarations}
  MsScrn1,                   {Fast screen writing routines}
  MsString,                  {String primitives}
  MsPtrOp,                   {Primitive pointer operations}
  EscSeq,                    {Returns text string for extended scan codes}
  MsCmds,                    {Maps keystrokes to commands}
  Int24,                     {DOS critical error handler}
  Message,                   {Message system}
  MsUser,                    {User keyboard input, line editing and error reporting}
  MsMemOp,                   {Text buffer allocation and deallocation}
  MsBack,                    {Background processes}
  MsScrn2,                   {Editor screen updating}
  MsMenu,                    {Pulldown and custom menu system}
  MsDir,                     {Popup directory picker}
  MsEdit;                    {Basic editing commands}

procedure EdPromptGotoCol;
  {-Process goto col #n command}

procedure EdPromptGotoLine;
  {-Process goto line #n command}

procedure EdPromptGotoPage;
  {-Prompt for and go to page}

procedure EdShowMemory;
  {-Show free memory for text}

procedure EdSetMarker(M : Byte);
  {-Process set text marker command}

procedure EdChangeCase(Mode : CaseChange);
  {-Change case of current character or block}

procedure EdNextSentence;
  {-Advance cursor to start of next sentence}

procedure EdPrevSentence;
  {-Move cursor to start of sentence}

procedure EdInsertPrintFormat(Ch : Char);
  {-Insert print font toggles surrounding current cursor or marked block}

procedure EdReformParagraph;
  {-Reformat the current paragraph}

procedure EdReformBlock;
  {-Reformat marked block}

procedure EdDeleteLineNoRecourse;
  {-Process delete line command without pushing to undo stack}

procedure EdSysInfo;
  {-display editor information}

procedure EdSizeWindow;
  {-Interactively size the current window}

procedure EdWhatFont;
  {-Display the font type of the character at the cursor}

procedure EdPromptGotoWindow;
  {-Prompt for a window and go to it}

procedure EdPromptJumpMarker;
  {-Use a menu to choose and jump to a text marker}

procedure EdPromptSetMarker;
  {-Use a menu to choose and set a text marker}

procedure EdChooseAppending(var Choice : Integer);
  {-Use a menu to choose between append and overwrite}

procedure EdHelpMenu;
  {-Use a menu to select and display a help section}

procedure EdInsertUndoBuffer;
  {-Insert the entire undo buffer prior to the current line of text}

procedure EdFlushUndo;
  {-Delete the contents of the undo buffer}

procedure EdJumpLastPosition;
  {-Move the cursor to its previous position}

procedure EdMoveToBegin;
  {-Move cursor to prior line with equal indentation to current line}

procedure EdMoveToEnd;
  {-Move cursor to following line with equal indent to current line}

  {==========================================================================}

implementation

type
  SentencePosType = (InBlank, InSentence, AtStartofSentence, AtEndofSentence);

  {$L MSTEXT}

  function EdWordsInBuffer(var Buffer; Len : Integer) : Integer; external;
  {-Fast word count for a single line, alphas=['a'..'z','A'..'Z','-',apostrophe]}

  procedure EdPromptGotoCol;
    {-Prompt for and go to column}
  var
    Cno : Integer;

  begin                      {EdPromptGotoCol}
    Cno := EdGetnumber(EdGetMessage(311), Curwin^.Colno);
    if (Cno > 0) and (Cno <= Maxlinelength) then begin
      EdGotoColumn(Cno);
      ExitMenu := True;
    end;
  end;                       {EdPromptGotoCol}

  procedure EdPromptGotoLine;
    {-Prompt for and go to line}
  var
    Lno : Integer;

  begin                      {EdPromptGotoLine}
    {Assure line count is up to date for current window}
    Intrflag := NoInterr;
    EdGenLineOne(Curwin);
    Intrflag := Interr;
    Lno := EdGetnumber(EdGetMessage(312), Curwin^.Clineno);
    if Lno > 0 then begin
      EdGotoLine(Lno);
      ExitMenu := True;
    end;
  end;                       {EdPromptGotoLine}

  procedure EdPromptGotoPage;
    {-Prompt for and go to page}
  var
    Pnum : Integer;

  begin                      {EdPromptGotoPage}
    if Curwin^.PA then begin
      Pnum := EdGetnumber(EdGetMessage(357), EdGetPageNum(Curwin^.Curline));
      if Pnum < 1 then
        Pnum := 1
      else if Pnum > MaxPage then
        Pnum := MaxPage;
      EdGotoPage(Pnum);
      ExitMenu := True;
    end else
      EdErrormsg(40);
  end;                       {EdPromptGotoPage}

  procedure EdShowMemory;
    {-Show free memory for text}
  var
    Ch : Char;

  begin                      {EdShowMemory}
    EdDisplayPromptWindow(
                          EdCalcMemory+'-'+EdGetMessage(305), EdYcenterWindow(3), [#27], Ch, NormalBox);
  end;                       {EdShowMemory}

  procedure EdSetMarker(M : Byte);
    {-Process set text marker command}

  begin                      {EdSetMarker}
    if not(M in [0..MaxMarker]) then begin
      EdErrormsg(28);
      Exit;
    end;
    with Marker[M] do begin
      {Reset any previous version of mark}
      if EdPtrNotNil(Line) then
        EdClrFlag(Line, InMark);
      {Set new mark}
      with Curwin^ do begin
        if (Line = Curline) and (Col = Colno) then
          {Setting mark on current mark, clears mark}
          EdSetPtrNil(Line)
        else begin
          Line := Curline;
          Col := Colno;
        end;
      end;
    end;
    {Turn on mark display}
    Markhide := True;
    EdToggleTextMarker;
  end;                       {EdSetMarker}

  procedure EdChangeCase(Mode : CaseChange);
    {-Change case of current character or block}
  var
    P : PlineDesc;
    I, Cmin, Cmax : Integer;

    procedure EdChangeCaseOneChar(Line : PlineDesc; Col : Integer);
      {-Change case as requested by mode}
    var
      Ch : Char;

    begin                    {EdChangeCaseOneChar}
      if Col <= Line^.Bufflen then begin
        Ch := Line^.Txt^[Col];
        case Mode of
          ToUpper :
            if (Ch >= 'a') and (Ch <= 'z') then
              Ch := Chr(Ord(Ch)-32);
          ToLower :
            if (Ch >= 'A') and (Ch <= 'Z') then
              Ch := Chr(Ord(Ch)+32);
          Toggle :
            if (Ch >= 'A') and (Ch <= 'Z') then
              Ch := Chr(Ord(Ch)+32)
            else if (Ch >= 'a') and (Ch <= 'z') then
              Ch := Chr(Ord(Ch)-32);
        end;
        Line^.Txt^[Col] := Ch;
      end;
    end;                     {EdChangeCaseOneChar}

  begin                      {EdChangeCase}
    with Curwin^ do begin

      Modified := True;

      if EdNoBlock then
        EdChangeCaseOneChar(Curline, Colno)
      else if not(EdCursorInBlock(Curline, Colno, False)) then
        EdChangeCaseOneChar(Curline, Colno)
      else begin
        {A visible block is defined, change case throughout the block}
        P := Blockfrom.Line;
        Cmin := Blockfrom.Col;

        repeat
          if P = Blockto.Line then
            Cmax := Pred(Blockto.Col)
          else
            Cmax := P^.Bufflen;
          for I := Cmin to Cmax do
            EdChangeCaseOneChar(P, I);
          Cmin := 1;
          if P = Blockto.Line then
            EdSetPtrNil(P)
          else
            EdFwdPtr(P);
        until EdPtrIsNil(P);

      end;
    end;
  end;                       {EdChangeCase}

  procedure EdReformOneParagraph(BlockMode : Boolean);
    {-Reformat a single paragraph to fit within the right margin}
  label
    ExitPoint;
  var
    C, R, EffLen, Len, MinCol, Junk : Integer;
    SaveInsert : Boolean;

    function EdEmptyLine(P : PlineDesc; var Len : Integer) : Boolean;
      {-return true if line is empty or starts with a format char or ends the block}

    begin                    {EdEmptyLine}
      if EdPtrIsNil(P) then
        EdEmptyLine := True
      else begin
        Len := EdTextLength(P);
        EdEmptyLine := (Len = 0) or (P^.Txt^[1] = FormatChar) or (BlockMode and (P = Blockto.Line));
      end;
    end;                     {EdEmptyLine}

  begin                      {EdReformOneParagraph}

    with Curwin^ do begin

      {Check for empty line}
      if EdEmptyLine(Curline, Len) then begin
        EdDownLine;
        Colno := 1;
        Exit;
      end;

      {Force insert mode for this operation}
      SaveInsert := Insertflag;
      Insertflag := True;

      R := Rmargin;

      {Assure first line is within left margin}
      while (Colno < Lmargin) and (Curline^.Txt^[Colno] = Blank) do
        Inc(Colno);
      if Colno < Lmargin then begin
        if not(EdInsertSpace(Curline, Colno, Wmargin-Colno)) then
          Exit;
        Colno := Lmargin;
      end;

      {Reset pagination process}
      EdResetPageLine(Curwin);

      {Continue until a termination line is found}
      while not(EdEmptyLine(Curline, Len)) do begin

        if CW then begin
          {Remove excess blanks}
          Junk := 1;
          EdCompress(Curline, Wmargin, Junk, Len);
        end;
        EffLen := EdComputeEffectiveColNo(True, Curline, Len);

        {Pull up succeeding lines until this line fills margin}
        while (EffLen <= R) and EdPtrNotNil(Curline^.Fwdlink) and not(EdEmptyLine(Curline^.Fwdlink, Junk)) do begin
          Colno := Len+2;
          EdJoinline;
          if Goterror then
            goto ExitPoint;
          if CW then
            {Remove excess blanks}
            EdCompress(Curline, Wmargin, Junk, Len)
          else begin
            {Remove leading blanks}
            while Curline^.Txt^[Colno] = Blank do
              EdDeleteRightChar;
            Len := EdTextLength(Curline);
          end;
          EffLen := EdComputeEffectiveColNo(True, Curline, Len);
        end;

        {Break line to stay within margin}
        if EffLen > R then begin

          with Curline^ do begin
            C := Len;
            while EdComputeEffectiveColNo(True, Curline, C) > R do begin
              {Move left to previous blank}
              while (C > 0) and (Txt^[C] <> Blank) do
                Dec(C);
              {Move left to previous non-blank}
              while (C > 0) and (Txt^[C] = Blank) do
                Dec(C);
            end;
            {Right to blank}
            Inc(C);
            {Right to next non-blank}
            while (C < Len) and (Txt^[C] = Blank) do
              Inc(C);
          end;
          Colno := C;

          {Make sure a legal break point was found}
          if AI then
            MinCol := EdLineIndent(Curline)
          else
            MinCol := Wmargin;
          if EdComputeEffectiveColNo(True, Curline, Colno) <= MinCol then begin
            {Error, could not break line within margin}
            EdErrormsg(25);
            goto ExitPoint;
          end;

          {Break the line here}
          EdInsertLine;

          {Apply right justification}
          if JU then begin
            EdRightJustify(Curline, Wmargin, R);
            if Goterror then
              goto ExitPoint;
          end;

        end;

        if EdPtrNotNil(Curline^.Fwdlink) then begin
          {Move to next line}
          EdFwdPtr(Curline);
          Colno := Wmargin;
        end else begin
          {End of file, force exit}
          EdRightLine;
          goto ExitPoint;
        end;

      end;

ExitPoint:
      Insertflag := SaveInsert;
      EdRealign;

    end;
  end;                       {EdReformOneParagraph}

  procedure EdAdvance(var P : PlineDesc; var C, Len : Integer);
    {-Advance cursor to next column or line}

  begin                      {EdAdvance}
    if C <= Len then
      Inc(C)
    else if EdPtrNotNil(P^.Fwdlink) then begin
      EdFwdPtr(P);
      Len := EdTextLength(P);
      C := 1;
    end;
  end;                       {EdAdvance}

  function EdSentencePos(P : PlineDesc; C, Len : Integer) : SentencePosType;
    {-Return position in sentence}
  var
    Ch : Char;

  begin                      {EdSentencePos}
    if Len = 0 then begin
      if EdPtrIsNil(P^.Fwdlink) then
        EdSentencePos := AtStartofSentence
      else
        EdSentencePos := AtEndofSentence;
    end else if C > Len then begin
      if EdPtrIsNil(P^.Fwdlink) then
        EdSentencePos := AtStartofSentence
      else
        EdSentencePos := InBlank;
    end else begin
      Ch := P^.Txt^[C];
      if (Ch <= Blank) then
        EdSentencePos := InBlank
      else if (Ch in SentenceEnd) then
        EdSentencePos := AtEndofSentence
      else if ((C = 1) and (Ch = FormatChar)) then
        EdSentencePos := AtStartofSentence
      else
        EdSentencePos := InSentence;
    end;
  end;                       {EdSentencePos}

  procedure EdNextSentence;
    {-Advance cursor to start of next sentence}
  var
    SentencePos : SentencePosType;
    Len : Integer;

  begin                      {EdNextSentence}
    with Curwin^ do begin

      {Work within the current line buffer}
      EdMoveCursorIntoLine;

      {Advance to end of current sentence}
      Len := EdTextLength(Curline);
      repeat
        SentencePos := EdSentencePos(Curline, Colno, Len);
        if SentencePos <> AtEndofSentence then
          EdAdvance(Curline, Colno, Len);
      until (SentencePos <> InSentence) and (SentencePos <> InBlank);

      {Advance to start of next sentence}
      if SentencePos <> AtStartofSentence then
        repeat
          EdAdvance(Curline, Colno, Len);
          SentencePos := EdSentencePos(Curline, Colno, Len);
        until (SentencePos <> InBlank) and (SentencePos <> AtEndofSentence);

    end;
    EdRealignOne(Curwin);
  end;                       {EdNextSentence}

  procedure EdPrevSentence;
    {-Move cursor to start of sentence}
  var
    CurC, PrevC : Integer;
    CurL, PrevL : PlineDesc;
    SentencePos : SentencePosType;

    procedure EdRetreatToPrev;
      {-Retreat to end of previous sentence}
    var
      Len : Integer;

      procedure EdRetreat(var Top, P : PlineDesc; var C, Len : Integer);
        {-Regress cursor to previous column or line}

      begin                  {EdRetreat}
        if C > 1 then
          Dec(C)
        else if EdPtrNotNil(P^.Backlink) then begin
          if P = Top then begin
            EdBackPtr(Top);
            P := Top;
          end else
            EdBackPtr(P);
          Len := EdTextLength(P);
          C := Succ(Len);
        end;
      end;                   {EdRetreat}

      function EdSentencePosBack(P : PlineDesc; C, Len : Integer) : SentencePosType;
        {-Return position in sentence when moving backwards}
      var
        Ch : Char;

      begin                  {EdSentencePosBack}
        if Len = 0 then
          EdSentencePosBack := {InBlank} AtEndofSentence
        else if (C = 1) and EdPtrIsNil(P^.Backlink) then
          EdSentencePosBack := AtStartofSentence
        else begin
          Ch := P^.Txt^[C];
          if (Ch <= Blank) then
            EdSentencePosBack := InBlank
          else if (Ch in SentenceEnd) then
            EdSentencePosBack := AtEndofSentence
          else if ((C = 1) and (Ch = FormatChar)) then
            EdSentencePosBack := AtStartofSentence
          else
            EdSentencePosBack := InSentence;
        end;
      end;                   {EdSentencePosBack}

    begin                    {EdRetreatToPrev}
      with Curwin^ do begin
        Len := EdTextLength(Curline);
        repeat
          EdRetreat(TopLine, Curline, Colno, Len);
          SentencePos := EdSentencePosBack(Curline, Colno, Len);
        until (SentencePos <> InSentence) and (SentencePos <> InBlank);
      end;
    end;                     {EdRetreatToPrev}

    procedure EdAdvanceToNext;
      {-Advance cursor to start of next sentence}
    var
      Len : Integer;

    begin                    {EdAdvanceToNext}
      with Curwin^ do begin
        Len := EdTextLength(Curline);
        if SentencePos <> AtStartofSentence then
          repeat
            EdAdvance(Curline, Colno, Len);
            SentencePos := EdSentencePos(Curline, Colno, Len);
          until (SentencePos <> InBlank) and (SentencePos <> AtEndofSentence);
      end;
    end;                     {EdAdvancetoNext}

    function EdBeyond(P : PlineDesc; Pc : Integer; Q : PlineDesc; Qc : Integer) : Boolean;
      {-Return true when the marker p:pc is equal or beyond the marker q:qc in the text stream}

    begin                    {EdBeyond}
      if P = Q then
        EdBeyond := (Pc >= Qc)
      else begin
        {Scan back from p looking for q}
        repeat
          EdBackPtr(P);
          if P = Q then begin
            EdBeyond := True;
            Exit;
          end;
        until EdPtrIsNil(P);
        EdBeyond := False;
      end;
    end;                     {EdBeyond}

  begin                      {EdPrevSentence}
    with Curwin^ do begin

      {Get out if at beginning of file}
      if (Colno = 1) and EdPtrIsNil(Curline^.Backlink) then
        Exit;

      {Work within the current line buffer}
      EdMoveCursorIntoLine;

      {Store current position}
      CurL := Curline;
      CurC := Colno;
      PrevL := CurL;
      PrevC := CurC;

      while EdBeyond(Curline, Colno, CurL, CurC) do begin
        {Continue until solution prior to original cursor is found}
        Curline := PrevL;
        Colno := PrevC;

        {Go back another sentence}
        EdRetreatToPrev;

        {Store current position}
        PrevC := Colno;
        PrevL := Curline;

        if SentencePos <> AtStartofSentence then
          {Advance to start of next}
          EdAdvanceToNext;
      end;

    end;
    EdRealignOne(Curwin);
  end;                       {EdPrevSentence}

  procedure EdInsertPrintFormat(Ch : Char);
    {-Insert print font toggles surrounding current cursor or marked block}
  var
    C : BlockMarker;
    SaveInsertMode : Boolean;

    procedure EdUpdateVisibleAttributes;
      {-Assure line attribute flags are updated}
    var
      P : PlineDesc;
      L : Integer;

    begin                    {EdUpdateVisibleAttributes}
      with Curwin^ do begin
        {Get pointer to last text line visible in current window}
        P := TopLine;
        L := 1;
        while EdPtrNotNil(P) and (L <= Succ(Lastlineno-Firsttextno)) do begin
          EdFwdPtr(P);
          Inc(L);
        end;
      end;
      {Update font flags up to that point, without interruption}
      Intrflag := NoInterr;
      EdSetAttrOne(Curwin, P);
      Intrflag := Interr;
    end;                     {EdUpdateVisibleAttributes}

  begin                      {EdInsertPrintFormat}
    with Curwin^ do begin

      Modified := True;

      {Assure insert mode}
      SaveInsertMode := Insertflag;
      Insertflag := True;

      if EdNoBlock then begin
        {Insert a pair of toggles}
        EdProcesstext(Ch, False);
        EdProcesstext(Ch, False);
        {Note that attribute changed within line}
        EdChangeFlag(Curline, True, NewAttr);
        {Put cursor between the pair}
        EdLeftChar;
        {Assure line attribute flags are updated}
        EdUpdateVisibleAttributes;
      end else begin
        {Insert toggles surrounding marked block}
        with C do begin
          Line := Curline;
          Col := Colno;
        end;
        EdJumpMarker(Blockfrom);
        EdProcesstext(Ch, False);
        {Note that attribute changed within line}
        EdChangeFlag(Curline, True, NewAttr);
        EdJumpMarker(Blockto);
        EdProcesstext(Ch, False);
        {Note that attribute changed within line}
        EdChangeFlag(Curline, True, NewAttr);
        {Assure line attribute flags are updated}
        EdUpdateVisibleAttributes;
        {Turn off block marking so the font display is apparent}
        Blockhide := True;
        EdOffblock;
        {Return to original position}
        EdJumpMarker(C);
      end;

      Insertflag := SaveInsertMode;
    end;
  end;                       {EdInsertPrintFormat}

  procedure EdReformParagraph;
    {-Reformat the current paragraph}

  begin                      {EdReformParagraph}

    {Allow reformat only when Word Wrap mode is set}
    if not(Curwin^.WW) then begin
      EdErrormsg(60);
      Exit;
    end;

    EdReformOneParagraph(False);

  end;                       {EdReformParagraph}

  procedure EdReformBlock;
    {-Reformat marked block}

  begin                      {EdReformBlock}
    with Curwin^ do begin

      {Allow reformat only when Word Wrap mode is set}
      if not(WW) then begin
        EdErrormsg(60);
        Exit;
      end;

      {See if a contiguous, visible block is defined}
      if EdNoBlock then begin
        EdErrormsg(26);
        Exit;
      end;
      if not(EdCursorInBlock(Curline, Colno, False)) then begin
        EdErrormsg(59);
        Exit;
      end;

      {Can't reformat a single line block}
      if Blockfrom.Line = Blockto.Line then
        Exit;

      {Reformat entire marked block}
      EdWait;
      EdJumpMarker(Blockfrom);
      repeat
        EdReformOneParagraph(True);
      until Goterror or Abortcmd or (Curline = Blockto.Line);

    end;
  end;                       {EdReformBlock}

  procedure EdDeleteLineNoRecourse;
    {-Process delete line command without pushing to undo stack}

  begin                      {EdDeleteLineNoRecourse}
    UndoLimit := 0;
    EdDeleteLine;
    UndoLimit := SaveUndoLimit;
  end;                       {EdDeleteLineNoRecourse}

  procedure EdSysInfo;
    {-display editor information}
  label
    ExitPoint;
  const
    Items = 14;
  var
    W : WindowRec;
    Ch : Char;
    I : Byte;
    Value, Line, CurDir : VarString;
    JustMenu : Boolean;
    WrdCnt : LongInt;

    function EdDOSversion : VarString;
      {-Return the DOS version number, e.g., 3.1}
    var
      regs : registers;
      Major, Minor : string[3];

    begin                    {EdDOSversion}
      with regs do begin
        Ah := $30;
        intr($21, regs);
        Str(Al, Major);
        Str(Ah, Minor);
        EdDOSversion := Major+'.'+Minor;
      end;
    end;                     {EdDOSversion}

    function EdMax(I, J : Integer) : Integer;
      {-Return the maximum of two Words}

    begin                    {EdMax}
      if I > J then
        EdMax := I
      else
        EdMax := J;
    end;                     {EdMax}

    function EdDateTime : VarString;
      {-Return a formatted string containing date and time}
    var
      regs : registers;
      Date, Time : VarString;
      Year, Month, Day, Hour, Minute, Second, AmPm : string[4];

      function EdZeroPad(S : VarString) : VarString;
        {-Left pad string with zeros until length is at least 2}

      begin                  {EdZeroPad}
        while Length(S) < 2 do
          S := '0'+S;
        EdZeroPad := S;
      end;                   {EdZeroPad}

    begin                    {EdDateTime}
      with regs do begin
        Ah := $2a;
        intr($21, regs);
        EdClearString(Date);
        Str(dl, Day);
        Month := Copy(Months, Succ(3*Pred(Dh)), 3);
        Str(Cx, Year);
        Date := Month+Blank+Day+','+Blank+Year;
        Ah := $2C;
        intr($21, regs);
        Str(Dh, Second);
        Str(Cl, Minute);
        if Ch = 0 then begin
          Ch := 12;
          AmPm := 'AM';
        end else if Ch < 12 then
          AmPm := 'AM'
        else begin
          if Ch > 12 then
            Ch := Ch-12;
          AmPm := 'PM';
        end;
        Str(Ch, Hour);
        Time := Blank+Hour+':'+EdZeroPad(Minute)+':'+EdZeroPad(Second)+Blank+AmPm;
      end;
      EdDateTime := Time+'  '+Date;
    end;                     {EdDateTime}

    function EdGetWordCnt : LongInt;
      {-Return the number of words in the current window}
    var
      P : PlineDesc;
      Cnt : LongInt;

    begin                    {EdGetWordCnt}

      P := EdTopofStream(Curwin);
      Cnt := 00;

      while EdPtrNotNil(P) do begin

        if EdKeyInterrupt then
          Exit;

        with P^ do
          Cnt := Cnt+EdWordsInBuffer(Txt^[1], Bufflen);

        EdFwdPtr(P);
      end;
      EdGetWordCnt := Cnt;
    end;                     {EdGetWordCnt}

  begin                      {EdSysInfo}

    EdEraseMenuHelp;
    EdWritePromptLine(EdGetMessage(255));

    JustMenu := (WindowCount = 0);

    {Set up a window}
    GetDir(0, CurDir);
    I := 4+EdMax(Length(CurDir), Length(Curwin^.Filename));
    if I < 32 then
      I := 32;
    EdSaveTextWindow(Border, EdGetMessage(343)+Version+Blank, 24, 8, 24+I, 9+Items, W);

    {Write info to the window}
    with W, Curwin^ do
      for I := 1 to Items do begin

        EdClearString(Line);

        case I of

          1 :                {Current file message}
            Line := EdGetMessage(402);

          2 :                {Current filename}
            Line := Blank+Filename;

          3 :                {File modified status}
            if not(JustMenu) then
              if Modified then
                Line := EdGetMessage(398)
              else
                Line := EdGetMessage(399);

          4 :                {Line count}
            if not(JustMenu) then begin
              EdGenLineOne(Curwin);
              if not(EdKeyInterrupt) then begin
                Str(TlineNo, Value);
                if TlineNo = 1 then
                  Line := Blank+Value+EdGetMessage(252)
                else
                  Line := Blank+Value+EdGetMessage(400);
              end;
            end;

          5 :                {Byte count}
            if not(JustMenu) then
              if not(EdKeyInterrupt) then begin
                Str(TcharNo, Value);
                if TcharNo = 1 then
                  Line := Blank+Value+EdGetMessage(251)
                else
                  Line := Blank+Value+EdGetMessage(354);
              end;

          6 :                {Word count}
            if not(JustMenu) then begin
              WrdCnt := EdGetWordCnt;
              if not(EdKeyInterrupt) then begin
                Str(WrdCnt, Value);
                if WrdCnt = 01 then
                  Line := Blank+Value+EdGetMessage(253)
                else
                  Line := Blank+Value+EdGetMessage(254);
              end;
            end;

          7 :                {Page count}
            if not(JustMenu) then
              if PA then begin
                EdRepaginateOne(Curwin);
                if not(EdKeyInterrupt) then begin
                  Str(Tpageno, Value);
                  if Tpageno = 1 then
                    Line := Blank+Value+EdGetMessage(250)
                  else
                    Line := Blank+Value+EdGetMessage(397);
                end;
              end;

          8 :                {Blank line}
            ;

          9 :                {Date and time}
            Line := EdDateTime;

          10 :               {RAM bytes free}
            Line := EdCalcMemory;

          11 :               {DOS version}
            Line := EdGetMessage(352)+EdDOSversion;

          12 :               {Disk bytes free}
            begin
              Str(DiskFree(0), Value);
              Line := Blank+Value+EdGetMessage(336);
            end;

          13 :               {Current directory message}
            Line := EdGetMessage(335);

          14 :               {Current directory}
            Line := Blank+CurDir;

        end;
        EdFastWrite(Line, YPosn+I, XPosn+2, ScreenAttr[MnColor]);
      end;

ExitPoint:

    {Prompt for <Esc>}
    EdWritePromptLine(EdGetMessage(305));

    {Wait for an Escape}
    repeat
      Ch := EdGetAnyChar;
    until Abortcmd or (Ch = #27);

    {Restore the screen}
    EdRestoreTextWindow(W);
  end;                       {EdSysInfo}

  procedure EdSizeWindow;
    {-Interactively size the current window}
  type
    SizeCommands = (Bigger, Smaller, Accept, None);
  var
    CursorState, TopEdge, Done : Boolean;

    procedure EdGrowWindow(TopEdge : Boolean);
      {-Increase size of current window by one line}
    var
      W : Pwindesc;

    begin                    {EdGrowWindow}

      {Two or more windows previously guaranteed open}

      if TopEdge then begin
        {Bottom Window}
        {Add to top of window, taking it from previous window}
        W := Curwin^.Backlink;
        if (W^.Lastlineno-W^.Firsttextno) < MinWindowLines then
          Exit;
        Curwin^.Firstlineno := Pred(Curwin^.Firstlineno);
        W^.Lastlineno := Pred(W^.Lastlineno);
        EdSetTextNo(Curwin);
      end else begin
        {Top or middle window}
        {Add to bottom of window, taking it from next window}
        W := Curwin^.Fwdlink;
        {Make sure the other window can be shrunk}
        if (W^.Lastlineno-W^.Firsttextno) < MinWindowLines then
          Exit;
        Curwin^.Lastlineno := Succ(Curwin^.Lastlineno);
        W^.Firstlineno := Succ(W^.Firstlineno);
        EdSetTextNo(W);
      end;

      EdBackupCurline(W);
      UpdateScreen := True;

    end;                     {EdGrowWindow}

    procedure EdShrinkWindow(TopEdge : Boolean);
      {-Reduce the size of the current window}
    var
      W : Pwindesc;

    begin                    {EdShrinkWindow}

      {Two or more windows previously guaranteed open}

      {And that window is large enough to shrink}
      if (Curwin^.Lastlineno-Curwin^.Firsttextno) < MinWindowLines then
        Exit;

      if TopEdge then begin
        {Bottom Window}
        {Subtract from top of window, adding it from previous window}
        W := Curwin^.Backlink;
        Inc(Curwin^.Firstlineno);
        Inc(W^.Lastlineno);
        EdSetTextNo(Curwin);
      end else begin
        {Top or middle window}
        {Subtract from bottom of window, adding it to next window}
        W := Curwin^.Fwdlink;
        Curwin^.Lastlineno := Pred(Curwin^.Lastlineno);
        W^.Firstlineno := Pred(W^.Firstlineno);
        EdSetTextNo(W);
      end;
      EdBackupCurline(Curwin);
      UpdateScreen := True;
    end;                     {EdShrinkWindow}

    function EdGetCommand(TopEdge : Boolean) : SizeCommands;
      {-Get a window sizing command}
    var
      Ch : Char;

    begin                    {EdGetCommand}
      EdGetCommand := None;
      Ch := EdGetAnyChar;
      if Ch = Null then begin
        {Extended character, get the other half}
        Ch := EdGetAnyChar;
        case Ch of
          #72 :              {Up arrow}
            if TopEdge then
              EdGetCommand := Bigger
            else
              EdGetCommand := Smaller;
          #80 :              {Down arrow}
            if TopEdge then
              EdGetCommand := Smaller
            else
              EdGetCommand := Bigger;
        end;
      end else if (Ch = ^M) or (Ch = ^[) then
        EdGetCommand := Accept;
    end;                     {EdGetCommand}

  begin                      {EdSizeWindow}

    {Assure there are two windows or more}
    if Zoomed or (WindowCount <= 1) then begin
      EdErrormsg(56);
      Exit;
    end;

    {See whether top or bottom edge of window is changing}
    TopEdge := (Curwin^.Fwdlink = Window1);

    {Put up a prompt}
    EdZapPromptLine;
    EdAppPromptLine(EdGetMessage(355));
    {Avoid leaving the solid cursor in the wrong window}
    if SolidCursor then
      EdEraseSolidCursor;
    CursorState := SolidCursor;
    SolidCursor := False;
    UpdateScreen := True;

    {Loop until done}
    Done := False;
    repeat
      if UpdateScreen then begin
        {Force redraw of entire screen}
        Intrflag := NoInterr;
        EdUpdateScreen;
      end;
      case EdGetCommand(TopEdge) of
        Bigger :
          EdGrowWindow(TopEdge);
        Smaller :
          EdShrinkWindow(TopEdge);
        Accept :
          Done := True;
      end;
    until Done;

    SolidCursor := CursorState;
    UpdateScreen := True;

  end;                       {EdSizeWindow}

  procedure EdWhatFont;
    {-Display the font type of the character at the cursor}
  var
    FontByte : Byte;
    NextOff : Boolean;
    Col, Ipos : Integer;
    C, Clast : PrintCommandtype;
    S : VarString;

  begin                      {EdWhatFont}

    with Curwin^, Curline^ do begin

      if not(AT) then begin
        {The font bytes are accurate only when fonts are displayed}
        EdErrormsg(111);
        Exit;
      end;

      {Assure attributes are fully updated for current line}
      EdSetAttrOne(Curwin, Curline^.Fwdlink);
      if EdKeyInterrupt then
        Exit;

      {Analyze the line up to the cursor}
      FontByte := Font;
      if Colno > Bufflen then
        Col := Bufflen
      else
        Col := Colno;
      NextOff := False;
      for Ipos := 1 to Col do begin
        if NextOff then begin
          EdUpdateFont(Clast, FontByte);
          NextOff := False;
        end;
        C := PrintMap[Txt^[Ipos]];
        if C <> PrtNone then
          if (FontByte and (1 shl Ord(C))) <> 0 then begin
            {Toggle the bit after the next character}
            NextOff := True;
            Clast := C;
          end else
            {Toggle appropriate bit of font byte}
            EdUpdateFont(C, FontByte);
      end;
    end;

    {Build a string to display}
    EdClearString(S);
    for C := PrtBold to PrtAlt2 do
      if (FontByte and (1 shl Ord(C))) <> 0 then begin
        if not(EdStringEmpty(S)) then
          S := S+'+';
        S := S+EdGetMessage(414+Ord(C));
      end;
    if EdStringEmpty(S) then
      {Normal text}
      S := EdGetMessage(406);

    {Display string and wait for keypress}
    if EdPtrNotNil(CurrMenu) then
      {Erase menus}
      EdEraseMenus;
    EdWritePromptLine(S);
    EdUpdateCursor;
    EdWaitforKey;

  end;                       {EdWhatFont}

  procedure EdPromptGotoWindow;
    {-Prompt for a window and go to it}
  var
    Menu : CustomMenuRec;
    Choice : Integer;

    function EdBuildMessages(var Menu : CustomMenuRec) : Boolean;
      {-Build the message table for the menu}
    var
      Item : Integer;
      S : VarString;
      W : Pwindesc;

    begin                    {EdBuildMessages}
      EdBuildMessages := False;
      with Menu do begin

        if EdMemAvail(Succ(MaxChoice) shl 2, FreeListTemp) then
          {Get the pointers}
          GetMem(Messages, Succ(MaxChoice) shl 2)
        else
          Exit;

        {Get the string space and fill in the file names}
        W := Window1;
        Item := 0;
        repeat
          Inc(Item);
          Str(Item, S);
          S := S+Blank+W^.Filename;
          if EdMemAvail(Succ(Length(S)), FreeListTemp) then
            GetMem(Messages^[Item], Succ(Length(S)))
          else
            Exit;
          Messages^[Item]^ := S;
          EdFwdPtr(W);
        until W = Window1;

      end;
      EdBuildMessages := True;
    end;                     {EdBuildMessages}

  begin                      {EdPromptGotoWindow}

    if WindowCount <= 1 then begin
      EdErrormsg(56);
      Exit;
    end;

    {Initialize the menu}
    with Menu do begin
      Xmin := 17;
      Ymin := 8;
      MessageNum := 304;
      PromptNum := 313;
      MinChoice := 1;
      MaxChoice := WindowCount;
      InitChoice := 1;
      CmdSet := NumCmdSet;
      UseLetters := False;
    end;
    if not(EdBuildMessages(Menu)) then begin
      EdErrormsg(35);
      Exit;
    end;

    {Get the menu choice}
    EdGetCustomMenuChoice(Menu, Choice);

    {Go to the selected window}
    if not(Abortcmd) then begin
      EdWindowGoto(Choice);
      ExitMenu := True;
    end;

  end;                       {EdPromptGotoWindow}

  procedure EdPromptJumpMarker;
    {-Use a menu to choose and jump to a text marker}
  var
    Menu : CustomMenuRec;
    Choice : Integer;

    function EdBuildMessages(var Menu : CustomMenuRec) : Boolean;
      {-Build the message table for the menu}
    var
      Item, Lcount : Integer;
      S, Ss : VarString;
      W : Pwindesc;
      P : PlineDesc;

    begin                    {EdBuildMessages}
      EdBuildMessages := False;
      with Menu do begin

        if EdMemAvail(Succ(MaxChoice) shl 2, FreeListTemp) then
          {Get the pointers}
          GetMem(Messages, Succ(MaxChoice) shl 2)
        else
          Exit;

        {Get the string space and fill in the markers}
        for Item := MinChoice to MaxChoice do begin
          S := Blank+Chr(48+Item);
          if EdPtrIsNil(Marker[Item].Line) then
            S := S+EdGetMessage(382)
          else begin
            W := EdFindWindow(Marker[Item].Line);
            if EdPtrIsNil(W) then
              S := S+EdGetMessage(380)
            else begin
              {Display file and line number}
              S := S+Blank+EdEndOfPath(W^.Filename);
              Lcount := 0;
              P := Marker[Item].Line;
              while EdPtrNotNil(P) do begin
                Inc(Lcount);
                EdBackPtr(P);
              end;
              Str(Lcount, Ss);
              S := S+' : '+Ss;
            end;
          end;
          if EdMemAvail(Succ(Length(S)), FreeListTemp) then
            GetMem(Messages^[Item], Succ(Length(S)))
          else
            Exit;
          Messages^[Item]^ := S;
        end;
      end;
      EdBuildMessages := True;
    end;                     {EdBuildMessages}

  begin                      {EdPromptJumpMarker}

    {Initialize the menu}
    with Menu do begin
      Xmin := 24;
      Ymin := 11;
      MessageNum := 304;
      PromptNum := 381;
      MinChoice := 0;
      MaxChoice := MaxMarker;
      InitChoice := 0;
      CmdSet := NumCmdSet;
      UseLetters := False;
    end;
    if not(EdBuildMessages(Menu)) then begin
      EdErrormsg(35);
      Exit;
    end;

    {Get the menu choice}
    EdGetCustomMenuChoice(Menu, Choice);

    {Go to the selected window}
    if not(Abortcmd) then
      if EdPtrNotNil(Marker[Choice].Line) then
        EdJumpMarker(Marker[Choice]);

  end;                       {EdPromptJumpMarker}

  procedure EdPromptSetMarker;
    {-Use a menu to choose and set a text marker}
  var
    Menu : CustomMenuRec;
    Choice : Integer;

    function EdBuildMessages(var Menu : CustomMenuRec) : Boolean;
      {-Build the message table for the menu}
    var
      Item, Lcount : Integer;
      S, Ss : VarString;
      W : Pwindesc;
      P : PlineDesc;

    begin                    {EdBuildMessages}
      EdBuildMessages := False;
      with Menu do begin

        if EdMemAvail(Succ(MaxChoice) shl 2, FreeListTemp) then
          {Get the pointers}
          GetMem(Messages, Succ(MaxChoice) shl 2)
        else
          Exit;

        {Get the string space and fill in the markers}
        for Item := MinChoice to MaxChoice do begin
          S := Blank+Chr(48+Item);
          if EdPtrIsNil(Marker[Item].Line) then
            S := S+EdGetMessage(379)
          else begin
            W := EdFindWindow(Marker[Item].Line);
            if EdPtrIsNil(W) then
              S := S+EdGetMessage(380)
            else begin
              {Display file and line number}
              S := S+Blank+EdEndOfPath(W^.Filename);
              Lcount := 0;
              P := Marker[Item].Line;
              while EdPtrNotNil(P) do begin
                Inc(Lcount);
                EdBackPtr(P);
              end;
              Str(Lcount, Ss);
              S := S+' : '+Ss;
            end;
          end;
          if EdMemAvail(Succ(Length(S)), FreeListTemp) then
            GetMem(Messages^[Item], Succ(Length(S)))
          else
            Exit;
          Messages^[Item]^ := S;
        end;
      end;
      EdBuildMessages := True;
    end;                     {EdBuildMessages}

  begin                      {EdPromptSetMarker}

    {Initialize the menu}
    with Menu do begin
      Xmin := 10;
      Ymin := 11;
      MessageNum := 304;
      PromptNum := 381;
      MinChoice := 0;
      MaxChoice := MaxMarker;
      InitChoice := 0;
      CmdSet := NumCmdSet;
      UseLetters := False;
    end;
    if not(EdBuildMessages(Menu)) then begin
      EdErrormsg(35);
      Exit;
    end;

    {Get the menu choice}
    EdGetCustomMenuChoice(Menu, Choice);

    {Go to the selected window}
    if not(Abortcmd) then
      EdSetMarker(Choice);

  end;                       {EdPromptSetMarker}

  procedure EdChooseAppending(var Choice : Integer);
    {-Use a menu to choose between append and overwrite}
  var
    Menu : CustomMenuRec;

    function EdBuildMessages(var Menu : CustomMenuRec) : Boolean;
      {-Build the message table for the menu}
    var
      Item : Integer;
      S : VarString;

    begin                    {EdBuildMessages}
      EdBuildMessages := False;
      with Menu do begin
        if EdMemAvail(Succ(MaxChoice) shl 2, FreeListTemp) then
          {Get the pointers}
          GetMem(Messages, Succ(MaxChoice) shl 2)
        else
          Exit;

        {Get the string space and fill in the items}
        for Item := MinChoice to MaxChoice do begin
          S := EdGetMessage(370+Item);
          if EdMemAvail(Succ(Length(S)), FreeListTemp) then
            GetMem(Messages^[Item], Succ(Length(S)))
          else
            Exit;
          Messages^[Item]^ := S;
        end;
      end;
      EdBuildMessages := True;
    end;                     {EdBuildMessages}

  begin                      {EdChooseAppending}

    {Initialize the menu}
    with Menu do begin
      Xmin := 45;
      Ymin := 14;
      MessageNum := 304;
      PromptNum := 309;
      MinChoice := 1;
      MaxChoice := 2;
      InitChoice := 1;
      CmdSet := PrtCmdSet;
      UseLetters := True;
    end;
    if not(EdBuildMessages(Menu)) then begin
      EdErrormsg(35);
      Exit;
    end;

    {Get the menu choice}
    EdGetCustomMenuChoice(Menu, Choice);

    if Abortcmd then
      Choice := 0;

  end;                       {EdChooseAppending}

  procedure EdHelpMenu;
    {-Use a menu to select and display a help section}
  var
    Menu : CustomMenuRec;
    Choice : Integer;

    function EdBuildMessages(var Menu : CustomMenuRec) : Boolean;
      {-Build the message table for the menu}
    var
      Item : Integer;
      S : VarString;

    begin                    {EdBuildMessages}
      EdBuildMessages := False;
      with Menu do begin
        if EdMemAvail(Succ(MaxChoice) shl 2, FreeListTemp) then
          {Get the pointers}
          GetMem(Messages, Succ(MaxChoice) shl 2)
        else
          Exit;

        {Get the string space and fill in the items}
        for Item := MinChoice to MaxChoice do begin
          S := EdGetMessage(281+Item);
          if EdMemAvail(Succ(Length(S)), FreeListTemp) then
            {Get the pointers}
            GetMem(Messages^[Item], Succ(Length(S)))
          else
            Exit;
          Messages^[Item]^ := S;
        end;
      end;
      EdBuildMessages := True;
    end;                     {EdBuildMessages}

  begin                      {EdHelpMenu}

    if not(HelpAvailable) then begin
      EdErrormsg(64);
      Exit;
    end;

    {Initialize the menu}
    with Menu do begin
      Xmin := 36;
      Ymin := 7;
      MessageNum := 304;
      PromptNum := 324;
      MinChoice := 1;
      MaxChoice := 16;
      InitChoice := 1;
      CmdSet := PrtCmdSet;
      UseLetters := False;
    end;

    repeat

      if not(EdBuildMessages(Menu)) then begin
        EdErrormsg(35);
        Exit;
      end;

      {Get the menu choice}
      EdGetCustomMenuChoice(Menu, Choice);

      if not(Abortcmd) then begin
        EdHelpWindow(CommandType(Ord(CmdHelpMenu)+Choice));
        EdSetCursor(CursorOff);
      end;
    until Abortcmd;

  end;                       {EdHelpMenu}

  procedure EdInsertUndoBuffer;
    {-Insert the entire undo buffer prior to the current line of text}

  begin                      {EdInsertUndoBuffer}
    while UndoLimit*UndoCount > 0 do
      EdUndo;
  end;                       {EdInsertUndoBuffer}

  procedure EdFlushUndo;
    {-Delete the contents of the undo buffer}
  var
    P : PlineDesc;

  begin                      {EdFlushUndo}

    {If either Undolimit or Undocount = 0, we don't have anything to flush}
    if UndoLimit*UndoCount = 0 then
      Exit;

    while UndoCount > 0 do begin
      Dec(UndoCount);
      P := UndoStack;
      EdFwdPtr(UndoStack);
      if EdPtrIsNil(UndoStack) then
        EdSetPtrNil(UndoEnd);
      EdDesTextDesc(P);
    end;

  end;                       {EdFlushUndo}

  procedure EdJumpLastPosition;
    {-Move the cursor to its previous position}
  var
    W : Pwindesc;

  begin                      {EdJumpLastPosition}
    W := EdFindWindow(LastPosition.Line);
    if EdPtrIsNil(W) then
      {Last position was deleted}
      Exit;
    EdJumpMarker(LastPosition);
  end;                       {EdJumpLastPosition}

  procedure EdMoveToBegin;
    {-Move cursor to prior line with equal indentation to current line}
  var
    I : Integer;

  begin                      {EdMovetobegin}
    with Curwin^ do begin
      {Get out if we're already at top of file}
      if EdPtrIsNil(Curline^.Backlink) then
        Exit;
      {Get indent of current line}
      I := EdLineIndent(Curline);
      if I = 0 then
        Exit;
      {Move up to first prior line with equal indent}
      repeat
        EdUpLine;
      until EdPtrIsNil(Curline^.Backlink) or (EdLineIndent(Curline) = I);
      Colno := I;
    end;
  end;                       {EdMovetobegin}

  procedure EdMoveToEnd;
    {-Move cursor to following line with equal indent to current line}
  var
    I : Integer;

  begin                      {EdMovetoend}
    with Curwin^ do begin
      if EdPtrIsNil(Curline^.Fwdlink) then
        Exit;
      I := EdLineIndent(Curline);
      if I = 0 then
        Exit;
      repeat
        EdDownLine;
      until EdPtrIsNil(Curline^.Fwdlink) or (EdLineIndent(Curline) = I);
      Colno := I;
    end;
  end;                       {EdMovetoend}

end.