compform.pas

源代码

    UpdateCaption;
  end
  else
    SaveTo(FFilename);
  Memo.Modified := False;
  if not FOptions.UndoAfterSave then
    Memo.ClearUndo;
  Result := True;
  AddToMRUList(FFilename);
end;

function TCompileForm.ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
var
  FileTitle: String;
begin
  Result := True;
  if FCompiling then begin
    MsgBox('Please stop the compile process before performing this command.',
      SCompilerFormCaption, mbError, MB_OK);
    Result := False;
    Exit;
  end;
  if FDebugging and not AskToDetachDebugger then begin
    Result := False;
    Exit;
  end;
  if PromptToSave and Memo.Modified then begin
    FileTitle := FFilename;
    if FileTitle = '' then FileTitle := 'Untitled';
    case MsgBox('The text in the ' + FileTitle + ' file has changed.'#13#10#13#10 +
       'Do you want to save the changes?', SCompilerFormCaption, mbError,
       MB_YESNOCANCEL) of
      ID_YES: Result := SaveFile(False);
      ID_NO: ;
    else
      Result := False;
    end;
  end;
end;

procedure TCompileForm.ReadMRUList;
{ Loads the list of MRU items from the registry }
var
  Ini: TConfigIniFile;
  I: Integer;
  S: String;
begin
  try
    Ini := TConfigIniFile.Create;
    try
      FMRUList.Clear;
      for I := 0 to High(FMRUMenuItems) do begin
        S := Ini.ReadString('ScriptFileHistoryNew', 'History' + IntToStr(I), '');
        if S <> '' then FMRUList.Add(S);
      end;
    finally
      Ini.Free;
    end;
  except
    { Ignore any exceptions; don't want to hold up the display of the
      File menu. }
  end;
end;

procedure TCompileForm.AddToMRUList(const AFilename: String);
var
  I: Integer;
  Ini: TConfigIniFile;
  S: String;
