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

Pascal/Delphi Source File | 1987-12-21 | 24.9 KB | 852 lines

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

{$I msdirect.inc}

unit MsSet;
  {-Get and save default settings}

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,                   {Pointer primitives}
  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 edit, error report, help}
  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}
  MsFile;                    {File I/O routines}


procedure EdToggleWordWrap;
  {-Change state of word wrap}

procedure EdToggleFixedTabs;
  {-Process fixed tab toggle command}

procedure EdToggleJustify;
  {-Process justification toggle command}

procedure EdToggleCompressWrap;
  {-Process CompressWrap toggle command}

procedure EdTogglePaginate;
  {-Toggle display/computation of page numbers}

procedure EdSetUndoLimit;
  {-Prompt for and set the global undo limit}

procedure EdGetDefaultExtension;
  {-Get a new default file extension}

procedure EdSetColors;
  {-Customize editor colors}

procedure EdToggleInitZoomState;
  {-Toggle default zoom state}

procedure EdToggleRetraceMode;
  {-Toggle snow control}

procedure EdToggleSolidCursor;
  {-Toggle block cursor}

procedure EdToggleEga43Line;
  {-Toggle 43 line display mode}

procedure EdToggleTabLine;
  {-Toggle display of tab lines}

procedure EdSetLeftMargin;
  {-Set up a new left margin}

procedure EdSetRightMargin;
  {-Set up a new right margin}

procedure EdSetTabSize;
  {-Prompt for and set a new default tab size}

procedure EdSetSupportPath;
  {-Define the path or drive for all the editor support files}

procedure EdSetTopMargin;
  {-Prompt for and set the top margin of the current window}

procedure EdSetBotMargin;
  {-Prompt for and set the bottom margin of the current window}

procedure EdSetPageLength;
  {-Prompt for and save the page length of the current window}

procedure EdSaveDefaults;
  {-Write the current default settings to disk}

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

implementation

