turbo2.pas

Turbo Pascal 6.0编译器源码

  if (ExecDialog('StartupOptionsDialog', @StartupOptions) <> cmCancel) and
     (MessageBox(sStartupOptions, nil, mfWarning + mfOkCancel) <> cmCancel) then
  begin
    Written := False;
    H := FOpen(TurboExe, 2);
    if H >= 0 then
    begin
      if (FRead(H, Header, SizeOf(Header)) = 10) and (Header[0] = $5A4D) then
      begin
        FSeek(H, Longint(DSeg + Header[4] - PrefixSeg - 16) * 16 +
          Ofs(StartupOptions), 0);
        if FWrite(H, StartupOptions, SizeOf(StartupOptions)) =
          SizeOf(StartupOptions) then
          Written := True;
      end;
      FClose(H);
    end;
    if not Written then
      MessageBox(sErrorUpdatingTurboExe, nil, mfError + mfOkButton);
  end;
end;

procedure UserScreen;
begin
  SwapScreen(scUser, False);
  WaitEvent;
  SwapScreen(scTurbo, False);
end;

procedure WindowList;
var
  W, Data: PView;
  I: Word;
begin
  W := LoadWindow('WindowList');
  Data := nil;
  if W <> nil then
  begin
    W^.SetData(Data);
    I := Application^.ExecView(W);
    if I <> cmCancel then
    begin
      W^.GetData(Data);
      if Data <> nil then
        Data^.Select;
    end;
  end;
end;

procedure FindWindow(S: TResourceName; I: Word);
var
  W: pwindow;
  R: trect;
begin
  W := Message(Desktop, evDebugger, I, nil);
  if W = nil then
  begin
    W := LoadWindow(S);
    if W = nil then
      Exit;
    if W^.Flags and wfPutOnBottom <> 0 then
    begin
      W^.GetExtent(R);
      R.Move(0, Desktop^.Size.Y - R.B.Y);
      W^.Locate(R);
    end;
    W^.Number := GetFreeWNum;
    if W <> nil then
      Desktop^.Insert(W);
  end else
  begin
    W^.Owner^.Show;
    W^.Owner^.Select;
  end;
end;

procedure FindHelpWindow(I: Word);
var
  P: PWindow;
  R: TRect;
begin
  P := Message(Desktop, evDebugger, cmFindHelpWindow, nil);
  if P = nil then
  begin
    P := LoadWindow('HelpWindow');
    if P = nil then
      Exit;
    P^.Number := GetFreeWNum;
    Message(P, evCommand, I, nil);
    if P <> nil then
      Desktop^.Insert(P);
  end else
  begin
    Message(P, evCommand, I, nil);
    P^.Owner^.Show;
    P^.Owner^.Select;
  end;
end;

procedure UpdateMode;
begin
  if GetMode <> ScreenMode then
    SetMode(ScreenMode);
  Application^.Redraw;
end;

procedure WatchAdd(Edit: Boolean);
var
  W: PWindow;
  Viewer: PWatchViewer;
  S: TWatchString;
  P: PString;
  I: Word;
begin
  Viewer := Message(Desktop, evDebugger, cmFindWatchWindow, nil);
  S := '';
  if (Viewer <> nil) and ((Viewer^.State and sfActive <> 0) or Edit) then
    Viewer^.Get(S)
  else
    S := GetEditWord(80, @WordChars);
  if Edit then
    I := ExecDialog('EditWatchDialog', @S)
  else
    I := ExecDialog('AddWatchDialog', @S);
  if I <> cmCancel then
  begin
    P := NewStr(S);
    if LowMemory then
    begin
      DisposeStr(P);
      OutOfMemory;
      Exit
    end;
    if Viewer = nil then
    begin
      W := LoadWindow('WatchWindow');
      W^.Number := GetFreeWNum;
      Desktop^.Insert(W);
      Viewer := Message(Desktop, evDebugger, cmFindWatchWindow, nil);
    end;
    if Edit then
      Viewer^.Remove;
    Viewer^.Add(P);
  end;
end;

procedure WatchRemove(All: Boolean);
var
  Viewer: PWatchViewer;
begin
  Viewer := Message(Desktop, evDebugger, cmFindWatchWindow, nil);
  if Viewer <> nil then
    if All then
      Viewer^.RemoveAll
    else
      Viewer^.Remove;
end;

function ChangeMenu(I: Integer; Param: string): Boolean;
var
  P: PString;
begin
  P := NewStr(Param);
  if LowMemory then
  begin
    Dispose(P);
    OutOfMemory;
    ChangeMenu := False;
    Exit
  end;
  MenuBar^.ChangeParam(I, P);
  ChangeMenu := True;
end;

