compform.pas

源代码

unit CompForm;

{
  Inno Setup
  Copyright (C) 1997-2004 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  Compiler form

  $jrsoftware: issrc/Projects/CompForm.pas,v 1.118 2004/12/23 20:29:50 jr Exp $
}

{x$DEFINE STATICCOMPILER}
{ For debugging purposes, remove the 'x' to have it link the compiler code
  into this program and not depend on ISCmplr.dll. }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  UIStateForm, StdCtrls, ExtCtrls, Menus, Buttons, ComCtrls, CommCtrl,
  SynEdit, SynEditTypes, SynMemo, SynEditHighlighter, SynHighlighterInno,
  SynHighlighterISXCode, SynHighlighterPas, SynHighlighterMulti, NewTabSet,
  DebugStruct, CompInt, UxThemeISX;

const
  WM_StartCommandLineCompile = WM_USER + $1000;
  WM_StartCommandLineWizard = WM_USER + $1001;
  WM_ShowStartupForm = WM_USER + $1002;

  MRUListMaxCount = 10;

type
  TLineState = (lnUnknown, lnHasEntry, lnEntryProcessed);
  PLineStateArray = ^TLineStateArray;
  TLineStateArray = array[1..1] of TLineState;
  PDebugEntryArray = ^TDebugEntryArray;
  TDebugEntryArray = array[0..0] of TDebugEntry;
  PVariableDebugEntryArray = ^TVariableDebugEntryArray;
  TVariableDebugEntryArray = array[0..0] of TVariableDebugEntry;
  TDebugTarget = (dtSetup, dtUninstall);

const
  DebugTargetStrings: array[TDebugTarget] of String = ('Setup', 'Uninstall');