var
  WhichColorItem : Integer;  {Last selection on color installation menu}

  procedure EdToggleWordWrap;
    {-Change state of word wrap}

  begin                      {EdToggleWordWrap}
    with Curwin^ do begin
      WW := not WW;
      {Turning wrap off turns justify off}
      if not(WW) then
        JU := False;
    end;
  end;                       {EdToggleWordWrap}

  procedure EdToggleFixedTabs;
    {-Process fixed tab toggle command}

  begin                      {EdToggleFixedTabs}
    with Curwin^ do begin
      FT := not(FT);
      {Turning fixed tabs off turns tab display off}
      if not(FT) then begin
        TL := False;
        EdSetTextNo(Curwin);
      end;
    end;
  end;                       {EdToggleFixedTabs}

  procedure EdToggleJustify;
    {-Process justification toggle command}

  begin                      {EdToggleJustify}
    with Curwin^ do begin
      JU := not(JU);
      {Turning justify on forces word wrap and compresswrap on}
      if JU then begin
        WW := True;
        CW := True;
      end;
    end;
  end;                       {EdToggleJustify}

  procedure EdToggleCompressWrap;
    {-Process CompressWrap toggle command}

  begin                      {EdToggleCompressWrap}
    with Curwin^ do begin
      CW := not(CW);
      {Turning compresswrap off forces justify off}
      if not(CW) then
        JU := False;
    end;
  end;                       {EdToggleCompressWrap}

  procedure EdTogglePaginate;
    {-Toggle display/computation of page numbers}

  begin                      {EdTogglePaginate}
    with Curwin^ do begin
      PA := not(PA);
      {Set screen display offsets to show page markers}
      if PA then begin
        Leftcol := 2;
        PaginationDone := False;
        EdSetPtrNil(PageLine);
      end else
        Leftcol := 0;
    end;
  end;                       {EdTogglePaginate}

  procedure EdSetUndoLimit;
    {-Prompt for and set the global undo limit}
  var
    Empty : Boolean;

  begin                      {EdSetUndoLimit}
    EdSetNumber(UndoLimit, 361, 0, MaxInt, Empty);
    if Abortcmd or Goterror or Empty then
      Exit;
    SaveUndoLimit := UndoLimit;
  end;                       {EdSetUndoLimit}

  procedure EdGetDefaultExtension;
    {-Get a new default file extension}
  var
    DefExt : string[4];
    Done : Boolean;

  begin                      {EdGetDefaultExtension}
    repeat
      Done := True;
      DefExt := DefExtension;
      EdAskfor(EdGetMessage(377), 10, 20, 6, DefExt);
      if not(Abortcmd) then
        {Do some error checking}
        if EdHasWildCards(DefExt) then begin
          EdErrormsg(49);
          Done := False;
        end else begin
          {Remove leading period, if any}
          if (Length(DefExt) > 0) and (DefExt[1] = Period) then
            Delete(DefExt, 1, 1);
          {Remove blanks, and characters trailing blanks}
          EdDeleteLeadingBlanks(DefExt);
          EdDeleteTrailers(DefExt);
          {Uppercase}
          EdUpcase(DefExt);
          DefExtension := DefExt;
        end;
    until Done;
  end;                       {EdGetDefaultExtension}

  procedure EdSetColors;
    {-Customize editor colors}
  const
    MaxChoices = 16;
    Xmin = 5;
    Ymin = 7;
    Xmax = 26;
    ColorCmdSet : Charset =  {Characters to choose from color setup menus}
    [^J, ^M, ^[ , ^S, ^D, ^E, ^X];

  type
    ColorArray = array[1..16] of Byte;

  var
    Wmenu : WindowRec;
    Quitting, Changed : Boolean;
    Colors : ^ColorArray;
    SaveColor, Ncolor : Byte;

    procedure EdWriteEntry(W : WindowRec; I : Integer; Selected : Boolean);
      {-Write one color entry}
    var
      S : VarString;

      function EdPadEntry(F : VarString; Width : Byte; Selected : Boolean) : VarString;
        {-custom pad the string with blanks}
      const
        SelectChar : string[1] = #16;
      var
        S : VarString;

      begin                  {EdPadEntry}
        FillChar(S[1], Width, Blank);
        S[0] := Chr(Width);
        Move(F[2], S[3], Pred(Length(F)));
        if Selected then
          Move(SelectChar[1], S[1], 1);
        EdPadEntry := S;
      end;                   {EdPadEntry}

    begin                    {EdWriteEntry}
      with W do begin
        S := EdPadEntry(EdGetMessage(405+I), XSize-2, Selected);
        EdFastWrite(S[1], YPosn+I, Succ(XPosn), Ncolor);
        EdFastWrite(Copy(S, 2, DefNoCols), YPosn+I, XPosn+2, Colors^[I]);
      end;
    end;                     {EdWriteEntry}

    procedure EdDrawAllChoices(W : WindowRec; SelectNum : Integer);
      {-Draw all of the color choices}
    var
      I : Integer;

    begin                    {EdDrawAllChoices}
      for I := 1 to MaxChoices do
        EdWriteEntry(W, I, (I = SelectNum));
    end;                     {EdDrawAllChoices}

    procedure EdChooseColor(Wmenu : WindowRec; I : Integer; var Color : Byte);
      {-Interactively choose from menu of colors}
    const
      Xmin = 31;
      Ymin = 10;
      SelectStr = #15;
      ShowStr = #7;
      DefStr = #254;
    var
      F, B, Fdef, Bdef : Byte;
      Wcolor : WindowRec;
      Ch : Char;

      procedure EdWriteColored(W : WindowRec; F, B : Byte; S : VarString);
        {-write a string in color}

      begin                  {EdWriteColored}
        with W do
          EdFastWrite(S, Succ(YPosn+B), Succ(XPosn+F), (F and $F) or (B shl 4));
      end;                   {EdWriteColored}

      procedure EdDrawColorMap(Wcolor : WindowRec);
        {-Draw the matrix of available colors}
      var
        F, B : Byte;

      begin                  {EdDrawColorMap}
        for F := 0 to 15 do
          for B := 0 to 7 do
            EdWriteColored(Wcolor, F, B, ShowStr);
      end;                   {EdDrawColorMap}

    begin                    {EdChooseColor}

      {Save screen and put up window}
      EdSaveTextWindow(Border, EdGetMessage(374), Xmin, Ymin, Xmin+17, Ymin+9, Wcolor);

      {Save the default position}
      Fdef := Color and $F;
      Bdef := Color shr 4;
      F := Fdef;
      B := Bdef;

      {Draw the default color map}
      EdDrawColorMap(Wcolor);

      EdWritePromptLine(EdGetMessage(376));

      {Allow moving around}
      repeat

        {Pass back the new color}
        Color := F or (B shl 4);
        {Update the other menu}
        EdWriteEntry(Wmenu, I, True);
        {Update the color matrix}
        EdWriteColored(Wcolor, F, B, SelectStr);

        {Get a cursor command}
        Ch := EdGetCursorCommand(ColorCmdSet);

        {Rewrite the old cursor position}
        if (F = Fdef) and (B = Bdef) then
          EdWriteColored(Wcolor, F, B, DefStr)
        else
          EdWriteColored(Wcolor, F, B, ShowStr);

        case Ch of
          ^J :               {Help}
            EdHelpWindow(CmdSetColors);

          ^E :               {Cursor up}
            if B > 0 then
              Dec(B)
            else
              B := 7;

          ^X :               {Cursor down}
            if B < 7 then
              Inc(B)
            else
              B := 0;

          ^S :               {Cursor left}
            if F > 0 then
              Dec(F)
            else
              F := 15;

          ^D :               {Cursor right}
            if F < 15 then
              Inc(F)
            else
              F := 0;

          ^[ :               {Return to default and escape}
            begin
              Color := Fdef or (Bdef shl 4);
              {Update the other menu}
              EdWriteEntry(Wmenu, I, True);
              Ch := ^M;
            end;

        end;

      until Abortcmd or (Ch = ^M);

      EdRestoreTextWindow(Wcolor);
    end;                     {EdChooseColor}


  begin                      {EdSetColors}

    {Put up a menu of selections}
    EdSaveTextWindow(Border, EdGetMessage(362), Xmin, Ymin, Xmax, Succ(Ymin+MaxChoices), Wmenu);
    EdSetCursor(CursorOff);
    EdEraseMenuHelp;
    EdWritePromptLine(EdGetMessage(375));

    Colors := Addr(ScreenAttr);
    Ncolor := ScreenAttr[MnColor];
    EdDrawAllChoices(Wmenu, WhichColorItem);

    {Select until done}
    Quitting := False;
    Changed := False;

    repeat

      EdWriteEntry(Wmenu, WhichColorItem, True);

      case EdGetCursorCommand(ColorCmdSet) of

        ^J :                 {Help}
          EdHelpWindow(CmdSetColors);

        ^M :                 {Select}
          begin
            SaveColor := Colors^[WhichColorItem];
            EdChooseColor(Wmenu, WhichColorItem, Colors^[WhichColorItem]);
            if Colors^[WhichColorItem] <> SaveColor then
              Changed := True;
            EdWritePromptLine(EdGetMessage(375));
          end;

        ^[ :                 {Escape}
          Quitting := True;

        ^E :                 {Scroll up}
          begin
            EdWriteEntry(Wmenu, WhichColorItem, False);
            if WhichColorItem > 1 then
              Dec(WhichColorItem)
            else
              WhichColorItem := MaxChoices;
          end;

        ^X :                 {Scroll down}
          begin
            EdWriteEntry(Wmenu, WhichColorItem, False);
            if WhichColorItem < MaxChoices then
              Inc(WhichColorItem)
            else
              WhichColorItem := 1;
          end;

      end;
    until Abortcmd or Quitting;

    {Rebuild the attribute table for combined fonts}
    EdBuildFontAttribute(FontAttribute);

    {Store the attribute used for control characters}
    CtrlAttr := ScreenAttr[BlockColor];

    {Attributes used to draw boxes}
    TextAttr[NormalBox] := ScreenAttr[MnColor];
    TextAttr[ErrorBox] := ScreenAttr[CursorColor];
    FrameAttr[NormalBox] := ScreenAttr[MfColor];
    FrameAttr[ErrorBox] := ScreenAttr[CursorColor];

    {Restore the screen}
    EdShowMenuHelp;
    EdRestoreTextWindow(Wmenu);

    {Update all of the screen colors if any changed}
    if Changed and EdPtrNotNil(CurrMenu) then begin
      EdEraseMenus;
      if WindowCount > 0 then begin
        Intrflag := NoInterr;
        EdUpdateScreen;
      end;
      {Back into menu system}
      ExitMenu := True;
      EdUserPush(MenuPrime+'O');
    end;
  end;                       {EdSetColors}

  procedure EdToggleInitZoomState;
    {-Toggle default zoom state}

  begin                      {EdToggleInitZoomState}
    SaveInitZoomState := not(SaveInitZoomState);
    if SaveInitZoomState then begin
      {Make sure zoom is currently active}
      if not(Zoomed) then
        EdZoomWindow(False);
    end else if WindowCount <= 1 then
      {Turn off zoom}
      Zoomed := False;
  end;                       {EdToggleInitZoomState}

  procedure EdToggleRetraceMode;
    {-Toggle snow control}

  begin                      {EdToggleRetraceMode}
    GoodColorCard := not(GoodColorCard);
    RetraceMode := InitRetracemode and not(GoodColorCard);
  end;                       {EdToggleRetraceMode}

  procedure EdToggleSolidCursor;
    {-Toggle block cursor}

  begin                      {EdToggleSolidCursor}
    SolidCursor := not(SolidCursor);
    if SolidCursor then
      {Avoid display of phantom solid cursor upon exit}
      CurScrRow := 2;
  end;                       {EdToggleSolidCursor}

  procedure EdToggleEga43Line;
    {-Toggle 43 line display mode}
  var
    W : Pwindesc;
    LastTop : Integer;
    Rezoom : Boolean;

  begin                      {EdToggleEga43Line}
    if EgaPresent then begin
      Ega43lineMode := not(Ega43lineMode);
      if Ega43lineMode then begin
        EdSetEga43LineMode;
        if Zoomed then begin
          {Give the screen space to the visible window}
          Curwin^.Lastlineno := PhyScrRows;
          if Curwin = Window1^.Backlink then
            {Correct the stored info regarding the zoom}
            ZoomWin.Lastlineno := PhyScrRows;
        end;
        {Give the extra screen space to the bottom window}
        Window1^.Backlink^.Lastlineno := PhyScrRows;
      end else begin
        EdSetEga25lineMode;
        {Move up any windows that are off bottom of screen}
        Rezoom := Zoomed;
        if Rezoom then
          {Toggle zoom off}
          EdZoomWindow(False);
        W := Window1;
        LastTop := Succ(PhyscrRows);
        repeat
          {Work backwards from bottom window}
          EdBackPtr(W);
          with W^ do begin
            Lastlineno := Pred(LastTop);
            if Firstlineno+MinWindowLines > Lastlineno then begin
              Firstlineno := Lastlineno-MinWindowLines;
              EdSetTextNo(W);
            end;
            LastTop := Firstlineno;
            EdBackupCurline(W);
          end;
        until W = Window1;
        if Rezoom then
          {toggle zoom back on}
          EdZoomWindow(False);
      end;

      {Redraw screen and menus if on}
      if WindowCount > 0 then
        EdUpdateScreen
      else
        ClrScr;
      if EdPtrNotNil(CurrMenu) then
        EdDrawMenu(RootMenu);

    end else
      EdErrormsg(71);
  end;                       {EdToggleEga43Line}

  procedure EdToggleTabLine;
    {-Toggle display of tab lines}

  begin                      {EdToggleTabLine}
    with Curwin^ do begin
      TL := not(TL);
      {Force fixed tabs on}
      if TL then
        FT := True;
    end;
    EdSetTextNo(Curwin);
    EdRealignOne(Curwin);
  end;                       {EdToggleTabLine}

  procedure EdSetLeftMargin;
    {-Set up a new left margin}
  var
    Empty : Boolean;

  begin                      {EdSetLeftMargin}
    with Curwin^ do begin
      EdEraseMenuHelp;
      EdWritePromptLine(EdGetMessage(256));
      EdSetNumber(Lmargin, 344, 1, Pred(Rmargin), Empty);
      if Abortcmd or Goterror then
        Exit;
      if Empty and (Colno < Rmargin) then
        Lmargin := Colno;
      EdResetTempMargin(Curwin, True);
    end;
  end;                       {EdSetLeftMargin}

  procedure EdSetRightMargin;
    {-Set up a new right margin}
  var
    Empty : Boolean;

  begin                      {EdSetRightMargin}
    with Curwin^ do begin
      EdEraseMenuHelp;
      EdWritePromptLine(EdGetMessage(256));
      EdSetNumber(Rmargin, 340, Succ(Lmargin), Maxlinelength, Empty);
      if Abortcmd or Goterror then
        Exit;
      if Empty and (Colno > Lmargin) then
        Rmargin := Colno;
      {Reset temp margin if invalidated by the change in right margin}
      if Wmargin >= Pred(Rmargin) then
        EdResetTempMargin(Curwin, True);
    end;
  end;                       {EdSetRightMargin}

  procedure EdSetTabSize;
    {-Prompt for and set a new default tab size}
  var
    Empty : Boolean;

  begin                      {EdSetTabSize}
    EdSetNumber(SaveTabSize, 356, 1, 100, Empty);
  end;                       {EdSetTabSize}

  procedure EdSetSupportPath;
    {-Define the path or drive for all the editor support files}
  var
    NewPath : Filepath;

  begin                      {EdSetSupportPath}
    EdEraseMenuHelp;
    EdWritePromptLine('');
    NewPath := SupportPath;
    EdAskfor(EdGetMessage(317), 5, 20, 66, NewPath);
    if Abortcmd then
      Exit;
    if not(EdStringEmpty(NewPath)) then begin
      EdCleanFileName(NewPath);
      {Use popup window when appropriate to allow browsing directory}
      NewPath := EdPickdir(NewPath, 304, Directory, True);
      if Abortcmd then
        Exit;
    end;
    {Update the path that we use to find files}
    SupportPath := NewPath;
    if not(EdStringEmpty(SupportPath)) then
      SupportPath := EdAddTrailingBackslash(SupportPath);
    {SaveSupportPath is stored in the installation area and displayed on the menu}
    SaveSupportPath := SupportPath;
  end;                       {EdSetSupportPath}

  procedure EdSetTopMargin;
    {-Prompt for and set the top margin of the current window}
  var
    Empty : Boolean;

  begin                      {EdSetTopMargin}
    with Curwin^ do
      EdSetNumber(Tmargin, 358, 0, Pred(PageLen-Bmargin), Empty);
    if Abortcmd or Goterror or Empty then
      Exit;
    EdResetPageLine(Curwin);
  end;                       {EdSetTopMargin}

  procedure EdSetBotMargin;
    {-Prompt for and set the bottom margin of the current window}
  var
    Empty : Boolean;

  begin                      {EdSetBotMargin}
    with Curwin^ do
      EdSetNumber(Bmargin, 359, 0, Pred(PageLen-Tmargin), Empty);
    if Abortcmd or Goterror or Empty then
      Exit;
    EdResetPageLine(Curwin);
  end;                       {EdSetBotMargin}

  procedure EdSetPageLength;
    {-Prompt for and save the page length of the current window}
  var
    Empty : Boolean;

  begin                      {EdSetPageLength}
    with Curwin^ do
      EdSetNumber(PageLen, 360, Succ(Tmargin+Bmargin), (PrintStackSize-MaxHeaderChars) shr 1, Empty);
    if Abortcmd or Goterror or Empty then
      Exit;
    EdResetPageLine(Curwin);
  end;                       {EdSetPageLength}

  procedure EdSaveDefaults;
    {-Write the current default settings to disk}
  var
    Found : Boolean;
    Fname : Filepath;
    Ch : Char;

    function EdClone(Fname : Filepath; var Head, Tail) : Boolean;
      {-Clone installation area into the executable file, returning true if successful}
    label
      ExitPoint;
    const
      MaxBufSize = 32256;    {63 sectors * 512 bytes}
    type
      BufferType = array[0..MaxBufSize] of Byte;
    var
      Buflen : Word;
      Buffer : ^BufferType;  {Read buffer}
      Data : array[0..256] of Byte absolute Head; {Mask for start of installation area}
      Source : string[255] absolute Head; {Mask for Installation ID string}
      SearchLen : Byte;
      I, Actual, Amount : Word;
      Fpos : LongInt;
      F : file;

    begin                    {EdClone}

      {Get the largest available buffer to work in}
      if EdMemAvail(513, FreeListTemp) then begin
        Fpos := MaxAvail;
        if Fpos > MaxBufSize then
          Buflen := MaxBufSize
        else
          {Choose a multiple of 512 within the available space}
          Buflen := (Word(Fpos) shr 9) shl 9;
        GetMem(Buffer, Succ(Buflen));
        EdClone := True;
      end else
        EdClone := False;

      {Open the program file, previously determined to exist}
      Assign(F, Fname);
      Reset(F, 1);

      {Seek to the approximate start of the data segment}
      Fpos := 16*(DSeg-PrefixSeg-$10);
      Seek(F, Fpos);
      if EdINT24Result <> 0 then begin
        EdClone := False;
        goto ExitPoint;
      end;

      {Read the first buffer}
      EdBlockRead(F, Buffer^[1], Buflen, Actual);
      if Goterror then begin
        EdClone := False;
        goto ExitPoint;
      end;
      Inc(Fpos, Actual);
      SearchLen := Pred(Length(Source));

      {Search for ID string in the buffer, returning position or zero}
      I := EdLongPosFwd(Buffer^, 1, Actual, Source);

      {Keep searching throughout the file}
      while (I = 0) and (Actual >= Length(Source)) do begin
        {Save the tail end of the buffer into the next buffer}
        Move(Buffer^[Succ(Actual-SearchLen)], Buffer^[1], SearchLen);
        {Read the next part of the file}
        EdBlockRead(F, Buffer^[Length(Source)], Buflen-SearchLen, Actual);
        if Goterror then begin
          {File read error}
          EdClone := False;
          goto ExitPoint;
        end;
        Inc(Fpos, Actual);
        Actual := Actual+SearchLen;
        {Search for ID string in the buffer, returning position or zero}
        I := EdLongPosFwd(Buffer^, 1, Actual, Source);
      end;

      if I <> 0 then begin
        {Position file pointer to start of default area}
        Seek(F, Fpos+I+SearchLen-Actual);
        {Write the RAM default area to disk}
        Amount := Ofs(Tail)-Ofs(Data[Succ(Length(Source))]);
        EdBlockWrite(F, Data[Succ(Length(Source))], Amount);
        if Goterror then
          {Write error}
          EdClone := False;
      end else begin
        {ID string not found}
        EdErrormsg(240);
        EdClone := False;
      end;

ExitPoint:
      Close(F);
      FreeMem(Buffer, Succ(Buflen));

    end;                     {EdClone}

  begin                      {EdSaveDefaults}

    {Find the program file}
    Fname := ProgName+Period+ExeExt;

    {Check the current directory first}
    Found := EdExistFile(Fname);
    if not(Found) then begin
      {Try the installed directory next}
      Fname := SupportPath+Fname;
      Found := EdExistFile(Fname);
    end;

    if Found then begin

      {Update the RAM defaults area from the current window}
      with Curwin^ do begin
        SaveInsertMode := Insertflag;
        SaveIndentMode := AI;
        SaveWWmode := WW;
        SaveTabMode := TL;
        SaveJustMode := JU;
        SavePageMode := PA;
        SaveAttrMode := AT;
        SaveFTmode := FT;
        SaveCompressWrap := CW;
        SaveLeftMargin := Lmargin;
        SaveRightMargin := Rmargin;
        SaveTopMargin := Tmargin;
        SaveBottomMargin := Bmargin;
        SavePageLen := PageLen;
      end;
      SaveUndoLimit := UndoLimit;

      with PrintJob do begin
        SaveDeviceName := Devicename;
        SavePrinterPort := Printer;
        SaveOutputName := OutFilename;
        SaveToFile := ToFile;
      end;

      if InitRetracemode then
        ColorAttr := ScreenAttr
      else
        MonoAttr := ScreenAttr;

      {Write the RAM defaults to the program file}
      EdWait;
      if EdClone(Fname, MainIDstring, LastMainDefault) then
        if EdClone(Fname, ScreenIDstring, LastScreenDefault) then
          {Success message}
          EdDisplayPromptWindow(EdGetMessage(401)+Fname+' -'+EdGetMessage(305),
                                EdYcenterWindow(2), [#27], Ch, NormalBox);

    end else
      EdErrormsg(39);
  end;                       {EdSaveDefaults}

begin
  WhichColorItem := 1;
end.