function UpdateDestination: Boolean;
begin
  UpdateDestination := ChangeMenu(cmDestination,
    Strings^.Get((CompParams.Flags and cfDisk) + sDestinationBase));
end;

procedure DestinationItem;
var
  P: Pointer;
begin
  CompParams.Flags:=CompParams.Flags xor cfDisk;
  if not UpdateDestination then
    CompParams.Flags := CompParams.Flags xor cfDisk;
end;

function UpdatePrimaryFile: Boolean;
var
  S: PathStr;
begin
  S := MainFile;
  ConvertPath(S, 15);
  UpdatePrimaryFile := ChangeMenu(cmPrimaryFile, S);
end;

procedure MainFileDialog;
var
  S: PathStr;
  I: Word;
begin
  S := MainFile;
  ConvertPath(MainFile, 79);
  I := ExecDialog('MainFileDialog', @MainFile);
  if I = cmFileClear then
    MainFile := '';
  if (I <> cmCancel) and not UpdatePrimaryFile then
    MainFile := S;
end;

procedure SaveOptionsDialog;
var
  I: Word;
begin
  if ConfigFile = '' then
    ConfigFile := Strings^.Get(sConfigFileName);
  FExpand(ConfigFile, ConfigFile);
  ConvertPath(ConfigFile, 80);
  I := ExecDialog('SaveOptionsDialog', @ConfigFile);
  case I of
    cmOk:
      begin
        SaveConfig;
        SaveDesktop
      end;
    cmFileClear:
      ConfigFile := '';
  end;
end;

procedure RetrieveOptionsDialog;
var
  I: Word;
  L: array[0..0] of Longint;
  SaveConfigFile: PathStr;
begin
  SaveConfigFile := ConfigFile;
  if ConfigFile = '' then
    ConfigFile := Strings^.Get(sConfigFileName);
  FExpand(ConfigFile, ConfigFile);
  ConvertPath(ConfigFile, 80);
  I := ExecDialog('RetrieveOptionsDialog', @ConfigFile);
  if I = cmOk then
  begin
    if FileExists(ConfigFile) then
    begin
      if RetrieveConfig then
      begin
        RetrieveDesktop;
        UpdateDestination;
        UpdatePrimaryFile;
      end;
    end else
    begin
      L[0] := Longint(@ConfigFile);
      MessageBox(sFileNotFound, @L, mfError + mfOkButton);
      ConfigFile := SaveConfigFile;
    end;
  end;
end;

procedure OpenFileDialog(S: PathStr);
var
  I: Word;
begin
  I := ExecDialog('OpenFileDialog', @S);
  if I <> cmCancel then
    CreateEditor(S, I = cmFileReplace, False);
end;

procedure NewFile;
var
  I: Word;
  S: PathStr;
const
  Pattern: string[12] = 'NONAMEXX.PAS';
begin
  I := 0;
  FExpand(Pattern, S);
  repeat
    S[Length(S)-5] := Chr(I div 10 + Ord('0'));
    S[Length(S)-4] := Chr(I mod 10 + Ord('0'));
    Inc(I);
  until (I >= 100) or (FindFile(S) = nil);
  CreateEditor(S, False, False);
end;

function CreateSwapFile: PStream;
var
  C: Char;
  S: string[1];
  L: array[0..2] of Longint;
  Clock: Longint absolute $40:$6C;
