turbo1.pas

Turbo Pascal 6.0编译器源码

unit Turbo1;

{$O+,F+,S-,X+}

interface

uses Turbo2, Drivers, App, Views;

type

  TTurbo = object(TTurboBase)
    constructor Init;
    destructor Done;virtual;
    procedure GetEvent(var Event: TEvent); virtual;
    function  GetPalette: PPalette; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure Idle; virtual;
  end;

implementation

uses Objects, Dialogs, TDos, TVars, CompVars, Compiler, Tracer, Editor,
  Utils, Config, TWindows, BptDlg, StrNames;

function AutoMake: Boolean;
var
  S: PathStr;
begin
  AutoMake := True;
  if (ProgramStatus = psCompiled) or (ProgramStatus = psTerminated) then
  begin
    GetCompileName(S);
    if (SourceModified <> 0) or (S <> PrimaryFileStr) then
      ResetAll;
  end;
  if ProgramStatus = psNoProgram then
  begin
    CallCompiler(cfBuild + cfMake, False);
    if CompResult.ErrorNum <> 0 then
      AutoMake := False;
  end;
end;

procedure DoTrace(Action: Integer);
var
  T: TSrcPoint;
  P: PString;
begin
  if (ProgramStatus = psRunning) and (SourceModified = 1) then
    case MessageBox(sSourceModified, nil, mfInformation + mfYesNoCancel) of
      cmYes:
        ResetTracer;
      cmNo:
        Inc(SourceModified);
      cmCancel:
        Exit;
    end;
  if AutoMake then
  begin
    ProgErrorAddr := nil;
    if ProgramStatus = psCompiled then
      AutoSave;
    Trace(Action);
    if ProgErrorAddr <> nil then
    begin
      Longint(T) := FindError(ProgErrorAddr);
      if T.Fn <> 0 then
        P := GetSourceName(T.Fn)
      else
        P := nil;
      SetError(P, 0, T.Ln, ProgErrorCode, sRuntimeErrorBase, nil);
    end;
  end;
end;

procedure FindErrorDialog;
begin
  if (ExecDialog('FindErrorDialog', @ProgErrorAddr) <> cmCancel) and
    AutoMake then
    ShowFile(FindError(ProgErrorAddr), sErrorAddressNotFound);
end;

constructor TTurbo.Init;
var
  R: TRect;
begin
  TTurboBase.Init;
end;

destructor TTurbo.Done;
begin
  TTurboBase.Done;
end;

procedure TTurbo.GetEvent(var Event: TEvent);
var
  I: Word;
  P: PView;
const
  Helping: Boolean = False;
begin
  TTurboBase.GetEvent(Event);
  case Event.What of
    evCommand:
      if (Event.Command = cmHelp) and not Helping and (TopView <> @self) then
      begin
        Helping := True;
        P := LoadWindow('HelpDialog');
        if P <> nil then
        begin
          ExecView(P);
          Dispose(P, Done);
      end;
      ClearEvent(Event);
      Helping := False;
    end;
    evMouseDown:
      if Event.Buttons = mbRightButton then
        Event.What := evRightClick;
  end;
end;

function TTurbo.GetPalette: PPalette;
begin
  GetPalette := @ColorTable[AppPalette];
end;

procedure TTurbo.HandleEvent(var Event: TEvent);
var
  R: TRect;
  I: Word;