type
  TCompileForm = class(TUIStateForm)
    OpenDialog: TOpenDialog;
    MainMenu1: TMainMenu;
    FMenu: TMenuItem;
    FNew: TMenuItem;
    FOpen: TMenuItem;
    FSave: TMenuItem;
    FSaveAs: TMenuItem;
    N1: TMenuItem;
    BCompile: TMenuItem;
    N2: TMenuItem;
    FExit: TMenuItem;
    EMenu: TMenuItem;
    EUndo: TMenuItem;
    N3: TMenuItem;
    ECut: TMenuItem;
    ECopy: TMenuItem;
    EPaste: TMenuItem;
    EDelete: TMenuItem;
    N4: TMenuItem;
    ESelectAll: TMenuItem;
    VMenu: TMenuItem;
    EFind: TMenuItem;
    EFindNext: TMenuItem;
    EReplace: TMenuItem;
    HMenu: TMenuItem;
    HDoc: TMenuItem;
    N6: TMenuItem;
    HAbout: TMenuItem;
    SaveDialog: TSaveDialog;
    FMRUSep: TMenuItem;
    VCompilerOutput: TMenuItem;
    FindDialog: TFindDialog;
    ReplaceDialog: TReplaceDialog;
    StatusPanel: TPanel;
    CompilerOutputList: TListBox;
    SplitPanel: TPanel;
    ToolbarPanel: TPanel;
    NewButton: TSpeedButton;
    Bevel1: TBevel;
    OpenButton: TSpeedButton;
    SaveButton: TSpeedButton;
    CompileButton: TSpeedButton;
    HelpButton: TSpeedButton;
    HWebsite: TMenuItem;
    VToolbar: TMenuItem;
    N7: TMenuItem;
    VOptions: TMenuItem;
    Memo: TSynEdit;
    SynInnoSyn1: TSynInnoSyn;
    PopupMenu1: TPopupMenu;
    PUndo: TMenuItem;
    N8: TMenuItem;
    PCut: TMenuItem;
    PCopy: TMenuItem;
    PPaste: TMenuItem;
    PDelete: TMenuItem;
    PSelectAll: TMenuItem;
    N9: TMenuItem;
    PFind: TMenuItem;
    PFindNext: TMenuItem;
    PReplace: TMenuItem;
    HFaq: TMenuItem;
    Bevel2: TBevel;
    Bevel3: TBevel;
    StatusBar: TStatusBar;
    BodyPanel: TPanel;
    VStatusBar: TMenuItem;
    ERedo: TMenuItem;
    PRedo: TMenuItem;
    RMenu: TMenuItem;
    RStepInto: TMenuItem;
    RStepOver: TMenuItem;
    N5: TMenuItem;
    RRun: TMenuItem;
    RRunToCursor: TMenuItem;
    N10: TMenuItem;
    REvaluate: TMenuItem;
    CheckIfRunningTimer: TTimer;
    RunButton: TSpeedButton;
    Bevel4: TBevel;
    PauseButton: TSpeedButton;
    RPause: TMenuItem;
    RParameters: TMenuItem;
    ListPopupMenu: TPopupMenu;
    PListCopy: TMenuItem;
    SynMultiSyn1: TSynMultiSyn;
    SynISXCodeSyn1: TSynISXCodeSyn;
    HISPPSep: TMenuItem;
    N12: TMenuItem;
    BStopCompile: TMenuItem;
    StopCompileButton: TSpeedButton;
    HISPPDoc: TMenuItem;
    HISPPWebsite: TMenuItem;
    N13: TMenuItem;
    EGoto: TMenuItem;
    RTerminate: TMenuItem;
    BMenu: TMenuItem;
    BLowPriority: TMenuItem;
    HDonate: TMenuItem;
    N14: TMenuItem;
    HPSWebsite: TMenuItem;
    N15: TMenuItem;
    RTargetSetup: TMenuItem;
    RTargetUninstall: TMenuItem;
    TargetSetupButton: TSpeedButton;
    TargetUninstallButton: TSpeedButton;
    Bevel5: TBevel;
    TabSet: TNewTabSet;
    DebugOutputList: TListBox;
    VDebugOutput: TMenuItem;
    VHide: TMenuItem;
    N11: TMenuItem;
    SpacerPaintBox: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FExitClick(Sender: TObject);
    procedure FOpenClick(Sender: TObject);
    procedure EUndoClick(Sender: TObject);
    procedure EMenuClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure ECutClick(Sender: TObject);
    procedure ECopyClick(Sender: TObject);
    procedure EPasteClick(Sender: TObject);
    procedure EDeleteClick(Sender: TObject);
    procedure FSaveClick(Sender: TObject);
    procedure ESelectAllClick(Sender: TObject);
    procedure FNewClick(Sender: TObject);
    procedure FNewWizardClick(Sender: TObject);
    procedure FSaveAsClick(Sender: TObject);
    procedure HDocClick(Sender: TObject);
    procedure BCompileClick(Sender: TObject);
    procedure FMenuClick(Sender: TObject);
    procedure FMRUClick(Sender: TObject);
    procedure VCompilerOutputClick(Sender: TObject);
    procedure HAboutClick(Sender: TObject);
    procedure EFindClick(Sender: TObject);
    procedure FindDialogFind(Sender: TObject);
    procedure EReplaceClick(Sender: TObject);
    procedure ReplaceDialogReplace(Sender: TObject);
    procedure EFindNextClick(Sender: TObject);
    procedure SplitPanelMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure VMenuClick(Sender: TObject);
    procedure HWebsiteClick(Sender: TObject);
    procedure VToolbarClick(Sender: TObject);
    procedure VOptionsClick(Sender: TObject);
    procedure HFaqClick(Sender: TObject);
    procedure HPSWebsiteClick(Sender: TObject);
    procedure HISPPDocClick(Sender: TObject);
    procedure HISPPWebsiteClick(Sender: TObject);
    procedure MemoStatusChange(Sender: TObject;
      Changes: TSynStatusChanges);
    procedure VStatusBarClick(Sender: TObject);
    procedure MemoSpecialLineColors(Sender: TObject; Line: Integer;
      var Special: Boolean; var FG, BG: TColor);
    procedure MemoChange(Sender: TObject);
    procedure MemoDropFiles(Sender: TObject; X, Y: Integer;
      AFiles: TStrings);
    procedure ERedoClick(Sender: TObject);
    procedure StatusBarResize(Sender: TObject);
    procedure MemoPaint(Sender: TObject; ACanvas: TCanvas);
    procedure RStepIntoClick(Sender: TObject);
    procedure RStepOverClick(Sender: TObject);
    procedure RRunToCursorClick(Sender: TObject);
    procedure RRunClick(Sender: TObject);
    procedure REvaluateClick(Sender: TObject);
    procedure CheckIfRunningTimerTimer(Sender: TObject);
    procedure RPauseClick(Sender: TObject);
    procedure RParametersClick(Sender: TObject);
    procedure PListCopyClick(Sender: TObject);
    procedure BStopCompileClick(Sender: TObject);
    procedure HMenuClick(Sender: TObject);
    procedure EGotoClick(Sender: TObject);
    procedure MemoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RTerminateClick(Sender: TObject);
    procedure BMenuClick(Sender: TObject);
    procedure BLowPriorityClick(Sender: TObject);
    procedure StatusBarDrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure HDonateClick(Sender: TObject);
    procedure RTargetClick(Sender: TObject);
    procedure DebugOutputListDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure TabSetClick(Sender: TObject);
    procedure VHideClick(Sender: TObject);
    procedure VDebugOutputClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    FCompilerVersion: PCompilerVersionInfo;
    FInitialCurrentDir: String;
    FFilename: String;
    FFileLastWriteTime: TFileTime;
    FMRUMenuItems: array[0..MRUListMaxCount-1] of TMenuItem;
    FMRUList: TStringList;
    FOptions: record
      ShowStartupForm: Boolean;
      UseWizard: Boolean;
      MakeBackups: Boolean;
      FullPathInTitleBar: Boolean;
      UndoAfterSave: Boolean;
      PauseOnDebuggerExceptions: Boolean;
      UseSyntaxHighlighting: Boolean;
      CursorPastEOL: Boolean;
      TabWidth: Integer;
      LowPriorityDuringCompile: Boolean;
    end;
    FCompiling: Boolean;
    FCompileWantAbort: Boolean;
    FBecameIdle: Boolean;
    FErrorLine, FStepLine: Integer;
    FModifiedSinceLastCompile: Boolean;
    FDebugEntries: PDebugEntryArray;
    FDebugEntriesCount: Integer;
    FVariableDebugEntries: PVariableDebugEntryArray;
    FVariableDebugEntriesCount: Integer;
    FCompiledCodeText: String;
    FCompiledCodeDebugInfo: String;
    FLineState: PLineStateArray;
    FLineStateCount: Integer;
    FDebugClientWnd: HWND;
    FProcessHandle, FDebugClientProcessHandle: THandle;
    FDebugTarget: TDebugTarget;
    FCompiledExe, FUninstExe, FTempDir: String;
    FDebugging: Boolean;
    FSingleStep: Boolean;
    FPaused: Boolean;
    FRunToCursorEnabled: Boolean;
    FRunToCursorPoint: TDebugEntry;
    FReplyString: String;
    FDebuggerException: String;
    FRunParameters: String;
    FLastFindOptions: TFindOptions;
    FLastFindText: String;
    FLastReplaceText: String;
    FLastEvaluateConstantText: String;
    FSavePriorityClass: DWORD;
    FBuildImageList: HIMAGELIST;
    FBuildAnimationFrame: Cardinal;
    FLastAnimationTick: DWORD;
    FProgress, FProgressMax: Cardinal;
    FProgressThemeData: HTHEME;
    FProgressChunkSize, FProgressSpaceSize: Integer;
    FDebugLogListTimeWidth: Integer;
    procedure AddToMRUList(const AFilename: String);
    class procedure AppOnException(Sender: TObject; E: Exception);
    procedure AppOnActivate(Sender: TObject);
    procedure AppOnIdle(Sender: TObject; var Done: Boolean);
    function AskToDetachDebugger: Boolean;
    procedure CheckIfTerminated;
    procedure CompileFile(const AFilename: String; const ReadFromFile: Boolean);
    procedure CompileIfNecessary;
    function ConfirmCloseFile(const PromptToSave: Boolean): Boolean;
    procedure DebuggingStopped;
    procedure DebugLogMessage(const S: String);
    procedure DestroyDebugInfo;
    procedure DetachDebugger;
    function EvaluateConstant(const S: String; var Output: String): Integer;
    function EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry;
      var Output: String): Integer;
    procedure FindNext;
    procedure Go(ASingleStep, AStepOver: Boolean);
    procedure HideError;
    procedure InitializeFindText(Dlg: TFindDialog);
    procedure InvalidateStatusPanel(const Index: Integer);
    procedure MemoWndProc(var Message: TMessage);
    procedure NewFile;
    procedure NewWizardFile;
    procedure OpenFile(AFilename: String);
    procedure ParseDebugInfo(DebugInfo: Pointer);
    procedure ReadMRUList;
    procedure ResetLineState;
    procedure StartProcess;
    function SaveFile(const SaveAs: Boolean): Boolean;
    procedure SetErrorLine(ALine: Integer);
    procedure SetLowPriority(ALowPriority: Boolean);
    procedure SetStatusPanelVisible(const AVisible: Boolean);
    procedure SetStepLine(ALine: Integer);
    procedure ShowOpenDialog(const Examples: Boolean);
    procedure StatusMessage(const S: String);
    procedure SyncEditorOptions;
    procedure UpdateCaption;
    procedure UpdateCompileStatusPanels(const AProgress, AProgressMax: Cardinal);
    procedure UpdateNewButtons;
    procedure UpdateRunMenu;
    procedure UpdateTargetMenu;
    procedure UpdateThemeData(const Close, Open: Boolean);
    procedure UpdateStatusPanelHeight(H: Integer);
    procedure WMCopyData(var Message: TWMCopyData); message WM_COPYDATA;
    procedure WMDebuggerHello(var Message: TMessage); message WM_Debugger_Hello;
    procedure WMDebuggerGoodbye(var Message: TMessage); message WM_Debugger_Goodbye;
    function GetLineNumberFromEntry(Kind, Index: Integer): Integer;
    procedure DebuggerStepped(var Message: TMessage; const Intermediate: Boolean);
    procedure WMDebuggerStepped(var Message: TMessage); message WM_Debugger_Stepped;
    procedure WMDebuggerSteppedIntermediate(var Message: TMessage); message WM_Debugger_SteppedIntermediate;
    procedure WMDebuggerException(var Message: TMessage); message WM_Debugger_Exception;
    procedure WMStartCommandLineCompile(var Message: TMessage); message WM_StartCommandLineCompile;
    procedure WMStartCommandLineWizard(var Message: TMessage); message WM_StartCommandLineWizard;
    procedure WMShowStartupForm(var Message: TMessage); message WM_ShowStartupForm;
    procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED;
  public
    { Public declarations }
  end;