begin
  try
    { Load most recent items first, just in case they've changed }
    ReadMRUList;

    I := 0;
    while I < FMRUList.Count do begin
      if PathCompare(FMRUList[I], AFilename) = 0 then
        FMRUList.Delete(I)
      else
        Inc(I);
    end;
    FMRUList.Insert(0, AFilename);
    while FMRUList.Count > High(FMRUMenuItems)+1 do
      FMRUList.Delete(FMRUList.Count-1);

    { Save new MRU items }
    Ini := TConfigIniFile.Create;
    try
      { MRU list }
      for I := 0 to High(FMRUMenuItems) do begin
        if I < FMRUList.Count then
          S := FMRUList[I]
        else
          S := '';
        Ini.WriteString('ScriptFileHistoryNew', 'History' + IntToStr(I), S);
      end;
    finally
      Ini.Free;
    end;
  except
    { Handle exceptions locally; failure to save the MRU list should not be
      a fatal error. }
    Application.HandleException(Self);
  end;
end;

procedure TCompileForm.StatusMessage(const S: String);
var
  DC: HDC;
  Size: TSize;
begin
  with CompilerOutputList do begin
    try
      TopIndex := Items.Add(S);
    except
      on EOutOfResources do begin
        Clear;
        SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
        Items.Add(SCompilerStatusReset);
        TopIndex := Items.Add(S);
      end;
    end;
    DC := GetDC(0);
    try
      SelectObject(DC, Font.Handle);
      GetTextExtentPoint(DC, PChar(S), Length(S), Size);
    finally
      ReleaseDC(0, DC);
    end;
    Inc(Size.cx, 5);
    if Size.cx > SendMessage(Handle, LB_GETHORIZONTALEXTENT, 0, 0) then
      SendMessage(Handle, LB_SETHORIZONTALEXTENT, Size.cx, 0);
    Update;
  end;
end;

procedure TCompileForm.DebugLogMessage(const S: String);
var
  ST: TSystemTime;
  FirstLine: Boolean;

  procedure AddLine(S: String);
  var
    StartsWithTab: Boolean;
    DC: HDC;
    Size: TSize;
  begin
    if FirstLine then begin
      FirstLine := False;
      Insert(Format('[%.2u:%.2u:%.2u]   ', [ST.wHour, ST.wMinute, ST.wSecond]), S, 1);
      StartsWithTab := False;
    end
    else begin
      Insert(#9, S, 1);
      StartsWithTab := True;
    end;
    try
      DebugOutputList.TopIndex := DebugOutputList.Items.Add(S);
    except
      on EOutOfResources do begin
        DebugOutputList.Clear;
        SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
        DebugOutputList.Items.Add(SCompilerStatusReset);
        DebugOutputList.TopIndex := DebugOutputList.Items.Add(S);
      end;
    end;
    DC := GetDC(0);
    try
      SelectObject(DC, DebugOutputList.Font.Handle);
      if StartsWithTab then
        GetTextExtentPoint(DC, PChar(S)+1, Length(S)-1, Size)
      else
        GetTextExtentPoint(DC, PChar(S), Length(S), Size);
    finally
      ReleaseDC(0, DC);
    end;
    Inc(Size.cx, 5);
    if StartsWithTab then
      Inc(Size.cx, FDebugLogListTimeWidth);
    if Size.cx > SendMessage(DebugOutputList.Handle, LB_GETHORIZONTALEXTENT, 0, 0) then
      SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, Size.cx, 0);
  end;

var
  LineStart, I: Integer;
  LastWasCR: Boolean;
begin
  GetLocalTime(ST);
  FirstLine := True;
  LineStart := 1;
  LastWasCR := False;
  { Call AddLine for each line. CR, LF, and CRLF line breaks are supported. }
  for I := 1 to Length(S) do begin
    if S[I] = #13 then begin
      AddLine(Copy(S, LineStart, I - LineStart));
      LineStart := I + 1;
      LastWasCR := True;
    end
    else begin
      if S[I] = #10 then begin
        if not LastWasCR then
          AddLine(Copy(S, LineStart, I - LineStart));
        LineStart := I + 1;
      end;
      LastWasCR := False;
    end;
  end;
  AddLine(Copy(S, LineStart, Maxint));
  DebugOutputList.Update;
end;

type
  PAppData = ^TAppData;
  TAppData = record
    Form: TCompileForm;
    ScriptFile: TTextFileReader;
    CurLineNumber: Integer;
    CurLine: String;
    OutputExe: String;
    ErrorMsg: String;
    ErrorFilename: String;
    ErrorLine: Integer;
    Aborted: Boolean;
  end;

function CompilerCallbackProc(Code: Integer; var Data: TCompilerCallbackData;
  AppData: Longint): Integer; stdcall;
begin
  Result := iscrSuccess;
  with PAppData(AppData)^ do
    case Code of
      iscbReadScript:
        if ScriptFile = nil then begin
          if Data.Reset then
            CurLineNumber := 0;
          if CurLineNumber < Form.Memo.Lines.Count then begin
            CurLine := Form.Memo.Lines[CurLineNumber];
            Data.LineRead := PChar(CurLine);
            Inc(CurLineNumber);
          end;
        end
        else begin
          { Note: In Inno Setup 3.0.1 and later we can ignore Data.Reset since
            it is only True once (when reading the first line). }
          if not ScriptFile.Eof then begin
            CurLine := ScriptFile.ReadLine;
            Data.LineRead := PChar(CurLine);
          end;
        end;
      iscbNotifyStatus:
        Form.StatusMessage(Data.StatusMsg);
      iscbNotifyIdle:
        begin
          Form.UpdateCompileStatusPanels(Data.CompressProgress, Data.CompressProgressMax);
          { We have to use HandleMessage instead of ProcessMessages so that
            Application.Idle is called. Otherwise, Flat TSpeedButton's don't
            react to the mouse being moved over them.
            Unfortunately, HandleMessage by default calls WaitMessage. To avoid
            this we have an Application.OnIdle handler which sets Done to False
            while compiling is in progress - see AppOnIdle.
            The GetQueueStatus check below is just an optimization; calling
            HandleMessage when there are no messages to process wastes CPU. }
          if GetQueueStatus(QS_ALLINPUT) <> 0 then begin
            Form.FBecameIdle := False;
            repeat
              Application.HandleMessage;
              { AppOnIdle sets FBecameIdle to True when it's called, which
                indicates HandleMessage didn't find any message to process }
            until Form.FBecameIdle;
          end;
          if Form.FCompileWantAbort then
            Result := iscrRequestAbort;
        end;
      iscbNotifySuccess:
        begin
          OutputExe := Data.OutputExeFilename;
          if Form.FCompilerVersion.BinVersion >= $3000001 then begin
            Form.ParseDebugInfo(Data.DebugInfo);
            Form.Memo.InvalidateGutter;
          end;
        end;
      iscbNotifyError:
        begin
          if Assigned(Data.ErrorMsg) then
            ErrorMsg := Data.ErrorMsg
          else
            Aborted := True;
          ErrorFilename := Data.ErrorFilename;
          ErrorLine := Data.ErrorLine;
        end;
    end;
end;

procedure TCompileForm.CompileFile(const AFilename: String;
  const ReadFromFile: Boolean);
var
  F: TTextFileReader;
  SourcePath, S: String;
  Params: TCompileScriptParamsEx;
  AppData: TAppData;
  StartTime, ElapsedTime, ElapsedSeconds: DWORD;
begin
  if FCompiling then begin
    { Shouldn't get here, but just in case... }
    MsgBox('A compile is already in progress.', SCompilerFormCaption, mbError, MB_OK);
    Abort;
  end;

  DestroyDebugInfo;
  Memo.InvalidateGutter;
  if ReadFromFile then
    F := TTextFileReader.Create(AFilename, fdOpenExisting, faRead, fsRead)
  else
    F := nil;
  try
    FBuildAnimationFrame := 0;
    FProgress := 0;
    FProgressMax := 0;

    Memo.Cursor := crAppStart;
    CompilerOutputList.Cursor := crAppStart;
    Memo.ReadOnly := True;
    HideError;
    CompilerOutputList.Clear;
    SendMessage(CompilerOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
    DebugOutputList.Clear;
    SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0);
    TabSet.TabIndex := tiCompilerOutput;
    SetStatusPanelVisible(True);

    if AFilename <> '' then
      SourcePath := PathExtractPath(AFilename)
    else begin
      { If the script was not saved, set the initial source directory to the
        directory Compil32 was started from. (The Delphi IDE works basically
        the same way.) }
      SourcePath := FInitialCurrentDir;
    end;
    FillChar(Params, SizeOf(Params), 0);
    Params.Size := SizeOf(Params);
    Params.CompilerPath := nil;
    Params.SourcePath := PChar(SourcePath);
    Params.CallbackProc := CompilerCallbackProc;
    Pointer(Params.AppData) := @AppData;

    AppData.Form := Self;
    AppData.ScriptFile := F;
    AppData.CurLineNumber := 0;
    AppData.Aborted := False;

    StartTime := GetTickCount;
    StatusMessage(Format(SCompilerStatusStarting, [TimeToStr(Time)]));
    StatusMessage('');
    FCompiling := True;
    FCompileWantAbort := False;
    UpdateRunMenu;
    UpdateCaption;
    SetLowPriority(FOptions.LowPriorityDuringCompile);
    {$IFNDEF STATICCOMPILER}
    if ISDllCompileScript(Params) <> isceNoError then begin
    {$ELSE}
    if ISCompileScript(Params, False) <> isceNoError then begin
    {$ENDIF}
      StatusMessage(SCompilerStatusErrorAborted);
      if (AppData.ScriptFile = nil) and (AppData.ErrorLine > 0) and
         (AppData.ErrorFilename = '') then begin
        { Move the caret to the line number the error occured on }
        if Memo.CaretY <> AppData.ErrorLine then
          Memo.CaretXY := Point(1, AppData.ErrorLine);
        Memo.BlockBegin := Memo.CaretXY;  { clear any selection }
        Memo.SetFocus;
        SetErrorLine(AppData.ErrorLine);
      end;
      if not AppData.Aborted then begin
        S := '';
        if AppData.ErrorFilename <> '' then
          S := 'File: ' + AppData.ErrorFilename + SNewLine2;
        if AppData.ErrorLine > 0 then
          S := S + Format('Line %d:' + SNewLine, [AppData.ErrorLine]);
        S := S + AppData.ErrorMsg;
        MsgBox(S, 'Compiler Error', mbCriticalError, MB_OK)
      end;
      Abort;
    end;
    ElapsedTime := GetTickCount - StartTime;
    ElapsedSeconds := ElapsedTime div 1000;
    StatusMessage(Format(SCompilerStatusFinished, [TimeToStr(Time),
      Format('%.2u%s%.2u%s%.3u', [ElapsedSeconds div 60, TimeSeparator,
        ElapsedSeconds mod 60, DecimalSeparator, ElapsedTime mod 1000])]));
  finally
    F.Free;
    FCompiling := False;
    SetLowPriority(False);
    Memo.Cursor := crIBeam;
    CompilerOutputList.Cursor := crDefault;
    Memo.ReadOnly := False;
    UpdateRunMenu;
    UpdateCaption;
    InvalidateStatusPanel(spCompileIcon);
    InvalidateStatusPanel(spCompileProgress);
  end;
  FCompiledExe := AppData.OutputExe;
  FModifiedSinceLastCompile := False;
end;

procedure TCompileForm.SetLowPriority(ALowPriority: Boolean);
begin
  if ALowPriority then begin
    { Save current priority and change to 'low' }
    if FSavePriorityClass = 0 then
      FSavePriorityClass := GetPriorityClass(GetCurrentProcess);
    SetPriorityClass(GetCurrentProcess, IDLE_PRIORITY_CLASS);
  end