begin
  if ErrorShown and
    (Event.What and (evMouseDown + evKeyDown + evCommand) <> 0) then
  begin
    ClearError;
    if (Event.What = evCommand) and (Event.Command = cmHelp) then
      Event.Command := cmHelpOnError;
  end;
  TTurboBase.HandleEvent(Event);
  if Event.What=evCommand then
  begin
    case Event.Command of
      cmOpen:
        OpenFileDialog('*.PAS');
      cmNew:
        NewFile;
      cmChangeDir:
        begin
          ExecDialog('ChDirDialog', nil);
          Message(Desktop, evEditor, cmDirChanged, nil);
        end;
      cmGetInfo:
        GetInfoDialog;
      cmDosShell:
        ShellToDos;
      cmFindProcedure:
        FindProcDialog;
      cmFindError:
        FindErrorDialog;
      cmRun:
        DoTrace(acRun);
      cmProgramReset:
        ResetTracer;
      cmGotoCursor:
        DoTrace(acGotoCursor);
      cmTraceInto:
        DoTrace(acTraceInto);
      cmStepOver:
        DoTrace(acStepOver);
      cmParameters:
        ExecDialog('ParamsDialog', @CommandLine);
      cmEvaluate:
        ExecDialog('EvalDialog', nil);
      cmCallStackWindow:
        FindWindow('CallStackWindow', cmFindCallStackWindow);
      cmAddWatch:
        WatchAdd(False);
      cmEditWatch:
        WatchAdd(True);
      cmDeleteWatch:
        WatchRemove(False);
      cmRemoveAllWatches:
        WatchRemove(True);
      cmBreakpoints:
        ExecDialog('BreakPtDialog', nil);
      cmCompilerOptions:
        CompilerOptionsDialog;
      cmMemorySizes:
        MemorySizesDialog;
      cmLinkerOptions:
        LinkerDialog;
      cmDebuggerOptions:
        DebuggingDialog;
      cmDirectories:
        ExecDialog('DirectoriesDialog', @Dirs);
      cmError:
        ExecDialog('Not_Implemented', nil);
      cmCompile:
        CallCompiler(0, True);
      cmMake:
        CallCompiler(cfBuild + cfMake, True);
      cmBuild:
        CallCompiler(cfBuild, True);
      cmSaveOptions:
        SaveOptionsDialog;
      cmRetrieveOptions:
        RetrieveOptionsDialog;
      cmPreferences:
        PreferencesDialog;
      cmEditorOptions:
        EditorOptionsDialog;
      cmMouseOptions:
        MouseOptionsDialog;
      cmStartupOptions:
        StartupOptionsDialog;
      cmUserScreen:
        UserScreen;
      cmWatchWindow:
        FindWindow('WatchWindow', cmFindWatchWindow);
      cmRegisterWindow:
        FindWindow('CPUWindow', cmFindCpuWindow);
      cmOutputWindow:
        FindWindow('OutputWindow', cmFindOutputWindow);
      cmAbout:
        ExecDialog('AboutDialog', nil);
      cmWindowList:
        WindowList;
      cmShowClipboard:
        begin
          if Clipboard^.Owner^.State and sfVisible = 0 then
          begin
            PWindow(Clipboard^.Owner)^.Number := GetFreeWNum;
            Clipboard^.Owner^.Show;
          end;
          Clipboard^.Owner^.Select;
        end;
      cmTile, cmCascade:
        begin
          I := Event.Command;
          Desktop^.GetExtent(R);
          Event.What := evBroadcast;
          Event.Command := cmFindBottomLimit;
          Event.InfoInt := R.B.Y;
          Desktop^.HandleEvent(Event);
          R.B.Y := Event.InfoInt;
          if I = cmCascade then
            Desktop^.Cascade(R)
          else
            Desktop^.Tile(R);
        end;
      cmRefreshDisplay:
        UpdateMode;
      cmShowBreakpoint:
        ShowBpt(Event.InfoInt);
      cmHelp, cmHelpContents, cmHelpIndex, cmTopicSearch, cmPreviousTopic,
        cmHelpOnHelp, cmHelpOnError:
        FindHelpWindow(Event.Command);
      cmSaveAll:
        begin
          Event.What := evEditor;
          PutEvent(Event);
        end;
      cmDestination:
        DestinationItem;
      cmClearDesktop:
        ClearDesktop;
      cmLastError:
        ShowError;
      cmPrimaryFile:
        mainFileDialog;
      cmColors:
        ColorDialog;
    else
      Exit;
    end;
    ClearEvent(Event);
  end;
end;

procedure TTurbo.Idle;
begin
  TTurboBase.Idle;
  if EditCount <> 0 then
    EnableCommands([cmTile, cmCascade, cmSaveAll])
  else
    DisableCommands([cmTile, cmCascade, cmSaveAll]);
  if (MainFile <> '') or (EditCount <> 0) then
    EnableCommands([cmFindError, cmRun, cmTraceInto, cmStepOver, cmMake, cmBuild])
  else
    DisableCommands([cmFindError, cmRun, cmTraceInto, cmStepOver, cmMake, cmBuild]);
  if ProgramStatus = psRunning then
    EnableCommands([cmProgramReset, cmViewSource])
  else
    DisableCommands([cmProgramReset, cmViewSource]);
  if (ProgramStatus = psRunning) or (ProgramStatus = psTerminated) then
    EnableCommands([cmFindProcedure])
  else
    DisableCommands([cmFindProcedure]);
end;

end.