var
  CompileForm: TCompileForm;

  CommandLineFilename, CommandLineWizardName: String;
  CommandLineCompile: Boolean;
  CommandLineWizard: Boolean;

procedure InitFormFont(Form: TForm);

implementation

uses
  Clipbrd, ShellApi, IniFiles, Registry, CommDlg,
  PathFunc, CmnFunc, CmnFunc2, FileClass, CompMsgs, TmSchemaISX,
  {$IFDEF STATICCOMPILER} Compile, {$ENDIF}
  CompOptions, CompStartup, CompWizard;

{$R *.DFM}
{$R CompImages.res}

const
  { Status bar panel indexes }
  spCaretPos = 0;
  spModified = 1;
  spInsertMode = 2;
  spCompileIcon = 3;
  spCompileProgress = 4;
  spRunStatus = 5;

  { Tab set indexes }
  tiCompilerOutput = 0;
  tiDebugOutput = 1;

procedure InitFormFont(Form: TForm);
begin
  Form.Font.Name := GetPreferredUIFont;
  if (Form.Font.Name = 'MS Sans Serif') and
     (DefFontData.Charset = SHIFTJIS_CHARSET) then
    { MS Sans Serif can't display Japanese charactesr, so revert to default
      Japanese font (requires D3+) }
    Form.Font.Handle := 0;
end;

function GetDisplayFilename(const Filename: String): String;
var
  Buf: array[0..MAX_PATH-1] of Char;
begin
  if GetFileTitle(PChar(Filename), Buf, SizeOf(Buf)) = 0 then
    Result := Buf
  else
    Result := Filename;
end;

function GetLastWriteTimeOfFile(const Filename: String;
  var LastWriteTime: TFileTime): Boolean;
var
  H: THandle;
begin
  H := CreateFile(PChar(Filename), 0, FILE_SHARE_READ or FILE_SHARE_WRITE,