begin
  S := '';
  if StartupOptions.SwapDirectory <> '' then
  begin
    C := StartupOptions.SwapDirectory[Length(StartupOptions.SwapDirectory)];
    if (C <> '\') and (C <> ':') then
      S := '\';
  end;
  L[0] := Longint(@StartupOptions.SwapDirectory);
  L[1] := Longint(@S);
  L[2] := Clock;
  FormatStr(TempFile, '%s%sTP%06x.$$$', L);
  FExpand(TempFile, TempFile);
  CreateSwapFile := New(PDosStream, Init(TempFile, stCreate));
end;

procedure ColorDialog;
begin
  if ExecDialog('ColorDialog', Application^.GetPalette) <> cmCancel then
  begin
    DoneMemory;
    Message(Desktop, evConfig, cmUpdateColors, nil);
    Application^.Redraw;
  end;
end;

constructor TTurboBase.Init;
var
  NoConfig, NoDesktop: Boolean;
  I: Integer;
  S: PStream;
  Param: PathStr;
  Event: TEvent;
  R: TRect;
  W: PEditWindow;
  E: PEditView;
{$IFNDEF SINGLEEXE}
  ResName: PathStr;
{$ENDIF}
begin
  InitMemory;
  SaveMem;
  InitVSwap;
  InitVideoIO;
  RegisterAllTypes;
  RegisterType(RStringList);
  TurboExe := ParStr(0);
  if TurboExe = '' then
    TurboExe := FSearch('TURBO.EXE', GetEnv('PATH'));
  FExpand(TurboExe, TurboExe);
{$IFDEF SINGLEEXE}
  S := New(PBufStream, Init(TurboExe, stOpen, 1024));
{$ELSE}
  ResName := 'TURBO.TVR';
  SearchSysDir(ResName);
  S := New(PBufStream, Init(ResName, stOpen, 1024));
{$ENDIF}
  if S^.Status <> stOk then
    RunError(254);
  Resource.Init(S);
  if EmsHandle <> 0 then
  begin
    S := New(PEmsStream, Init($C000, $C000));
    if S^.Status = stOk then
    begin
      EmsResourceStream := PEmsStream(S);
      S := Resource.SwitchTo(S, False);
      if Resource.Stream^.Status <> stOk then
        RunError(209);
      Resource.Modified := False;
    end;
    Dispose(S, Done);
  end;
  Strings := PStringList(Resource.Get('Strings'));
  InitVMem(EditorHeapOrg, EditorHeapSize shr 8);
  if EmsHandle <> 0 then
  begin
    S := New(PEmsStream, Init($4000, $2000000));
    if S^.Status <> stOk then
      Dispose(S,Done)
    else
    begin
      EmsEditorStream := PEmsStream(S);
      AddStream(S, $FFFF);
    end;
  end;
  S := CreateSwapFile;
  if S^.Status <> stOk then
  begin
    Dispose(S, Done);
    StartupOptions.SwapDirectory := '';
    S := CreateSwapFile;
    if S^.Status <> stOk then
      RunError(255);
  end;
  AddStream(S, $FFFF);
  ShowTurboScreen;
  InitEvents;
  InitSysError;
  InitHistory;
  InitHelp;
  PositionalEvents := PositionalEvents or evRightClick;
  TProgram.Init;
  Dispose(Resource.Get('CommandTable'), Done);
  DisableCommands(EditCommands2 + HelpCommands + [cmError]);
  CallInitCompiler;
  Desktop^.GetExtent(R);
  W := New(PEditWindow, Init(R, nil, wnNoNumber));
  W^.Flags := W^.Flags and not wfSaveable;
  W^.Hide;
  Desktop^.Insert(W);
  NoConfig := not RetrieveConfig;
  NoDesktop := not RetrieveDesktop;
  NoConfig := NoDesktop and NoConfig;
  SetEgaLInes(Preferences.ScreenSize <> 0);
  MinWinSize.Y := 5;
  MinWinSize.X := 20;
  UpdateDestination;
  UpdatePrimaryFile;
  for I := 1 to ParCount do
  begin
    Param := ParStr(I);
    if (Param[1] <> '-') and (Param[1] <> '/') then
    begin
      NoConfig := False;
      NoDesktop := False;
      if Param[Length(Param)] = '\' then
        Param := Param + '*.PAS';
      ChangeExt(Param, '.PAS', False);
      if (Pos('?', Param) = 0) and (Pos('*', Param) = 0) then
      begin
        FExpand(Param, Param);
        E := FindEditor(@Param);
        if E <> nil then
          E^.Owner^.Select
        else
          CreateEditor(Param, False, False);
      end else
        OpenFileDialog(Param);
    end;
  end;
  if NoDesktop then
    NewFile;
  if NoConfig then
  begin
    Event.What := evCommand;
    Event.Command := cmAbout;
    PutEvent(Event);
  end;
end;

destructor TTurboBase.Done;
begin
  ResetAll;
  if ErrorAddr = nil then
    AutoSave;
  TProgram.Done;
  DoneSysError;
  DoneEvents;
  ShowUserScreen;
  DoneVMem;
  FDelete(TempFile);
  Resource.Done;
  DoneVideoIO;
  DoneVSwap;
  RestoreMem;
end;

procedure TTurboBase.InitDesktop;
var
  R: TRect;
begin
  GetExtent(R);
  Inc(R.A.Y);
  Dec(R.B.Y);
  Desktop := New(PTurboDestkop,Init(R));
end;

procedure TTurboBase.InitMenuBar;
begin
  MenuBar := PTurboMenuBar(Resource.Get('FullMenuBar'));
end;

procedure TTurboBase.InitScreen;
begin
  TProgram.InitScreen;
  if not SnowCheck then
    CheckSnow := False;
  if LcdScreen then
    AppPalette := apBlackWhite;
end;

procedure TTurboBase.InitStatusLine;
var
  R: TRect;
begin
  StatusLine := PTurboStatusLine(Resource.Get('StatusLine'));
  GetExtent(R);
  R.A.Y := R.B.Y - 1;
  StatusLine^.Locate(R);
end;

procedure TTurboDesktop.TileError;
begin
  MessageBox(sTileError, nil, mfError + mfOkButton);
end;

end.