unit IDE.MainForm; { Inno Setup Copyright (C) 1997-2025 Jordan Russell Portions by Martijn Laan For conditions of distribution and use, see LICENSE.TXT. Compiler form } {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. You will also need to add the ..\Components and Src folders to the Delphi Compiler Search path in the project options. Also see ISCC's STATICCOMPILER and Compiler.Compile's STATICPREPROC. } {$IFDEF STATICCOMPILER} {$R ..\Res\ISCmplr.images.res} {$ENDIF} interface uses Windows, Messages, SysUtils, Classes, Contnrs, Graphics, Controls, Forms, Dialogs, CommDlg, Generics.Collections, UIStateForm, StdCtrls, ExtCtrls, Menus, Buttons, ComCtrls, CommCtrl, ScintInt, ScintEdit, IDE.ScintStylerInnoSetup, NewTabSet, ModernColors, IDE.IDEScintEdit, Shared.DebugStruct, Shared.CompilerInt.Struct, NewUxTheme, ImageList, ImgList, ToolWin, IDE.HelperFunc, VirtualImageList, BaseImageCollection; const WM_StartCommandLineCompile = WM_USER + $1000; WM_StartCommandLineWizard = WM_USER + $1001; WM_StartNormally = WM_USER + $1002; type PDebugEntryArray = ^TDebugEntryArray; TDebugEntryArray = array[0..0] of TDebugEntry; PVariableDebugEntryArray = ^TVariableDebugEntryArray; TVariableDebugEntryArray = array[0..0] of TVariableDebugEntry; TStepMode = (smRun, smStepInto, smStepOver, smStepOut, smRunToCursor); TDebugTarget = (dtSetup, dtUninstall); const DebugTargetStrings: array[TDebugTarget] of String = ('Setup', 'Uninstall'); type TStatusMessageKind = (smkStartEnd, smkNormal, smkWarning, smkError); TIncludedFile = class Filename: String; CompilerFileIndex: Integer; LastWriteTime: TFileTime; HasLastWriteTime: Boolean; Memo: TIDEScintFileEdit; end; TIncludedFiles = TObjectList; TFindResult = class Filename: String; Line, LineStartPos: Integer; Range: TScintRange; PrefixStringLength: Integer; end; TFindResults = TObjectList; TMenuBitmaps = TDictionary; TKeyMappedMenus = TDictionary; TCallTipState = record StartCallTipWord: Integer; FunctionDefinition: AnsiString; BraceCount: Integer; LastPosCallTip: Integer; ClassOrRecordMember: Boolean; CurrentCallTipWord: String; CurrentCallTip: Integer; MaxCallTips: Integer; end; TUpdatePanelMessage = class Msg, ConfigIdent: String; ConfigValue: Integer; Color: TColor; constructor Create(const AMsg, AConfigIdent: String; const AConfigValue: Integer; const AColor: TColor); end; TUpdatePanelMessages = TObjectList; TMainForm = class(TUIStateForm) MainMenu1: TMainMenu; FMenu: TMenuItem; FNewMainFile: TMenuItem; FOpenMainFile: TMenuItem; FSave: TMenuItem; FSaveMainFileAs: 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; HAbout: TMenuItem; FRecent: TMenuItem; FClearRecent: TMenuItem; N6: TMenuItem; VCompilerOutput: TMenuItem; FindDialog: TFindDialog; ReplaceDialog: TReplaceDialog; StatusPanel: TPanel; CompilerOutputList: TListBox; SplitPanel: TPanel; HWebsite: TMenuItem; VToolbar: TMenuItem; N7: TMenuItem; TOptions: TMenuItem; HFaq: TMenuItem; StatusBar: TStatusBar; BodyPanel: TPanel; VStatusBar: TMenuItem; ERedo: TMenuItem; RMenu: TMenuItem; RStepInto: TMenuItem; RStepOver: TMenuItem; N5: TMenuItem; RRun: TMenuItem; RRunToCursor: TMenuItem; N10: TMenuItem; REvaluate: TMenuItem; CheckIfRunningTimer: TTimer; RPause: TMenuItem; RParameters: TMenuItem; OutputListPopupMenu: TMenuItem; POutputListCopy: TMenuItem; HISPPSep: TMenuItem; N12: TMenuItem; BStopCompile: TMenuItem; HISPPDoc: TMenuItem; N13: TMenuItem; EGoto: TMenuItem; RTerminate: TMenuItem; BMenu: TMenuItem; BLowPriority: TMenuItem; HDonate: TMenuItem; N14: TMenuItem; N15: TMenuItem; RTargetSetup: TMenuItem; RTargetUninstall: TMenuItem; OutputTabSet: TNewTabSet; DebugOutputList: TListBox; VDebugOutput: TMenuItem; VHide: TMenuItem; N11: TMenuItem; TMenu: TMenuItem; TAddRemovePrograms: TMenuItem; RToggleBreakPoint: TMenuItem; RDeleteBreakPoints: TMenuItem; HWhatsNew: TMenuItem; TGenerateGUID: TMenuItem; TSignTools: TMenuItem; N16: TMenuItem; HExamples: TMenuItem; N17: TMenuItem; BOpenOutputFolder: TMenuItem; N8: TMenuItem; VZoom: TMenuItem; VZoomIn: TMenuItem; VZoomOut: TMenuItem; N9: TMenuItem; VZoomReset: TMenuItem; N18: TMenuItem; N19: TMenuItem; FSaveEncoding: TMenuItem; FSaveEncodingAuto: TMenuItem; FSaveEncodingUTF8WithBOM: TMenuItem; ToolBar: TToolBar; BackNavButton: TToolButton; ForwardNavButton: TToolButton; ToolButton1: TToolButton; NewMainFileButton: TToolButton; OpenMainFileButton: TToolButton; SaveButton: TToolButton; ToolButton2: TToolButton; CompileButton: TToolButton; StopCompileButton: TToolButton; ToolButton3: TToolButton; RunButton: TToolButton; PauseButton: TToolButton; ToolButton4: TToolButton; TargetSetupButton: TToolButton; TargetUninstallButton: TToolButton; ToolButton5: TToolButton; HelpButton: TToolButton; Bevel1: TBevel; TerminateButton: TToolButton; ThemedToolbarVirtualImageList: TVirtualImageList; LightToolbarVirtualImageList: TVirtualImageList; POutputListSelectAll: TMenuItem; DebugCallStackList: TListBox; VDebugCallStack: TMenuItem; TMsgBoxDesigner: TMenuItem; TRegistryDesigner: TMenuItem; ToolBarPanel: TPanel; HMailingList: TMenuItem; MemosTabSet: TNewTabSet; { First tab is the main memo, last tab is the preprocessor output memo } FSaveAll: TMenuItem; RStepOut: TMenuItem; VNextTab: TMenuItem; VPreviousTab: TMenuItem; N20: TMenuItem; HShortcutsDoc: TMenuItem; HRegExDoc: TMenuItem; N21: TMenuItem; EFindPrevious: TMenuItem; FindResultsList: TListBox; VFindResults: TMenuItem; EFindInFiles: TMenuItem; FindInFilesDialog: TFindDialog; FPrint: TMenuItem; N22: TMenuItem; PrintDialog: TPrintDialog; FSaveEncodingUTF8WithoutBOM: TMenuItem; TFilesDesigner: TMenuItem; VCloseCurrentTab: TMenuItem; VReopenTab: TMenuItem; VReopenTabs: TMenuItem; MemosTabSetPopupMenu: TMenuItem; VCloseCurrentTab2: TMenuItem; VReopenTab2: TMenuItem; VReopenTabs2: TMenuItem; NavPopupMenu: TMenuItem; N23: TMenuItem; ThemedMarkersAndACVirtualImageList: TVirtualImageList; ESelectNextOccurrence: TMenuItem; ESelectAllOccurrences: TMenuItem; BreakPointsPopupMenu: TMenuItem; RToggleBreakPoint2: TMenuItem; RDeleteBreakPoints2: TMenuItem; N24: TMenuItem; VWordWrap: TMenuItem; N25: TMenuItem; ESelectAllFindMatches: TMenuItem; EToggleLinesComment: TMenuItem; EBraceMatch: TMenuItem; EFoldLine: TMenuItem; EUnfoldLine: TMenuItem; EFindRegEx: TMenuItem; UpdatePanel: TPanel; UpdateLinkLabel: TLinkLabel; UpdatePanelClosePaintBox: TPaintBox; UpdatePanelDonateImage: TImage; procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure FExitClick(Sender: TObject); procedure FOpenMainFileClick(Sender: TObject); procedure EUndoClick(Sender: TObject); procedure EMenuClick(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 FNewMainFileClick(Sender: TObject); procedure FNewMainFileUserWizardClick(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 EFindNextOrPreviousClick(Sender: TObject); procedure SplitPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure VMenuClick(Sender: TObject); procedure HWebsiteClick(Sender: TObject); procedure VToolbarClick(Sender: TObject); procedure TOptionsClick(Sender: TObject); procedure HFaqClick(Sender: TObject); procedure HISPPDocClick(Sender: TObject); procedure VStatusBarClick(Sender: TObject); procedure ERedoClick(Sender: TObject); procedure StatusBarResize(Sender: TObject); 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 POutputListCopyClick(Sender: TObject); procedure BStopCompileClick(Sender: TObject); procedure EGotoClick(Sender: TObject); 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 OutputTabSetClick(Sender: TObject); procedure VHideClick(Sender: TObject); procedure VDebugOutputClick(Sender: TObject); procedure FormResize(Sender: TObject); procedure TAddRemoveProgramsClick(Sender: TObject); procedure RToggleBreakPointClick(Sender: TObject); procedure RDeleteBreakPointsClick(Sender: TObject); procedure HWhatsNewClick(Sender: TObject); procedure TGenerateGUIDClick(Sender: TObject); procedure TSignToolsClick(Sender: TObject); procedure HExamplesClick(Sender: TObject); procedure BOpenOutputFolderClick(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure VZoomInClick(Sender: TObject); procedure VZoomOutClick(Sender: TObject); procedure VZoomResetClick(Sender: TObject); procedure FSaveEncodingItemClick(Sender: TObject); procedure CompilerOutputListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer); procedure POutputListSelectAllClick(Sender: TObject); procedure DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure VDebugCallStackClick(Sender: TObject); procedure HMailingListClick(Sender: TObject); procedure TMsgBoxDesignerClick(Sender: TObject); procedure TRegistryDesignerClick(Sender: TObject); procedure MemosTabSetClick(Sender: TObject); procedure FSaveAllClick(Sender: TObject); procedure RStepOutClick(Sender: TObject); procedure TMenuClick(Sender: TObject); procedure VNextTabClick(Sender: TObject); procedure VPreviousTabClick(Sender: TObject); procedure HShortcutsDocClick(Sender: TObject); procedure HRegExDocClick(Sender: TObject); procedure VFindResultsClick(Sender: TObject); procedure EFindInFilesClick(Sender: TObject); procedure FindInFilesDialogFind(Sender: TObject); procedure FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure FindResultsListDblClick(Sender: TObject); procedure FPrintClick(Sender: TObject); procedure TFilesDesignerClick(Sender: TObject); procedure VCloseCurrentTabClick(Sender: TObject); procedure VReopenTabsClick(Sender: TObject); procedure MemosTabSetPopupMenuClick(Sender: TObject); procedure MemosTabSetOnCloseButtonClick(Sender: TObject; Index: Integer); procedure StatusBarClick(Sender: TObject); procedure SimpleMenuClick(Sender: TObject); procedure OutputListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure RMenuClick(Sender: TObject); procedure BackNavButtonClick(Sender: TObject); procedure ForwardNavButtonClick(Sender: TObject); procedure NavPopupMenuClick(Sender: TObject); procedure ESelectNextOccurrenceClick(Sender: TObject); procedure ESelectAllOccurrencesClick(Sender: TObject); procedure BreakPointsPopupMenuClick(Sender: TObject); procedure FClearRecentClick(Sender: TObject); procedure VWordWrapClick(Sender: TObject); procedure ESelectAllFindMatchesClick(Sender: TObject); procedure EToggleLinesCommentClick(Sender: TObject); procedure EBraceMatchClick(Sender: TObject); procedure EFoldOrUnfoldLineClick(Sender: TObject); procedure EFindRegExClick(Sender: TObject); procedure UpdateLinkLabelLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType); procedure UpdatePanelClosePaintBoxPaint(Sender: TObject); procedure UpdatePanelClosePaintBoxClick(Sender: TObject); procedure UpdatePanelDonateImageClick(Sender: TObject); private { Private declarations } FMemos: TList; { FMemos[0] is the main memo and FMemos[1] the preprocessor output memo - also see MemosTabSet comment above } FMainMemo: TIDEScintFileEdit; { Doesn't change } FPreprocessorOutputMemo: TIDEScintEdit; { Doesn't change and is the only memo which isnt a TIDEScint*File*Edit} FFileMemos: TList; { All memos except FPreprocessorOutputMemo, including those without a tab } FHiddenFiles: TStringList; { List of files which *do* use a memo but are hidden by the user and have no tab } FActiveMemo: TIDEScintEdit; { Changes depending on user input } FErrorMemo, FStepMemo: TIDEScintFileEdit; { These change depending on user input } FMemosStyler: TInnoSetupStyler; { Single styler for all memos } FCompilerVersion: PCompilerVersionInfo; FMRUMainFilesMenuItems: array[0..MRUListMaxCount-1] of TMenuItem; FMRUMainFilesList: TStringList; FMRUParametersList: TStringList; FOptions: record ShowStartupForm: Boolean; UseWizard: Boolean; Autosave: Boolean; MakeBackups: Boolean; FullPathInTitleBar: Boolean; UndoAfterSave: Boolean; PauseOnDebuggerExceptions: Boolean; RunAsDifferentUser: Boolean; AutoAutoComplete: Boolean; AutoCallTips: Boolean; UseSyntaxHighlighting: Boolean; ColorizeCompilerOutput: Boolean; UnderlineErrors: Boolean; HighlightWordAtCursorOccurrences: Boolean; HighlightSelTextOccurrences: Boolean; CursorPastEOL: Boolean; TabWidth: Integer; UseTabCharacter: Boolean; ShowWhiteSpace: Boolean; UseFolding: Boolean; FindRegEx: Boolean; WordWrap: Boolean; AutoIndent: Boolean; IndentationGuides: Boolean; LowPriorityDuringCompile: Boolean; GutterLineNumbers: Boolean; KeyMappingType: TKeyMappingType; MemoKeyMappingType: TIDEScintKeyMappingType; ThemeType: TThemeType; ShowPreprocessorOutput: Boolean; OpenIncludedFiles: Boolean; ShowCaretPosition: Boolean; end; FOptionsLoaded: Boolean; FTheme: TTheme; FSignTools: TStringList; FFindResults: TFindResults; FCompiling: Boolean; FCompileWantAbort: Boolean; FBecameIdle: Boolean; FModifiedAnySinceLastCompile, FModifiedAnySinceLastCompileAndGo: Boolean; FDebugEntries: PDebugEntryArray; FDebugEntriesCount: Integer; FVariableDebugEntries: PVariableDebugEntryArray; FVariableDebugEntriesCount: Integer; FCompiledCodeText: AnsiString; FCompiledCodeDebugInfo: AnsiString; FDebugClientWnd: HWND; FProcessHandle, FDebugClientProcessHandle: THandle; FDebugTarget: TDebugTarget; FCompiledExe, FUninstExe, FTempDir: String; FPreprocessorOutput: String; FIncludedFiles: TIncludedFiles; FDebugging: Boolean; FStepMode: TStepMode; FPaused, FPausedAtCodeLine: Boolean; FRunToCursorPoint: TDebugEntry; FReplyString: String; FDebuggerException: String; FRunParameters: String; FLastFindOptions: TFindOptions; FLastFindRegEx: Boolean; FLastFindText: String; FLastReplaceText: String; FLastEvaluateConstantText: String; FSavePriorityClass: DWORD; FBuildAnimationFrame: Cardinal; FLastAnimationTick: DWORD; FProgress, FProgressMax: Cardinal; FTaskbarProgressValue: Cardinal; FProgressThemeData: HTHEME; FMenuThemeData: HTHEME; FToolbarThemeData: HTHEME; FMenuDarkBackgroundBrush: TBrush; FMenuDarkHotOrSelectedBrush: TBrush; FDebugLogListTimestampsWidth: Integer; FOnPendingSquiggly: Boolean; FPendingSquigglyCaretPos: Integer; FCallStackCount: Cardinal; FDevMode, FDevNames: HGLOBAL; FMenuImageList: TVirtualImageList; FMenuBitmaps: TMenuBitmaps; FMenuBitmapsSize: TSize; FMenuBitmapsSourceImageCollection: TCustomImageCollection; FSynchingZoom: Boolean; FNavStacks: TIDEScintEditNavStacks; FCurrentNavItem: TIDEScintEditNavItem; FKeyMappedMenus: TKeyMappedMenus; FBackNavButtonShortCut, FForwardNavButtonShortCut: TShortCut; FBackNavButtonShortCut2, FForwardNavButtonShortCut2: TShortCut; FIgnoreTabSetClick: Boolean; FFirstTabSelectShortCut, FLastTabSelectShortCut: TShortCut; FCompileShortCut2: TShortCut; FCallTipState: TCallTipState; FUpdatePanelMessages: TUpdatePanelMessages; function AnyMemoHasBreakPoint: Boolean; class procedure AppOnException(Sender: TObject; E: Exception); procedure AppOnActivate(Sender: TObject); class procedure AppOnGetActiveFormHandle(var AHandle: HWND); procedure AppOnIdle(Sender: TObject; var Done: Boolean); function AskToDetachDebugger: Boolean; procedure BringToForeground; procedure BuildAndSaveBreakPointLines(const AMemo: TIDEScintFileEdit); procedure BuildAndSaveKnownIncludedAndHiddenFiles; procedure CheckIfTerminated; procedure ClearMRUMainFilesList; procedure CloseTab(const TabIndex: Integer); procedure CompileFile(AFilename: String; const ReadFromFile: Boolean); procedure CompileIfNecessary; function ConfirmCloseFile(const PromptToSave: Boolean): Boolean; procedure DebuggingStopped(const WaitForTermination: Boolean); procedure DebugLogMessage(const S: String); procedure DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal); function DestroyLineState(const AMemo: TIDEScintFileEdit): Boolean; procedure DestroyDebugInfo; procedure DetachDebugger; function EvaluateConstant(const S: String; out Output: String): Integer; function EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry; out Output: String): Integer; procedure FindNext(const ReverseDirection: Boolean); function FindSetupDirectiveValue(const DirectiveName, DefaultValue: String): String; overload; function FindSetupDirectiveValue(const DirectiveName: String; DefaultValue: Boolean): Boolean; overload; function FromCurrentPPI(const XY: Integer): Integer; function GetBorderStyle: TFormBorderStyle; procedure Go(AStepMode: TStepMode); procedure HideError; procedure InitializeFindText(Dlg: TFindDialog); function InitializeFileMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit; function InitializeMainMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit; function InitializeMemoBase(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit; function InitializeNonFileMemo(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit; function InitiateAutoCompleteOrCallTipAllowedAtPos(const AMemo: TIDEScintEdit; const WordStartLinePos, PositionBeforeWordStartPos: Integer): Boolean; procedure InitiateAutoComplete(const Key: AnsiChar); procedure UpdateCallTipFunctionDefinition(const Pos: Integer = -1); procedure InitiateCallTip(const Key: AnsiChar); procedure ContinueCallTip; procedure InvalidateStatusPanel(const Index: Integer); procedure LoadBreakPointLinesAndUpdateLineMarkers(const AMemo: TIDEScintFileEdit); procedure LoadKnownIncludedAndHiddenFilesAndUpdateMemos(const AFilename: String); procedure MemoCallTipArrowClick(Sender: TObject; const Up: Boolean); procedure MemoChange(Sender: TObject; const Info: TScintEditChangeInfo); procedure MemoCharAdded(Sender: TObject; Ch: AnsiChar); procedure MainMemoDropFiles(Sender: TObject; X, Y: Integer; AFiles: TStrings); procedure MemoHintShow(Sender: TObject; var Info: TScintHintInfo); procedure MemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure MemoKeyPress(Sender: TObject; var Key: Char); procedure MemoLinesDeleted(Memo: TIDEScintFileEdit; FirstLine, Count, FirstAffectedLine: Integer); procedure MemoLinesInserted(Memo: TIDEScintFileEdit; FirstLine, Count: integer); procedure MemoMarginClick(Sender: TObject; MarginNumber: Integer; Line: Integer); procedure MemoMarginRightClick(Sender: TObject; MarginNumber: Integer; Line: Integer); procedure MemoModifiedChange(Sender: TObject); function MemoToTabIndex(const AMemo: TIDEScintEdit): Integer; procedure MemoUpdateUI(Sender: TObject; Updated: TScintEditUpdates); procedure MemoZoom(Sender: TObject); function MultipleSelectionPasteFromClipboard(const AMemo: TIDESCintEdit): Boolean; procedure UpdateReopenTabMenu(const Menu: TMenuItem); procedure ModifyMRUMainFilesList(const AFilename: String; const AddNewItem: Boolean); procedure ModifyMRUParametersList(const AParameter: String; const AddNewItem: Boolean); procedure MoveCaretAndActivateMemo(AMemo: TIDEScintEdit; const LineNumberOrPosition: Integer; const AlwaysResetColumnEvenIfOnRequestedLineAlready: Boolean; const IsPosition: Boolean = False; const PositionVirtualSpace: Integer = 0); procedure NavItemClick(Sender: TObject); procedure NewMainFile; procedure NewMainFileUsingWizard; procedure OpenFile(AMemo: TIDEScintFileEdit; AFilename: String; const MainMemoAddToRecentDocs: Boolean); procedure OpenMRUMainFile(const AFilename: String); procedure ParseDebugInfo(DebugInfo: Pointer); procedure ReadMRUMainFilesList; procedure ReadMRUParametersList; procedure RemoveMemoFromNav(const AMemo: TIDEScintEdit); procedure RemoveMemoBadLinesFromNav(const AMemo: TIDEScintEdit); procedure ReopenTabClick(Sender: TObject); procedure ReopenTabOrTabs(const HiddenFileIndex: Integer; const Activate: Boolean); procedure ResetAllMemosLineState; procedure StartProcess; function SaveFile(const AMemo: TIDEScintFileEdit; const SaveAs: Boolean): Boolean; procedure SetBorderStyle(Value: TFormBorderStyle); procedure SetErrorLine(const AMemo: TIDEScintFileEdit; const ALine: Integer); procedure SetStatusPanelVisible(const AVisible: Boolean); procedure SetStepLine(const AMemo: TIDEScintFileEdit; ALine: Integer); procedure ShowOpenMainFileDialog(const Examples: Boolean); procedure StatusMessage(const Kind: TStatusMessageKind; const S: String); function StoreAndTestLastFindOptions(Sender: TObject): Boolean; function TestLastFindOptions: Boolean; procedure SyncEditorOptions; function TabIndexToMemo(const ATabIndex, AMaxTabIndex: Integer): TIDEScintEdit; function ToCurrentPPI(const XY: Integer): Integer; procedure ToggleBreakPoint(Line: Integer); procedure UpdateAllMemoLineMarkers(const AMemo: TIDEScintFileEdit); procedure UpdateAllMemosLineMarkers; procedure UpdateBevel1Visibility; procedure UpdateCaption; procedure UpdateCaretPosPanelAndBackNavStack; procedure UpdateCompileStatusPanels(const AProgress, AProgressMax: Cardinal; const ASecondsRemaining: Integer; const ABytesCompressedPerSecond: Cardinal); procedure UpdateEditModePanel; procedure UpdateFindRegExUI; procedure UpdateFindResult(const FindResult: TFindResult; const ItemIndex: Integer; const NewLine, NewLineStartPos: Integer); procedure UpdatePreprocMemos; procedure UpdateLineMarkers(const AMemo: TIDEScintFileEdit; const Line: Integer); procedure UpdateImages; procedure UpdateMarginsAndAutoCompleteIcons; procedure UpdateMarginsAndSquigglyAndCaretWidths; procedure UpdateMemosTabSetVisibility; procedure UpdateMenuBitmapsIfNeeded; procedure UpdateModifiedPanel; procedure UpdateNavButtons; procedure UpdateNewMainFileButtons; procedure UpdateOccurrenceIndicators(const AMemo: TIDEScintEdit); procedure UpdateOutputTabSetListsItemHeightAndDebugTimeWidth; procedure UpdateRunMenu; procedure UpdateSaveMenuItemAndButton; procedure UpdateTargetMenu; procedure UpdateUpdatePanel; procedure UpdateKeyMapping; procedure UpdateTheme; procedure UpdateThemeData(const Open: Boolean); procedure ApplyMenuBitmaps(const ParentMenuItem: TMenuItem); procedure UpdateStatusPanelHeight(H: Integer); procedure WMAppCommand(var Message: TMessage); message WM_APPCOMMAND; 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; procedure WMDebuggerQueryVersion(var Message: TMessage); message WM_Debugger_QueryVersion; procedure GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TIDEScintFileEdit; var DebugEntry: PDebugEntry); 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 WMDebuggerSetForegroundWindow(var Message: TMessage); message WM_Debugger_SetForegroundWindow; procedure WMDebuggerCallStackCount(var Message: TMessage); message WM_Debugger_CallStackCount; procedure WMStartCommandLineCompile(var Message: TMessage); message WM_StartCommandLineCompile; procedure WMStartCommandLineWizard(var Message: TMessage); message WM_StartCommandLineWizard; procedure WMStartNormally(var Message: TMessage); message WM_StartNormally; procedure WMDPIChanged(var Message: TMessage); message WM_DPICHANGED; procedure WMSettingChange(var Message: TMessage); message WM_SETTINGCHANGE; procedure WMSysColorChange(var Message: TMessage); message WM_SYSCOLORCHANGE; procedure WMThemeChanged(var Message: TMessage); message WM_THEMECHANGED; procedure WMUAHDrawMenu(var Message: TMessage); message WM_UAHDRAWMENU; procedure WMUAHDrawMenuItem(var Message: TMessage); message WM_UAHDRAWMENUITEM; procedure UAHDrawMenuBottomLine; procedure WMNCActivate(var Message: TMessage); message WM_NCACTIVATE; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; protected procedure WndProc(var Message: TMessage); override; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; function IsShortCut(var Message: TWMKey): Boolean; override; published property BorderStyle: TFormBorderStyle read GetBorderStyle write SetBorderStyle; end; var MainForm: TMainForm; CommandLineFilename, CommandLineWizardName: String; CommandLineCompile: Boolean; CommandLineWizard: Boolean; implementation uses ActiveX, Clipbrd, ShellApi, ShlObj, IniFiles, Registry, Consts, Types, UITypes, Math, StrUtils, WideStrUtils, TypInfo, PathFunc, Shared.CommonFunc.Vcl, Shared.CommonFunc, Shared.FileClass, IDE.Messages, NewUxTheme.TmSchema, BrowseFunc, IDE.HtmlHelpFunc, TaskbarProgressFunc, IDE.ImagesModule, {$IFDEF STATICCOMPILER} Compiler.Compile, {$ENDIF} IDE.OptionsForm, IDE.StartupForm, IDE.Wizard.WizardForm, IDE.SignToolsForm, Shared.ConfigIniFile, Shared.SignToolsFunc, IDE.InputQueryComboForm, IDE.MsgBoxDesignerForm, IDE.FilesDesignerForm, IDE.RegistryDesignerForm, IDE.Wizard.WizardFormRegistryHelper, Shared.CompilerInt; {$R *.DFM} const { Memos } MaxMemos = 22; { Includes the main and preprocessor output memos } FirstIncludedFilesMemoIndex = 1; { This is an index into FFileMemos } { Status bar panel indexes } spCaretPos = 0; spModified = 1; spEditMode = 2; spFindRegEx = 3; spHiddenFilesCount = 4; spCompileIcon = 5; spCompileProgress = 6; spExtraStatus = 7; { Output tab set indexes } tiCompilerOutput = 0; tiDebugOutput = 1; tiDebugCallStack = 2; tiFindResults = 3; LineStateGrowAmount = 4000; { TUpdatePanelMessage } constructor TUpdatePanelMessage.Create(const AMsg, AConfigIdent: String; const AConfigValue: Integer; const AColor: TColor); begin Msg := AMsg; ConfigIdent := AConfigIdent; ConfigValue := AConfigValue; Color := AColor; end; { TMainFormPopupMenu } type TMainFormPopupMenu = class(TPopupMenu) private FParentMenuItem: TMenuItem; public constructor Create(const AOwner: TComponent; const ParentMenuItem: TMenuItem); reintroduce; virtual; procedure Popup(X, Y: Integer); override; end; constructor TMainFormPopupMenu.Create(const AOwner: TComponent; const ParentMenuItem: TMenuItem); begin inherited Create(AOwner); FParentMenuItem := ParentMenuItem; end; procedure TMainFormPopupMenu.Popup(X, Y: Integer); var Form: TMainForm; begin { Show the existing main menu's submenu } Form := Owner as TMainForm; var OldVisible := FParentMenuItem.Visible; { See ApplyMenuBitmaps } FParentMenuItem.Visible := True; try TrackPopupMenu(FParentMenuItem.Handle, TPM_RIGHTBUTTON, X, Y, 0, Form.Handle, nil); finally FParentMenuItem.Visible := OldVisible; end; end; { TMainForm } function TMainForm.InitializeMemoBase(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit; begin Memo.Align := alClient; Memo.Font.Name := GetPreferredMemoFont; { Default font only, see ReadConfig } Memo.Font.Size := 10; Memo.ShowHint := True; Memo.Styler := FMemosStyler; Memo.PopupMenu := PopupMenu; Memo.OnCallTipArrowClick := MemoCallTipArrowClick; Memo.OnChange := MemoChange; Memo.OnCharAdded := MemoCharAdded; Memo.OnHintShow := MemoHintShow; Memo.OnKeyDown := MemoKeyDown; Memo.OnKeyPress := MemoKeyPress; Memo.OnMarginClick := MemoMarginClick; Memo.OnMarginRightClick := MemoMarginRightClick; Memo.OnModifiedChange := MemoModifiedChange; Memo.OnUpdateUI := MemoUpdateUI; Memo.OnZoom := MemoZoom; Memo.Parent := BodyPanel; Memo.SetAutoCompleteSeparators(InnoSetupStylerWordListSeparator, InnoSetupStylerWordListTypeSeparator); Memo.SetWordChars(Memo.GetDefaultWordChars+'#{}[]'); Memo.Theme := FTheme; Memo.Visible := False; Result := Memo; end; function TMainForm.InitializeFileMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit; begin InitializeMemoBase(Memo, PopupMenu); Memo.ChangeHistory := schMarkers; Memo.CompilerFileIndex := UnknownCompilerFileIndex; Memo.ErrorLine := -1; Memo.StepLine := -1; Result := Memo; end; function TMainForm.InitializeMainMemo(const Memo: TIDEScintFileEdit; const PopupMenu: TPopupMenu): TIDEScintFileEdit; begin InitializeFileMemo(Memo, PopupMenu); Memo.AcceptDroppedFiles := True; Memo.CompilerFileIndex := -1; Memo.OnDropFiles := MainMemoDropFiles; Memo.Used := True; Result := Memo; end; function TMainForm.InitializeNonFileMemo(const Memo: TIDEScintEdit; const PopupMenu: TPopupMenu): TIDEScintEdit; begin InitializeMemoBase(Memo, PopupMenu); Memo.ReadOnly := True; Result := Memo; end; constructor TMainForm.Create(AOwner: TComponent); procedure CheckUpdatePanelMessage(const Ini: TConfigIniFile; const ConfigIdent: String; const ConfigValueDefault, ConfigValueMinimum: Integer; const Msg: String; const Color: TColor); begin var ConfigValue := Ini.ReadInteger('UpdatePanel', ConfigIdent, ConfigValueDefault); if ConfigValue < ConfigValueMinimum then FUpdatePanelMessages.Add(TUpdatePanelMessage.Create(Msg, ConfigIdent, ConfigValueMinimum, Color)); end; procedure ReadConfig; var Ini: TConfigIniFile; WindowPlacement: TWindowPlacement; I: Integer; Memo: TIDEScintEdit; begin Ini := TConfigIniFile.Create; try { Menu check boxes state } ToolbarPanel.Visible := Ini.ReadBool('Options', 'ShowToolbar', True); StatusBar.Visible := Ini.ReadBool('Options', 'ShowStatusBar', True); FOptions.LowPriorityDuringCompile := Ini.ReadBool('Options', 'LowPriorityDuringCompile', False); { Configuration options } FOptions.ShowStartupForm := Ini.ReadBool('Options', 'ShowStartupForm', True); FOptions.UseWizard := Ini.ReadBool('Options', 'UseWizard', True); FOptions.Autosave := Ini.ReadBool('Options', 'Autosave', False); FOptions.MakeBackups := Ini.ReadBool('Options', 'MakeBackups', False); FOptions.FullPathInTitleBar := Ini.ReadBool('Options', 'FullPathInTitleBar', False); FOptions.UndoAfterSave := Ini.ReadBool('Options', 'UndoAfterSave', True); FOptions.PauseOnDebuggerExceptions := Ini.ReadBool('Options', 'PauseOnDebuggerExceptions', True); FOptions.RunAsDifferentUser := Ini.ReadBool('Options', 'RunAsDifferentUser', False); FOptions.AutoAutoComplete := Ini.ReadBool('Options', 'AutoComplete', True); FOptions.AutoCallTips := Ini.ReadBool('Options', 'AutoCallTips', True); FOptions.UseSyntaxHighlighting := Ini.ReadBool('Options', 'UseSynHigh', True); FOptions.ColorizeCompilerOutput := Ini.ReadBool('Options', 'ColorizeCompilerOutput', True); FOptions.UnderlineErrors := Ini.ReadBool('Options', 'UnderlineErrors', True); FOptions.HighlightWordAtCursorOccurrences := Ini.ReadBool('Options', 'HighlightWordAtCursorOccurrences', False); FOptions.HighlightSelTextOccurrences := Ini.ReadBool('Options', 'HighlightSelTextOccurrences', True); FOptions.CursorPastEOL := Ini.ReadBool('Options', 'EditorCursorPastEOL', False); FOptions.TabWidth := Ini.ReadInteger('Options', 'TabWidth', 2); FOptions.UseTabCharacter := Ini.ReadBool('Options', 'UseTabCharacter', False); FOptions.ShowWhiteSpace := Ini.ReadBool('Options', 'ShowWhiteSpace', False); FOptions.UseFolding := Ini.ReadBool('Options', 'UseFolding', True); FOptions.FindRegEx := Ini.ReadBool('Options', 'FindRegEx', False); FOptions.WordWrap := Ini.ReadBool('Options', 'WordWrap', False); FOptions.AutoIndent := Ini.ReadBool('Options', 'AutoIndent', True); FOptions.IndentationGuides := Ini.ReadBool('Options', 'IndentationGuides', True); FOptions.GutterLineNumbers := Ini.ReadBool('Options', 'GutterLineNumbers', False); FOptions.ShowPreprocessorOutput := Ini.ReadBool('Options', 'ShowPreprocessorOutput', True); FOptions.OpenIncludedFiles := Ini.ReadBool('Options', 'OpenIncludedFiles', True); I := Ini.ReadInteger('Options', 'KeyMappingType', Ord(GetDefaultKeyMappingType)); if (I >= 0) and (I <= Ord(High(TKeyMappingType))) then FOptions.KeyMappingType := TKeyMappingType(I); I := Ini.ReadInteger('Options', 'MemoKeyMappingType', Ord(GetDefaultMemoKeyMappingType)); if (I >= 0) and (I <= Ord(High(TIDEScintKeyMappingType))) then FOptions.MemoKeyMappingType := TIDEScintKeyMappingType(I); I := Ini.ReadInteger('Options', 'ThemeType', Ord(GetDefaultThemeType)); if (I >= 0) and (I <= Ord(High(TThemeType))) then FOptions.ThemeType := TThemeType(I); FMainMemo.Font.Name := Ini.ReadString('Options', 'EditorFontName', FMainMemo.Font.Name); FMainMemo.Font.Size := Ini.ReadInteger('Options', 'EditorFontSize', 10); FMainMemo.Font.Charset := Ini.ReadInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset); FMainMemo.Zoom := Ini.ReadInteger('Options', 'Zoom', 0); { MemoZoom will zoom the other memos } for Memo in FMemos do if Memo <> FMainMemo then Memo.Font := FMainMemo.Font; { UpdatePanel visibility } CheckUpdatePanelMessage(Ini, 'KnownVersion', 0, Integer(FCompilerVersion.BinVersion), 'Your version of Inno Setup has been updated! See what''s new.', $ABE3AB); //MGreen with HSL lightness changed from 40% to 78% CheckUpdatePanelMessage(Ini, 'VSCodeMemoKeyMap', 0, 1, 'VS Code-style editor shortcuts added! Use the Editor Keys option in Options dialog.', $FFD399); //MBlue with HSL lightness changed from 42% to 80% UpdateUpdatePanel; { Debug options } FOptions.ShowCaretPosition := Ini.ReadBool('Options', 'ShowCaretPosition', False); if FOptions.ShowCaretPosition then begin StatusBar.Panels[spCaretPos].Width := MulDiv(StatusBar.Panels[spCaretPos].Width, 7, 2); StatusBar.Panels[spCaretPos].Alignment := taLeftJustify; end; SyncEditorOptions; UpdateNewMainFileButtons; UpdateKeyMapping; UpdateTheme; UpdateFindRegExUI; { Window state } WindowPlacement.length := SizeOf(WindowPlacement); GetWindowPlacement(Handle, @WindowPlacement); WindowPlacement.showCmd := SW_HIDE; { the form isn't Visible yet } WindowPlacement.rcNormalPosition.Left := Ini.ReadInteger('State', 'WindowLeft', WindowPlacement.rcNormalPosition.Left); WindowPlacement.rcNormalPosition.Top := Ini.ReadInteger('State', 'WindowTop', WindowPlacement.rcNormalPosition.Top); WindowPlacement.rcNormalPosition.Right := Ini.ReadInteger('State', 'WindowRight', WindowPlacement.rcNormalPosition.Left + Width); WindowPlacement.rcNormalPosition.Bottom := Ini.ReadInteger('State', 'WindowBottom', WindowPlacement.rcNormalPosition.Top + Height); SetWindowPlacement(Handle, @WindowPlacement); { Note: Must set WindowState *after* calling SetWindowPlacement, since TCustomForm.WMSize resets WindowState } if Ini.ReadBool('State', 'WindowMaximized', False) then WindowState := wsMaximized; { Note: Don't call UpdateStatusPanelHeight here since it clips to the current form height, which hasn't been finalized yet } { StatusPanel height } StatusPanel.Height := ToCurrentPPI(Ini.ReadInteger('State', 'StatusPanelHeight', (10 * FromCurrentPPI(DebugOutputList.ItemHeight) + 4) + FromCurrentPPI(OutputTabSet.Height))); finally Ini.Free; end; FOptionsLoaded := True; end; var I: Integer; NewItem: TMenuItem; PopupMenu: TPopupMenu; Memo: TIDEScintEdit; begin inherited; {$IFNDEF STATICCOMPILER} FCompilerVersion := ISDllGetVersion; {$ELSE} FCompilerVersion := ISGetVersion; {$ENDIF} FModifiedAnySinceLastCompile := True; InitFormFont(Self); { For some reason, if AutoScroll=False is set on the form Delphi ignores the 'poDefault' Position setting } AutoScroll := False; { Append the shortcut key text to the Edit items. Don't actually set the ShortCut property because we don't want the key combinations having an effect when Memo doesn't have the focus. } SetFakeShortCut(EUndo, Ord('Z'), [ssCtrl]); SetFakeShortCut(ERedo, Ord('Y'), [ssCtrl]); SetFakeShortCut(ECut, Ord('X'), [ssCtrl]); SetFakeShortCut(ECopy, Ord('C'), [ssCtrl]); SetFakeShortCut(EPaste, Ord('V'), [ssCtrl]); SetFakeShortCut(ESelectAll, Ord('A'), [ssCtrl]); SetFakeShortCut(EDelete, VK_DELETE, []); SetFakeShortCutText(VZoomIn, SmkcCtrl + 'Num +'); { These zoom shortcuts are handled by Scintilla and only support the active memo, unlike the menu items which work on all memos } SetFakeShortCutText(VZoomOut, SmkcCtrl + 'Num -'); SetFakeShortCutText(VZoomReset, SmkcCtrl + 'Num /'); { Use fake Esc shortcut for Stop Compile so it doesn't conflict with the editor's autocompletion list } SetFakeShortCut(BStopCompile, VK_ESCAPE, []); { Use fake Ctrl+F4 shortcut for VCloseCurrentTab2 because VCloseCurrentTab already has the real one } SetFakeShortCut(VCloseCurrentTab2, VK_F4, [ssCtrl]); { Use fake Ctrl+C and Ctrl+A shortcuts for OutputListPopupMenu's items so they don't conflict with the editor which also uses fake shortcuts for these } SetFakeShortCut(POutputListCopy, Ord('C'), [ssCtrl]); SetFakeShortCut(POutputListSelectAll, Ord('A'), [ssCtrl]); { Set real shortcut on TOptions which can't be set at design time } TOptions.ShortCut := ShortCut(VK_OEM_COMMA, [ssCtrl]); PopupMenu := TMainFormPopupMenu.Create(Self, EMenu); FMemosStyler := TInnoSetupStyler.Create(Self); FMemosStyler.ISPPInstalled := ISPPInstalled; FTheme := TTheme.Create; InitFormThemeInit(FTheme); ToolBarPanel.ParentBackground := False; UpdatePanel.ParentBackground := False; UpdatePanelDonateImage.Hint := RemoveAccelChar(HDonate.Caption); UpdateImages; FMemos := TList.Create; FMainMemo := InitializeMainMemo(TIDEScintFileEdit.Create(Self), PopupMenu); FMemos.Add(FMainMemo); FPreprocessorOutputMemo := InitializeNonFileMemo(TIDEScintEdit.Create(Self), PopupMenu); FMemos.Add(FPreprocessorOutputMemo); for I := FMemos.Count to MaxMemos-1 do FMemos.Add(InitializeFileMemo(TIDEScintFileEdit.Create(Self), PopupMenu)); FFileMemos := TList.Create; for Memo in FMemos do if Memo is TIDEScintFileEdit then FFileMemos.Add(TIDEScintFileEdit(Memo)); FHiddenFiles := TStringList.Create(dupError, True, True); FActiveMemo := FMainMemo; FActiveMemo.Visible := True; FErrorMemo := FMainMemo; FStepMemo := FMainMemo; UpdateMarginsAndSquigglyAndCaretWidths; FMemosStyler.Theme := FTheme; MemosTabSet.PopupMenu := TMainFormPopupMenu.Create(Self, MemosTabSetPopupMenu); FFirstTabSelectShortCut := ShortCut(Ord('1'), [ssCtrl]); FLastTabSelectShortCut := ShortCut(Ord('9'), [ssCtrl]); FNavStacks := TIDEScintEditNavStacks.Create; UpdateNavButtons; FCurrentNavItem.Invalidate; BackNavButton.Style := tbsDropDown; BackNavButton.DropdownMenu := TMainFormPopupMenu.Create(Self, NavPopupMenu); PopupMenu := TMainFormPopupMenu.Create(Self, OutputListPopupMenu); CompilerOutputList.PopupMenu := PopupMenu; DebugOutputList.PopupMenu := PopupMenu; DebugCallStackList.PopupMenu := PopupMenu; FindResultsList.PopupMenu := PopupMenu; UpdateOutputTabSetListsItemHeightAndDebugTimeWidth; Application.HintShortPause := 0; Application.OnException := AppOnException; Application.OnActivate := AppOnActivate; Application.OnIdle := AppOnIdle; FMRUMainFilesList := TStringList.Create; for I := 0 to High(FMRUMainFilesMenuItems) do begin NewItem := TMenuItem.Create(Self); NewItem.OnClick := FMRUClick; FRecent.Insert(I, NewItem); FMRUMainFilesMenuItems[I] := NewItem; end; FMRUParametersList := TStringList.Create; FSignTools := TStringList.Create; FFindResults := TFindResults.Create; FIncludedFiles := TIncludedFiles.Create; UpdatePreprocMemos; FDebugTarget := dtSetup; UpdateTargetMenu; UpdateCaption; FMenuDarkBackgroundBrush := TBrush.Create; FMenuDarkHotOrSelectedBrush := TBrush.Create; LightToolbarVirtualImageList.AutoFill := True; ThemedMarkersAndACVirtualImageList.AutoFill := True; UpdateThemeData(True); FMenuBitmaps := TMenuBitmaps.Create; FMenuBitmapsSize.cx := 0; FMenuBitmapsSize.cy := 0; FKeyMappedMenus := TKeyMappedMenus.Create; FCallTipState.MaxCallTips := 1; { Just like SciTE 5.50 } FUpdatePanelMessages := TUpdatePanelMessages.Create; if CommandLineCompile then begin ReadSignTools(FSignTools); PostMessage(Handle, WM_StartCommandLineCompile, 0, 0) end else if CommandLineWizard then begin { Stop Delphi from showing the compiler form } Application.ShowMainForm := False; { Show wizard form later } PostMessage(Handle, WM_StartCommandLineWizard, 0, 0); end else begin ReadConfig; { Calls UpdateTheme } ReadSignTools(FSignTools); PostMessage(Handle, WM_StartNormally, 0, 0); end; end; destructor TMainForm.Destroy; procedure SaveConfig; var Ini: TConfigIniFile; WindowPlacement: TWindowPlacement; begin Ini := TConfigIniFile.Create; try { Theme state - can change without opening the options } Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see TOptionsClick } { Menu check boxes state } Ini.WriteBool('Options', 'ShowToolbar', ToolbarPanel.Visible); Ini.WriteBool('Options', 'ShowStatusBar', StatusBar.Visible); Ini.WriteBool('Options', 'LowPriorityDuringCompile', FOptions.LowPriorityDuringCompile); { Window state } WindowPlacement.length := SizeOf(WindowPlacement); GetWindowPlacement(Handle, @WindowPlacement); Ini.WriteInteger('State', 'WindowLeft', WindowPlacement.rcNormalPosition.Left); Ini.WriteInteger('State', 'WindowTop', WindowPlacement.rcNormalPosition.Top); Ini.WriteInteger('State', 'WindowRight', WindowPlacement.rcNormalPosition.Right); Ini.WriteInteger('State', 'WindowBottom', WindowPlacement.rcNormalPosition.Bottom); { The GetWindowPlacement docs claim that "flags" is always zero. Fortunately, that's wrong. WPF_RESTORETOMAXIMIZED is set when the window is either currently maximized, or currently minimized from a previous maximized state. } Ini.WriteBool('State', 'WindowMaximized', WindowPlacement.flags and WPF_RESTORETOMAXIMIZED <> 0); Ini.WriteInteger('State', 'StatusPanelHeight', FromCurrentPPI(StatusPanel.Height)); { Zoom state } Ini.WriteInteger('Options', 'Zoom', FMainMemo.Zoom); { Only saves the main memo's zoom } finally Ini.Free; end; end; begin UpdateThemeData(False); Application.OnActivate := nil; Application.OnIdle := nil; if FOptionsLoaded and not (CommandLineCompile or CommandLineWizard) then SaveConfig; if FDevMode <> 0 then GlobalFree(FDevMode); if FDevNames <> 0 then GlobalFree(FDevNames); FUpdatePanelMessages.Free; FNavStacks.Free; FKeyMappedMenus.Free; FMenuBitmaps.Free; FMenuDarkBackgroundBrush.Free; FMenuDarkHotOrSelectedBrush.Free; FTheme.Free; DestroyDebugInfo; FIncludedFiles.Free; FFindResults.Free; FSignTools.Free; FMRUParametersList.Free; FMRUMainFilesList.Free; FFileMemos.Free; FHiddenFiles.Free; FMemos.Free; inherited; end; function TMainForm.GetBorderStyle: TFormBorderStyle; begin Result := inherited BorderStyle; end; procedure TMainForm.SetBorderStyle(Value: TFormBorderStyle); begin { Hack: To stop the Delphi IDE from adding Explicit* properties to the .dfm file every time the unit is saved, we set BorderStyle=bsNone on the form. At run-time, ignore that setting so that BorderStyle stays at the default value, bsSizeable. It would be simpler to change BorderStyle from bsNone to bsSizeable in the form's constructor, but it doesn't quite work: when a form's handle is created while BorderStyle=bsNone, Position=poDefault behaves like poDefaultPosOnly (see TCustomForm.CreateParams). } if Value <> bsNone then inherited BorderStyle := Value; end; class procedure TMainForm.AppOnException(Sender: TObject; E: Exception); begin AppMessageBox(PChar(AddPeriod(E.Message)), SCompilerFormCaption, MB_OK or MB_ICONSTOP); end; class procedure TMainForm.AppOnGetActiveFormHandle(var AHandle: HWND); begin { As of Delphi 11.3, the default code in TApplication.GetActiveFormHandle (which runs after this handler) calls GetActiveWindow, and if that returns 0, it calls GetLastActivePopup(Application.Handle). The problem is that when the application isn't in the foreground, GetActiveWindow returns 0, and when MainFormOnTaskBar=True, the GetLastActivePopup call normally just returns Application.Handle (since there are no popups owned by the application window). So if the application calls Application.MessageBox while it isn't in the foreground, that message box will be owned by Application.Handle, not by the last-active window as it should be. That can lead to the message box falling behind the main form in z-order. To rectify that, when no window is active and MainFormOnTaskBar=True, we fall back to returning the handle of the main form's last active popup, which is the window that would be activated if the main form's taskbar button were clicked. (If Application.Handle is active, we treat that the same as no active window because Application.Handle shouldn't be the owner of any windows when MainFormOnTaskBar=True.) If there is no assigned main form or if MainFormOnTaskBar=False, then we fall back to the default handling. } if Application.MainFormOnTaskBar then begin AHandle := GetActiveWindow; if ((AHandle = 0) or (AHandle = Application.Handle)) and Assigned(Application.MainForm) and Application.MainForm.HandleAllocated then AHandle := GetLastActivePopup(Application.MainFormHandle); end; end; procedure TMainForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer); begin UpdateImages; UpdateMarginsAndAutoCompleteIcons; UpdateMarginsAndSquigglyAndCaretWidths; UpdateOutputTabSetListsItemHeightAndDebugTimeWidth; UpdateStatusPanelHeight(StatusPanel.Height); end; procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if IsWindowEnabled(Handle) then CanClose := ConfirmCloseFile(True) else { CloseQuery is also called by the VCL when a WM_QUERYENDSESSION message is received. Don't display message box if a modal dialog is already displayed. } CanClose := False; end; procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin var AShortCut := ShortCut(Key, Shift); if (AShortCut = VK_ESCAPE) and BStopCompile.Enabled then begin Key := 0; { Intentionally only done when BStopCompile is enabled to allow the memo to process it instead } BStopCompileClick(Self) end else if (AShortCut = FBackNavButtonShortCut) or ((FBackNavButtonShortCut2 <> 0) and (AShortCut = FBackNavButtonShortCut2)) then begin Key := 0; if BackNavButton.Enabled then BackNavButtonClick(Self); end else if (AShortCut = FForwardNavButtonShortCut) or ((FForwardNavButtonShortCut2 <> 0) and (AShortCut = FForwardNavButtonShortCut2)) then begin Key := 0; if ForwardNavButton.Enabled then ForwardNavButtonClick(Self); end else if (AShortCut >= FFirstTabSelectShortCut) and (AShortCut <= FLastTabSelectShortCut) then begin Key := 0; if MemosTabSet.Visible then begin var TabIndex := AShortCut - FFirstTabSelectShortCut; if TabIndex < 8 then begin if TabIndex < MemosTabSet.Tabs.Count then MemosTabSet.TabIndex := TabIndex; end else { Ctrl+9 = Select last tab } MemosTabSet.TabIndex := MemosTabSet.Tabs.Count-1; end; end else if AShortCut = FCompileShortCut2 then begin Key := 0; if BCompile.Enabled then BCompileClick(Self); end else if (Key = VK_F6) and not (ssAlt in Shift) then begin { Toggle focus between the active memo and the active bottom pane } Key := 0; if ActiveControl <> FActiveMemo then ActiveControl := FActiveMemo else if StatusPanel.Visible then begin case OutputTabSet.TabIndex of tiCompilerOutput: ActiveControl := CompilerOutputList; tiDebugOutput: ActiveControl := DebugOutputList; tiDebugCallStack: ActiveControl := DebugCallStackList; tiFindResults: ActiveControl := FindResultsList; end; end; end; end; procedure TMainForm.MemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure SimplifySelection(const AMemo: TIDEScintEdit); begin { The built in Esc (SCI_CANCEL) simply drops all additional selections and does not empty the main selection, It doesn't matter if Esc is pressed once or twice. Implement our own behaviour, same as VSCode. Also see https://github.com/microsoft/vscode/issues/118835. } if AMemo.SelectionCount > 1 then AMemo.RemoveAdditionalSelections else if not AMemo.SelEmpty then AMemo.SetEmptySelection; AMemo.ScrollCaretIntoView; end; procedure AddCursor(const AMemo: TIDEScintEdit; const Up: Boolean); begin { Does not try to keep the main selection. } var Selections: TScintCaretAndAnchorList := nil; var VirtualSpaces: TScintCaretAndAnchorList := nil; try Selections := TScintCaretAndAnchorList.Create; VirtualSpaces := TScintCaretAndAnchorList.Create; { Get all the virtual spaces as well before we start doing modifications } AMemo.GetSelections(Selections, VirtualSpaces); for var I := 0 to Selections.Count-1 do begin var Selection := Selections[I]; var LineCaret := AMemo.GetLineFromPosition(Selection.CaretPos); var LineAnchor := AMemo.GetLineFromPosition(Selection.AnchorPos); if LineCaret = LineAnchor then begin { Add selection with same caret and anchor offsets one line up or down. } var OtherLine := LineCaret + IfThen(Up, -1, 1);; if (OtherLine < 0) or (OtherLine >= AMemo.Lines.Count) then Continue { Already at the top or bottom, can't add } else begin var LineStartPos := AMemo.GetPositionFromLine(LineCaret); var CaretCharacterCount := AMemo.GetCharacterCount(LineStartPos, Selection.CaretPos) + VirtualSpaces[I].CaretPos; var AnchorCharacterCount := AMemo.GetCharacterCount(LineStartPos, Selection.AnchorPos) + VirtualSpaces[I].AnchorPos; var OtherLineStart := AMemo.GetPositionFromLine(OtherLine); var MaxCharacterCount := AMemo.GetCharacterCount(OtherLineStart, AMemo.GetLineEndPosition(OtherLine)); var NewCaretCharacterCount := CaretCharacterCount; var NewCaretVirtualSpace := 0; var NewAnchorCharacterCount := AnchorCharacterCount; var NewAnchorVirtualSpace := 0; if NewCaretCharacterCount > MaxCharacterCount then begin NewCaretVirtualSpace := NewCaretCharacterCount - MaxCharacterCount; NewCaretCharacterCount := MaxCharacterCount; end; if NewAnchorCharacterCount > MaxCharacterCount then begin NewAnchorVirtualSpace := NewAnchorCharacterCount - MaxCharacterCount; NewAnchorCharacterCount := MaxCharacterCount; end; var NewSelection: TScintCaretAndAnchor; NewSelection.CaretPos := AMemo.GetPositionRelative(OtherLineStart, NewCaretCharacterCount); NewSelection.AnchorPos := AMemo.GetPositionRelative(OtherLineStart, NewAnchorCharacterCount); { AddSelection trims selections except for the main selection so we need to check that ourselves unfortunately. Not doing a check gives a problem when you AddCursor two times starting with an empty single selection. The result will be 4 cursors, with 2 of them in the same place. The check below fixes this but not other cases when there's only partial overlap and Scintilla still behaves weird. The check also doesn't handle virtual space which is why we ultimately don't set virtual space: it leads to duplicate selections. } var MainSelection := AMemo.Selection; if not NewSelection.Range.Within(AMemo.Selection) then begin AMemo.AddSelection(NewSelection.CaretPos, NewSelection.AnchorPos); { if svsUserAccessible in FActiveMemo.VirtualSpaceOptions then begin var MainSel := AMemo.MainSelection; AMemo.SelectionCaretVirtualSpace[MainSel] := NewCaretVirtualSpace; AMemo.SelectionAnchorVirtualSpace[MainSel] := NewAnchorVirtualSpace; end; } end; end; end else begin { Extend multiline selection up or down. This is not the same as LineExtendUp/Down because those can shrink instead of extend. } var CaretBeforeAnchor := Selection.CaretPos < Selection.AnchorPos; var Down := not Up; var LineStartOrEnd, StartOrEndPos, VirtualSpace: Integer; { Does it start (when going up) or end (when going down) at the caret or the anchor? } if (Up and CaretBeforeAnchor) or (Down and not CaretBeforeAnchor) then begin LineStartOrEnd := LineCaret; StartOrEndPos := Selection.CaretPos; VirtualSpace := VirtualSpaces[I].CaretPos; end else begin LineStartOrEnd := LineAnchor; StartOrEndPos := Selection.AnchorPos; VirtualSpace := VirtualSpaces[I].AnchorPos; end; var NewStartOrEndPos: Integer; var NewVirtualSpace := 0; { Go up or down one line or to the start or end of the document } if (Up and (LineStartOrEnd > 0)) or (Down and (LineStartOrEnd < AMemo.Lines.Count-1)) then begin var CharacterCount := AMemo.GetCharacterCount(AMemo.GetPositionFromLine(LineStartOrEnd), StartOrEndPos) + VirtualSpace; var OtherLine := LineStartOrEnd + IfThen(Up, -1, 1); var OtherLineStart := AMemo.GetPositionFromLine(OtherLine); var MaxCharacterCount := AMemo.GetCharacterCount(OtherLineStart, AMemo.GetLineEndPosition(OtherLine)); var NewCharacterCount := CharacterCount; if NewCharacterCount > MaxCharacterCount then begin NewVirtualSpace := NewCharacterCount - MaxCharacterCount; NewCharacterCount := MaxCharacterCount; end; NewStartOrEndPos := AMemo.GetPositionRelative(OtherLineStart, NewCharacterCount); end else NewStartOrEndPos := IfThen(Up, 0, AMemo.GetPositionFromLine(AMemo.Lines.Count)); { Move the caret or the anchor up or down to extend the selection } if (Up and CaretBeforeAnchor) or (Down and not CaretBeforeAnchor) then begin AMemo.SelectionCaretPosition[I] := NewStartOrEndPos; if svsUserAccessible in FActiveMemo.VirtualSpaceOptions then AMemo.SelectionCaretVirtualSpace[I] := NewVirtualSpace; end else begin AMemo.SelectionAnchorPosition[I] := NewStartOrEndPos; if svsUserAccessible in FActiveMemo.VirtualSpaceOptions then AMemo.SelectionAnchorVirtualSpace[I] := NewVirtualSpace; end; end; end; finally VirtualSpaces.Free; Selections.Free; end; end; procedure AddCursorsToLineEnds(const AMemo: TIDEScintEdit); begin { Does not try to keep the main selection. Otherwise behaves the same as observed in Visual Studio Code, see comments. } var Selections: TScintCaretAndAnchorList := nil; var VirtualSpaces: TScintCaretAndAnchorList := nil; try Selections := TScintCaretAndAnchorList.Create; VirtualSpaces := TScintCaretAndAnchorList.Create; AMemo.GetSelections(Selections, VirtualSpaces); { First remove all empty selections } for var I := Selections.Count-1 downto 0 do begin var Selection := Selections[I]; var VirtualSpace := VirtualSpaces[I]; if (Selection.CaretPos + VirtualSpace.CaretPos) = (Selection.AnchorPos + VirtualSpace.AnchorPos) then begin Selections.Delete(I); VirtualSpaces.Delete(I); end; end; { If all selections were empty do nothing } if Selections.Count = 0 then Exit; { Handle non empty selections } for var I := Selections.Count-1 downto 0 do begin var Selection := Selections[I]; var Line1 := AMemo.GetLineFromPosition(Selection.CaretPos); var Line2 := AMemo.GetLineFromPosition(Selection.AnchorPos); var SelSingleLine := Line1 = Line2; if SelSingleLine then begin { Single line selections are updated into empty selection at end of selection } var VirtualSpace := VirtualSpaces[I]; if Selection.CaretPos + VirtualSpace.CaretPos > Selection.AnchorPos + VirtualSpace.AnchorPos then begin Selection.AnchorPos := Selection.CaretPos; VirtualSpace.AnchorPos := VirtualSpace.CaretPos; end else begin Selection.CaretPos := Selection.AnchorPos; VirtualSpace.CaretPos := VirtualSpace.AnchorPos; end; Selections[I] := Selection; VirtualSpaces[I] := VirtualSpace; end else begin { Multiline selections are replaced by empty selections at each end of line } if Line1 > Line2 then begin var TmpLine := Line1; Line1 := Line2; Line2 := TmpLine; end; { Ignore last line if the selection doesn't really select anything on that line } if Selection.Range.EndPos = AMemo.GetPositionFromLine(Line2) then Dec(Line2); for var Line := Line1 to Line2 do begin Selection.CaretPos := AMemo.GetLineEndPosition(Line); Selection.AnchorPos := Selection.CaretPos; Selections.Add(Selection); VirtualSpaces.Add(TScintCaretAndAnchor.Create(0, 0)); end; Selections.Delete(I); VirtualSpaces.Delete(I); end; end; { Send updated selections to memo } for var I := 0 to Selections.Count-1 do begin var Selection := Selections[I]; var VirtualSpace := VirtualSpaces[I]; if I = 0 then AMemo.SetSingleSelection(Selection.CaretPos, Selection.AnchorPos) else AMemo.AddSelection(Selection.CaretPos, Selection.AnchorPos); AMemo.SelectionCaretVirtualSpace[I] := VirtualSpaces[I].CaretPos; AMemo.SelectionAnchorVirtualSpace[I] := VirtualSpaces[I].AnchorPos; end; finally VirtualSpaces.Free; Selections.Free; end; end; begin if (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then begin var Memo := Sender as TIDEScintEdit; { Make sure we don't break the special rectangular select shortcuts } if Shift * [ssShift, ssAlt, ssCtrl] <> Memo.GetRectExtendShiftState(True) then begin if Memo.SelectionMode in [ssmRectangular, ssmThinRectangular] then begin { Allow left/right/etc. navigation with rectangular selection, see https://sourceforge.net/p/scintilla/feature-requests/1275/ and https://sourceforge.net/p/scintilla/bugs/2412/#cb37 Notepad++ calls this "Enable Column Selection to Multi-editing" which is on by default and in VSCode and VS it's also on by default. } Memo.SelectionMode := ssmStream; end; end; { Key is not cleared to allow Scintilla to do the actual handling } end; if Key = VK_F1 then begin Key := 0; var HelpFile := GetHelpFile; if Assigned(HtmlHelp) then begin HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_DISPLAY_TOPIC, 0); var S := FActiveMemo.WordAtCaret; if S <> '' then begin var KLink: THH_AKLINK; FillChar(KLink, SizeOf(KLink), 0); KLink.cbStruct := SizeOf(KLink); KLink.pszKeywords := PChar(S); KLink.fIndexOnFail := True; HtmlHelp(GetDesktopWindow, PChar(HelpFile), HH_KEYWORD_LOOKUP, DWORD(@KLink)); end; end; end else if ((Key = Ord('V')) or (Key = VK_INSERT)) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssCtrl]) then begin if FActiveMemo.CanPaste then if MultipleSelectionPasteFromClipboard(FActiveMemo) then Key := 0; end else if (Key = VK_SPACE) and (Shift * [ssShift, ssAlt, ssCtrl] = [ssShift, ssCtrl]) then begin Key := 0; { Based on SciTE 5.50's SciTEBase::MenuCommand IDM_SHOWCALLTIP } if FActiveMemo.CallTipActive then begin FCallTipState.CurrentCallTip := IfThen(FCallTipState.CurrentCallTip + 1 = FCallTipState.MaxCallTips, 0, FCallTipState.CurrentCallTip + 1); UpdateCallTipFunctionDefinition; end else begin FCallTipState.BraceCount := 1; { Missing in SciTE, see https://sourceforge.net/p/scintilla/bugs/2446/ } InitiateCallTip(#0); end; end else begin var AShortCut := ShortCut(Key, Shift); { Check if the memo keymap wants us to handle the shortcut but first check the menu keymap didn't already claim the same shortcut. Other shortcuts (which are always same and not set by the menu keymap) are assumed to never conflict. } if not FKeyMappedMenus.ContainsKey(AShortCut) then begin var ComplexCommand := FActiveMemo.GetComplexCommand(AShortCut); if ComplexCommand <> ccNone then begin if Key <> VK_ESCAPE then { Allow Scintilla to see Esc } Key := 0; case ComplexCommand of ccSelectNextOccurrence: ESelectNextOccurrenceClick(Self); ccSelectAllOccurrences: ESelectAllOccurrencesClick(Self); ccSelectAllFindMatches: ESelectAllFindMatchesClick(Self); ccFoldLine: EFoldOrUnfoldLineClick(EFoldLine); ccUnfoldLine: EFoldOrUnfoldLineClick(EUnfoldLine); ccSimplifySelection: SimplifySelection(FActiveMemo); ccToggleLinesComment: EToggleLinesCommentClick(Self); //GetCompexCommand already checked ReadOnly for us ccAddCursorUp, ccAddCursorDown: AddCursor(FActiveMemo, ComplexCommand = ccAddCursorUp); ccBraceMatch: EBraceMatchClick(Self); ccAddCursorsToLineEnds: AddCursorsToLineEnds(FActiveMemo); else raise Exception.Create('Unknown ComplexCommand'); end; end; end; end; end; procedure TMainForm.MemoKeyPress(Sender: TObject; var Key: Char); begin if ((Key = #9) or (Key = ' ')) and (GetKeyState(VK_CONTROL) < 0) then begin { About #9, as Wikipedia explains: "The most known and common tab is a horizontal tabulation <..> and may be referred to as Ctrl+I." Ctrl+I is (just like in Visual Studio Code) our alternative code completion character because Ctrl+Space is used by the Chinese IME and Alt+Right is used for the forward button. So that's why we handle #9 here. Doesn't mean Ctrl+Tab doesn't work: it doesnt trigger KeyPress, even if it wasn't a menu shortcut for Next Tab (which it is). } InitiateAutoComplete(#0); Key := #0; end else if (Key <= #31) or (Key = #127) then begin { Prevent "control characters" from being entered in text. Don't need to be concerned about #9 or #10 or #13 etc here. Based on Notepad++'s WM_CHAR handling in ScintillaEditView.cpp. Also don't need to be concerned about shortcuts like Ctrl+Shift+- which equals #31. } Key := #0 end; end; procedure TMainForm.FormResize(Sender: TObject); begin { Make sure the status panel's height is decreased if necessary in response to the form's height decreasing } if StatusPanel.Visible then UpdateStatusPanelHeight(StatusPanel.Height); end; procedure TMainForm.WndProc(var Message: TMessage); begin { Without this, the status bar's owner drawn panels sometimes get corrupted and show menu items instead. See: http://groups.google.com/group/borland.public.delphi.vcl.components.using/browse_thread/thread/e4cb6c3444c70714 } with Message do case Msg of WM_DRAWITEM: with PDrawItemStruct(Message.LParam)^ do if (CtlType = ODT_MENU) and not IsMenu(hwndItem) then CtlType := ODT_STATIC; end; inherited end; function TMainForm.IsShortCut(var Message: TWMKey): Boolean; begin { Key messages are forwarded by the VCL to the main form for ShortCut processing. In Delphi 5+, however, this happens even when a TFindDialog is active, causing Ctrl+V/Esc/etc. to be intercepted by the main form. Work around this by always returning False when not Active. } if Active then Result := inherited IsShortCut(Message) else Result := False; end; procedure TMainForm.UpdateCaption; var NewCaption: String; begin if FMainMemo.Filename = '' then NewCaption := GetFileTitle(FMainMemo.Filename) else begin if FOptions.FullPathInTitleBar then NewCaption := FMainMemo.Filename else NewCaption := GetDisplayFilename(FMainMemo.Filename); end; NewCaption := NewCaption + ' - ' + SCompilerFormCaption + ' ' + String(FCompilerVersion.Version); if FCompiling then NewCaption := NewCaption + ' [Compiling]' else if FDebugging then begin if not FPaused then NewCaption := NewCaption + ' [Running]' else NewCaption := NewCaption + ' [Paused]'; end; Caption := NewCaption; if not CommandLineWizard then Application.Title := NewCaption; end; procedure TMainForm.UpdateNewMainFileButtons; begin if FOptions.UseWizard then begin FNewMainFile.Caption := '&New...'; FNewMainFile.OnClick := FNewMainFileUserWizardClick; NewMainFileButton.OnClick := FNewMainFileUserWizardClick; end else begin FNewMainFile.Caption := '&New'; FNewMainFile.OnClick := FNewMainFileClick; NewMainFileButton.OnClick := FNewMainFileClick; end; end; procedure TMainForm.NewMainFile; var Memo: TIDEScintFileEdit; begin HideError; FUninstExe := ''; if FDebugTarget <> dtSetup then begin FDebugTarget := dtSetup; UpdateTargetMenu; end; FHiddenFiles.Clear; InvalidateStatusPanel(spHiddenFilesCount); for Memo in FFileMemos do if Memo.Used then Memo.BreakPoints.Clear; DestroyDebugInfo; FMainMemo.Filename := ''; UpdateCaption; FMainMemo.SaveEncoding := seUTF8WithoutBOM; FMainMemo.Lines.Clear; FModifiedAnySinceLastCompile := True; FPreprocessorOutput := ''; FIncludedFiles.Clear; UpdatePreprocMemos; FMainMemo.ClearUndo; FNavStacks.Clear; UpdateNavButtons; FCurrentNavItem.Invalidate; end; { Breakpoints are preserved on a per-file basis } procedure TMainForm.LoadBreakPointLinesAndUpdateLineMarkers(const AMemo: TIDEScintFileEdit); begin if AMemo.BreakPoints.Count <> 0 then raise Exception.Create('AMemo.BreakPoints.Count <> 0'); { NewMainFile or OpenFile should have cleared these } try var HadSkippedBreakPoint := False; var Strings := TStringList.Create; try LoadBreakPointLines(AMemo.FileName, Strings); for var LineAsString in Strings do begin var Line := LineAsString.ToInteger; if Line < AMemo.Lines.Count then AMemo.BreakPoints.Add(Line) else HadSkippedBreakPoint := True; end; finally Strings.Free; end; for var Line in AMemo.BreakPoints do UpdateLineMarkers(AMemo, Line); { If there were breakpoints beyond the end of file get rid of them so they don't magically reappear on a reload of an externally edited and grown file } if HadSkippedBreakPoint then BuildAndSaveBreakPointLines(AMemo); except { Ignore any exceptions } end; end; procedure TMainForm.BuildAndSaveBreakPointLines(const AMemo: TIDEScintFileEdit); begin try if AMemo.FileName <> '' then begin var Strings := TStringList.Create; try for var Line in AMemo.BreakPoints do Strings.Add(Line.ToString); SaveBreakPointLines(AMemo.FileName, Strings); finally Strings.Free; end; end; except { Handle exceptions locally; failure to save the breakpoint lines list should not be a fatal error } Application.HandleException(Self); end; end; { Known included and hidden files are preserved on a per-main-file basis } procedure TMainForm.LoadKnownIncludedAndHiddenFilesAndUpdateMemos; begin if FIncludedFiles.Count <> 0 then raise Exception.Create('FIncludedFiles.Count <> 0'); { NewMainFile should have cleared these } try if AFilename <> '' then begin var Strings := TStringList.Create; try LoadKnownIncludedAndHiddenFiles(FMainMemo.FileName, Strings, FHiddenFiles); if Strings.Count > 0 then begin try for var Filename in Strings do begin var IncludedFile := TIncludedFile.Create; IncludedFile.Filename := Filename; IncludedFile.CompilerFileIndex := UnknownCompilerFileIndex; IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename, @IncludedFile.LastWriteTime); FIncludedFiles.Add(IncludedFile); end; finally UpdatePreprocMemos; end; end; finally Strings.Free; end; end; except { Ignore any exceptions } end; end; procedure TMainForm.BuildAndSaveKnownIncludedAndHiddenFiles; begin try if FMainMemo.FileName <> '' then begin var Strings := TStringList.Create; try for var IncludedFile in FIncludedFiles do Strings.Add(IncludedFile.Filename); SaveKnownIncludedAndHiddenFiles(FMainMemo.FileName, Strings, FHiddenFiles); finally Strings.Free; end; end; except { Handle exceptions locally; failure to save the includes list should not be a fatal error } Application.HandleException(Self); end; end; procedure TMainForm.NewMainFileUsingWizard; var WizardForm: TWizardForm; SaveEnabled: Boolean; begin WizardForm := TWizardForm.Create(Application); try SaveEnabled := Enabled; if CommandLineWizard then begin WizardForm.WizardName := CommandLineWizardName; { Must disable MainForm even though it isn't shown, otherwise menu keyboard shortcuts (such as Ctrl+O) still work } Enabled := False; end; try if WizardForm.ShowModal <> mrOk then Exit; finally Enabled := SaveEnabled; end; if CommandLineWizard then begin SaveTextToFile(CommandLineFileName, WizardForm.ResultScript, seUTF8WithoutBOM); end else begin NewMainFile; FMainMemo.Lines.Text := WizardForm.ResultScript; FMainMemo.ClearUndo; if WizardForm.Result = wrComplete then begin FMainMemo.ForceModifiedState; if MsgBox('Would you like to compile the new script now?', SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then BCompileClick(Self); end; end; finally WizardForm.Free; end; end; procedure TMainForm.OpenFile(AMemo: TIDEScintFileEdit; AFilename: String; const MainMemoAddToRecentDocs: Boolean); function GetStreamSaveEncoding(const Stream: TStream): TSaveEncoding; var Buf: array[0..2] of Byte; begin Result := seAuto; var StreamSize := Stream.Size; var CappedSize: Integer; if StreamSize > High(Integer) then CappedSize := High(Integer) else CappedSize := Integer(StreamSize); if (CappedSize >= SizeOf(Buf)) and (Stream.Read(Buf, SizeOf(Buf)) = SizeOf(Buf)) and (Buf[0] = $EF) and (Buf[1] = $BB) and (Buf[2] = $BF) then Result := seUTF8WithBOM else begin Stream.Seek(0, soFromBeginning); var S: AnsiString; SetLength(S, CappedSize); SetLength(S, Stream.Read(S[1], CappedSize)); if DetectUTF8Encoding(S) in [etUSASCII, etUTF8] then Result := seUTF8WithoutBOM; end; end; function GetEncoding(const SaveEncoding: TSaveEncoding): TEncoding; begin if SaveEncoding in [seUTF8WithBOM, seUTF8WithoutBOM] then Result := TEncoding.UTF8 else Result := nil; end; var Stream: TFileStream; begin AMemo.OpeningFile := True; try AFilename := PathExpand(AFilename); var NameChange := PathCompare(AMemo.Filename, AFilename) <> 0; Stream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone); try if AMemo = FMainMemo then NewMainFile else begin AMemo.BreakPoints.Clear; if DestroyLineState(AMemo) then UpdateAllMemoLineMarkers(AMemo); if NameChange then { Also see below the other case which needs to be done after load } RemoveMemoFromNav(AMemo); end; GetFileTime(Stream.Handle, nil, nil, @AMemo.FileLastWriteTime); AMemo.SaveEncoding := GetStreamSaveEncoding(Stream); Stream.Seek(0, soFromBeginning); AMemo.Lines.LoadFromStream(Stream, GetEncoding(AMemo.SaveEncoding)); if (AMemo <> FMainMemo) and not NameChange then RemoveMemoBadLinesFromNav(AMemo); finally Stream.Free; end; AMemo.ClearUndo; if AMemo = FMainMemo then begin AMemo.Filename := AFilename; UpdateCaption; ModifyMRUMainFilesList(AFilename, True); if MainMemoAddToRecentDocs then AddFileToRecentDocs(AFilename); LoadKnownIncludedAndHiddenFilesAndUpdateMemos(AFilename); InvalidateStatusPanel(spHiddenFilesCount); end; LoadBreakPointLinesAndUpdateLineMarkers(AMemo); finally AMemo.OpeningFile := False; end; end; procedure TMainForm.OpenMRUMainFile(const AFilename: String); { Same as OpenFile, but offers to remove the file from the MRU list if it cannot be opened } begin try OpenFile(FMainMemo, AFilename, True); except Application.HandleException(Self); if MsgBoxFmt('There was an error opening the file. Remove it from the list?', [AFilename], SCompilerFormCaption, mbError, MB_YESNO) = IDYES then begin ModifyMRUMainFilesList(AFilename, False); DeleteBreakPointLines(AFilename); DeleteKnownIncludedAndHiddenFiles(AFilename); end; end; end; function TMainForm.SaveFile(const AMemo: TIDEScintFileEdit; const SaveAs: Boolean): Boolean; procedure SaveMemoTo(const FN: String); var TempFN, BackupFN: String; Buf: array[0..4095] of Char; begin { Save to a temporary file; don't overwrite existing files in place. This way, if the system crashes or the disk runs out of space during the save, the existing file will still be intact. } if GetTempFileName(PChar(PathExtractDir(FN)), 'iss', 0, Buf) = 0 then raise Exception.CreateFmt('Error creating file (code %d). Could not save file', [GetLastError]); TempFN := Buf; try SaveTextToFile(TempFN, AMemo.Lines.Text, AMemo.SaveEncoding); { Back up existing file if needed } if FOptions.MakeBackups and NewFileExists(FN) then begin BackupFN := PathChangeExt(FN, '.~is'); DeleteFile(BackupFN); if not RenameFile(FN, BackupFN) then raise Exception.Create('Error creating backup file. Could not save file'); end; { Delete existing file } if not DeleteFile(FN) and (GetLastError <> ERROR_FILE_NOT_FOUND) then raise Exception.CreateFmt('Error removing existing file (code %d). Could not save file', [GetLastError]); except DeleteFile(TempFN); raise; end; { Rename temporary file. Note: This is outside the try..except because we already deleted the existing file, and don't want the temp file also deleted in the unlikely event that the rename fails. } if not RenameFile(TempFN, FN) then raise Exception.CreateFmt('Error renaming temporary file (code %d). Could not save file', [GetLastError]); GetLastWriteTimeOfFile(FN, @AMemo.FileLastWriteTime); end; var FN: String; begin Result := False; var OldName := AMemo.Filename; if SaveAs or (AMemo.Filename = '') then begin if AMemo <> FMainMemo then raise Exception.Create('Internal error: AMemo <> FMainMemo'); FN := AMemo.Filename; if not NewGetSaveFileName('', FN, '', SCompilerOpenFilter, 'iss', Handle) then Exit; FN := PathExpand(FN); SaveMemoTo(FN); AMemo.Filename := FN; UpdateCaption; end else SaveMemoTo(AMemo.Filename); AMemo.SetSavePoint; if not FOptions.UndoAfterSave then AMemo.ClearUndo(False); Result := True; if AMemo = FMainMemo then begin ModifyMRUMainFilesList(AMemo.Filename, True); if PathCompare(AMemo.Filename, OldName) <> 0 then begin if OldName <> '' then begin DeleteBreakPointLines(OldName); DeleteKnownIncludedAndHiddenFiles(OldName); end; BuildAndSaveBreakPointLines(AMemo); BuildAndSaveKnownIncludedAndHiddenFiles; end; end; end; function TMainForm.ConfirmCloseFile(const PromptToSave: Boolean): Boolean; function PromptToSaveMemo(const AMemo: TIDEScintFileEdit): Boolean; var FileTitle: String; begin Result := True; if AMemo.Modified then begin FileTitle := GetFileTitle(AMemo.Filename); 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 IDYES: Result := SaveFile(AMemo, False); IDNO: ; else Result := False; end; end; end; var Memo: TIDEScintFileEdit; begin 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; Result := True; if PromptToSave then begin for Memo in FFileMemos do begin if Memo.Used then begin Result := PromptToSaveMemo(Memo); if not Result then Exit; end; end; end; end; procedure TMainForm.ClearMRUMainFilesList; begin try ClearMRUList(FMRUMainFilesList, 'ScriptFileHistoryNew'); except { Ignore any exceptions. } end; end; procedure TMainForm.ReadMRUMainFilesList; begin try ReadMRUList(FMRUMainFilesList, 'ScriptFileHistoryNew', 'History'); except { Ignore any exceptions. } end; end; procedure TMainForm.ModifyMRUMainFilesList(const AFilename: String; const AddNewItem: Boolean); begin { Load most recent items first, just in case they've changed } try ReadMRUMainFilesList; except { Ignore any exceptions. } end; try ModifyMRUList(FMRUMainFilesList, 'ScriptFileHistoryNew', 'History', AFileName, AddNewItem, @PathCompare); except { Handle exceptions locally; failure to save the MRU list should not be a fatal error. } Application.HandleException(Self); end; end; procedure TMainForm.ReadMRUParametersList; begin try ReadMRUList(FMRUParametersList, 'ParametersHistory', 'History'); except { Ignore any exceptions. } end; end; procedure TMainForm.ModifyMRUParametersList(const AParameter: String; const AddNewItem: Boolean); begin { Load most recent items first, just in case they've changed } try ReadMRUParametersList; except { Ignore any exceptions. } end; try ModifyMRUList(FMRUParametersList, 'ParametersHistory', 'History', AParameter, AddNewItem, @CompareText); except { Handle exceptions locally; failure to save the MRU list should not be a fatal error. } Application.HandleException(Self); end; end; procedure TMainForm.StatusMessage(const Kind: TStatusMessageKind; const S: String); begin AddLines(CompilerOutputList, S, TObject(Kind), False, alpNone, 0); CompilerOutputList.Update; end; procedure TMainForm.DebugLogMessage(const S: String); begin AddLines(DebugOutputList, S, nil, True, alpTimestamp, FDebugLogListTimestampsWidth); DebugOutputList.Update; end; procedure TMainForm.DebugShowCallStack(const CallStack: String; const CallStackCount: Cardinal); begin DebugCallStackList.Clear; AddLines(DebugCallStackList, CallStack, nil, True, alpCountdown, FCallStackCount-1); DebugCallStackList.Items.Insert(0, '*** [Code] Call Stack'); DebugCallStackList.Update; end; type PAppData = ^TAppData; TAppData = record Form: TMainForm; Filename: String; Lines: TStringList; CurLineNumber: Integer; CurLine: String; OutputExe: String; DebugInfo: Pointer; ErrorMsg: String; ErrorFilename: String; ErrorLine: Integer; Aborted: Boolean; end; function CompilerCallbackProc(Code: Integer; var Data: TCompilerCallbackData; AppData: Longint): Integer; stdcall; procedure DecodeIncludedFilenames(P: PChar; const IncludedFiles: TIncludedFiles); var IncludedFile: TIncludedFile; I: Integer; begin IncludedFiles.Clear; if P = nil then Exit; I := 0; while P^ <> #0 do begin if not IsISPPBuiltins(P) then begin IncludedFile := TIncludedFile.Create; IncludedFile.Filename := GetCleanFileNameOfFile(P); IncludedFile.CompilerFileIndex := I; IncludedFile.HasLastWriteTime := GetLastWriteTimeOfFile(IncludedFile.Filename, @IncludedFile.LastWriteTime); IncludedFiles.Add(IncludedFile); end; Inc(P, StrLen(P) + 1); Inc(I); end; end; procedure CleanHiddenFiles(const IncludedFiles: TIncludedFiles; const HiddenFiles: TStringList); var HiddenFileIncluded: array of Boolean; begin if HiddenFiles.Count > 0 then begin { Clean previously hidden files which are no longer included } if IncludedFiles.Count > 0 then begin SetLength(HiddenFileIncluded, HiddenFiles.Count); for var I := 0 to HiddenFiles.Count-1 do HiddenFileIncluded[I] := False; for var I := 0 to IncludedFiles.Count-1 do begin var IncludedFile := IncludedFiles[I]; var HiddenFileIndex := HiddenFiles.IndexOf(IncludedFile.Filename); if HiddenFileIndex <> -1 then HiddenFileIncluded[HiddenFileIndex] := True; end; for var I := HiddenFiles.Count-1 downto 0 do if not HiddenFileIncluded[I] then HiddenFiles.Delete(I); end else HiddenFiles.Clear; end; end; begin Result := iscrSuccess; with PAppData(AppData)^ do case Code of iscbReadScript: begin if Data.Reset then CurLineNumber := 0; if CurLineNumber < Lines.Count then begin CurLine := Lines[CurLineNumber]; Data.LineRead := PChar(CurLine); Inc(CurLineNumber); end; end; iscbNotifyStatus: if Data.Warning then Form.StatusMessage(smkWarning, Data.StatusMsg) else Form.StatusMessage(smkNormal, Data.StatusMsg); iscbNotifyIdle: begin Form.UpdateCompileStatusPanels(Data.CompressProgress, Data.CompressProgressMax, Data.SecondsRemaining, Data.BytesCompressedPerSecond); { 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; iscbNotifyPreproc: begin Form.FPreprocessorOutput := TrimRight(Data.PreprocessedScript); DecodeIncludedFilenames(Data.IncludedFilenames, Form.FIncludedFiles); { Also stores last write time } CleanHiddenFiles(Form.FIncludedFiles, Form.FHiddenFiles); Form.InvalidateStatusPanel(spHiddenFilesCount); Form.BuildAndSaveKnownIncludedAndHiddenFiles; end; iscbNotifySuccess: begin OutputExe := Data.OutputExeFilename; if Form.FCompilerVersion.BinVersion >= $3000001 then begin DebugInfo := AllocMem(Data.DebugInfoSize); Move(Data.DebugInfo^, DebugInfo^, Data.DebugInfoSize); end else DebugInfo := nil; end; iscbNotifyError: begin if Assigned(Data.ErrorMsg) then ErrorMsg := Data.ErrorMsg else Aborted := True; ErrorFilename := Data.ErrorFilename; ErrorLine := Data.ErrorLine; end; end; end; procedure TMainForm.CompileFile(AFilename: String; const ReadFromFile: Boolean); function GetMemoFromErrorFilename(const ErrorFilename: String): TIDEScintFileEdit; var Memo: TIDEScintFileEdit; begin if ErrorFilename = '' then Result := FMainMemo else begin if FOptions.OpenIncludedFiles then begin for Memo in FFileMemos do begin if Memo.Used and (PathCompare(Memo.Filename, ErrorFilename) = 0) then begin Result := Memo; Exit; end; end; end; Result := nil; end; end; var SourcePath, S, Options: String; Params: TCompileScriptParamsEx; AppData: TAppData; StartTime, ElapsedTime, ElapsedSeconds: DWORD; I: Integer; Memo: TIDEScintFileEdit; OldActiveMemo: TIDEScintEdit; 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; if not ReadFromFile then begin if FOptions.OpenIncludedFiles then begin { Included files must always be saved since they're not read from the editor by the compiler } for Memo in FFileMemos do begin if (Memo <> FMainMemo) and Memo.Used and Memo.Modified then begin if FOptions.Autosave then begin if not SaveFile(Memo, False) then Abort; end else begin case MsgBox('The text in the ' + Memo.Filename + ' file has changed and must be saved before compiling.'#13#10#13#10 + 'Save the changes and continue?', SCompilerFormCaption, mbError, MB_YESNO) of IDYES: if not SaveFile(Memo, False) then Abort; else Abort; end; end; end; end; end; { Save main file if requested } if FOptions.Autosave and FMainMemo.Modified then begin if not SaveFile(FMainMemo, False) then Abort; end else if FMainMemo.Filename = '' then begin case MsgBox('Would you like to save the script before compiling?' + SNewLine2 + 'If you answer No, the compiled installation will be ' + 'placed under your My Documents folder by default.', SCompilerFormCaption, mbConfirmation, MB_YESNOCANCEL) of IDYES: if not SaveFile(FMainMemo, False) then Abort; IDNO: ; else Abort; end; end; AFilename := FMainMemo.Filename; end; {else: Command line compile, AFilename already set. } DestroyDebugInfo; OldActiveMemo := FActiveMemo; AppData.Lines := TStringList.Create; try FBuildAnimationFrame := 0; FProgress := 0; FProgressMax := 0; FTaskbarProgressValue := 0; FActiveMemo.CancelAutoCompleteAndCallTip; FActiveMemo.Cursor := crAppStart; FActiveMemo.SetCursorID(999); { hack to keep it from overriding Cursor } CompilerOutputList.Cursor := crAppStart; for Memo in FFileMemos do Memo.ReadOnly := True; UpdateEditModePanel; HideError; CompilerOutputList.Clear; SendMessage(CompilerOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0); DebugOutputList.Clear; SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0); DebugCallStackList.Clear; SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0); OutputTabSet.TabIndex := tiCompilerOutput; SetStatusPanelVisible(True); SourcePath := GetSourcePath(AFilename); FillChar(Params, SizeOf(Params), 0); Params.Size := SizeOf(Params); Params.CompilerPath := nil; Params.SourcePath := PChar(SourcePath); Params.CallbackProc := CompilerCallbackProc; Pointer(Params.AppData) := @AppData; Options := ''; for I := 0 to FSignTools.Count-1 do Options := Options + AddSignToolParam(FSignTools[I]); Params.Options := PChar(Options); AppData.Form := Self; AppData.CurLineNumber := 0; AppData.Aborted := False; I := ReadScriptLines(AppData.Lines, ReadFromFile, AFilename, FMainMemo); if I <> -1 then begin if not ReadFromFile then begin MoveCaretAndActivateMemo(FMainMemo, I, False); SetErrorLine(FMainMemo, I); end; raise Exception.CreateFmt(SCompilerIllegalNullChar, [I + 1]); end; StartTime := GetTickCount; StatusMessage(smkStartEnd, Format(SCompilerStatusStarting, [TimeToStr(Time)])); StatusMessage(smkStartEnd, ''); FCompiling := True; FCompileWantAbort := False; UpdateRunMenu; UpdateCaption; SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass); AppData.Filename := AFilename; {$IFNDEF STATICCOMPILER} if ISDllCompileScript(Params) <> isceNoError then begin {$ELSE} if ISCompileScript(Params, False) <> isceNoError then begin {$ENDIF} StatusMessage(smkError, SCompilerStatusErrorAborted); if not ReadFromFile and (AppData.ErrorLine > 0) then begin Memo := GetMemoFromErrorFilename(AppData.ErrorFilename); if Memo <> nil then begin { Move the caret to the line number the error occurred on } MoveCaretAndActivateMemo(Memo, AppData.ErrorLine - 1, False); SetErrorLine(Memo, AppData.ErrorLine - 1); end; 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; SetAppTaskbarProgressState(tpsError); MsgBox(S, 'Compiler Error', mbCriticalError, MB_OK) end; Abort; end; ElapsedTime := GetTickCount - StartTime; ElapsedSeconds := ElapsedTime div 1000; StatusMessage(smkStartEnd, Format(SCompilerStatusFinished, [TimeToStr(Time), Format('%.2u%s%.2u%s%.3u', [ElapsedSeconds div 60, FormatSettings.TimeSeparator, ElapsedSeconds mod 60, FormatSettings.DecimalSeparator, ElapsedTime mod 1000])])); finally AppData.Lines.Free; FCompiling := False; SetLowPriority(False, FSavePriorityClass); OldActiveMemo.Cursor := crDefault; OldActiveMemo.SetCursorID(SC_CURSORNORMAL); CompilerOutputList.Cursor := crDefault; for Memo in FFileMemos do Memo.ReadOnly := False; UpdateEditModePanel; UpdateRunMenu; UpdateCaption; UpdatePreprocMemos; if AppData.DebugInfo <> nil then begin ParseDebugInfo(AppData.DebugInfo); { Must be called after UpdateIncludedFilesMemos } FreeMem(AppData.DebugInfo); end; InvalidateStatusPanel(spCompileIcon); InvalidateStatusPanel(spCompileProgress); SetAppTaskbarProgressState(tpsNoProgress); StatusBar.Panels[spExtraStatus].Text := ''; end; FCompiledExe := AppData.OutputExe; FModifiedAnySinceLastCompile := False; FModifiedAnySinceLastCompileAndGo := False; end; procedure TMainForm.SyncEditorOptions; const SquigglyStyles: array[Boolean] of Integer = (INDIC_HIDDEN, INDIC_SQUIGGLE); WhiteSpaceStyles: array[Boolean] of Integer = (SCWS_INVISIBLE, SCWS_VISIBLEALWAYS); var Memo: TIDEScintEdit; begin for Memo in FMemos do begin Memo.UseStyleAttributes := FOptions.UseSyntaxHighlighting; Memo.Call(SCI_INDICSETSTYLE, minSquiggly, SquigglyStyles[FOptions.UnderlineErrors]); Memo.Call(SCI_SETVIEWWS, WhiteSpaceStyles[FOptions.ShowWhiteSpace], 0); if FOptions.CursorPastEOL then Memo.VirtualSpaceOptions := [svsRectangularSelection, svsUserAccessible, svsNoWrapLineStart] else Memo.VirtualSpaceOptions := []; Memo.FillSelectionToEdge := FOptions.CursorPastEOL; Memo.TabWidth := FOptions.TabWidth; Memo.UseTabCharacter := FOptions.UseTabCharacter; Memo.KeyMappingType := FOptions.MemoKeyMappingType; if Memo = FMainMemo then begin SetFakeShortCut(ESelectNextOccurrence, FMainMemo.GetComplexCommandShortCut(ccSelectNextOccurrence)); SetFakeShortCut(ESelectAllOccurrences, FMainMemo.GetComplexCommandShortCut(ccSelectAllOccurrences)); SetFakeShortCut(ESelectAllFindMatches, FMainMemo.GetComplexCommandShortCut(ccSelectAllFindMatches)); SetFakeShortCut(EFoldLine, FMainMemo.GetComplexCommandShortCut(ccFoldLine)); SetFakeShortCut(EUnfoldLine, FMainMemo.GetComplexCommandShortCut(ccUnfoldLine)); SetFakeShortCut(EToggleLinesComment, FMainMemo.GetComplexCommandShortCut(ccToggleLinesComment)); SetFakeShortCut(EBraceMatch, FMainMemo.GetComplexCommandShortCut(ccBraceMatch)); end; Memo.UseFolding := FOptions.UseFolding; Memo.WordWrap := FOptions.WordWrap; if FOptions.IndentationGuides then Memo.IndentationGuides := sigLookBoth else Memo.IndentationGuides := sigNone; Memo.LineNumbers := FOptions.GutterLineNumbers; end; end; procedure TMainForm.FMenuClick(Sender: TObject); var I: Integer; begin FSaveMainFileAs.Enabled := FActiveMemo = FMainMemo; FSaveEncoding.Enabled := FSave.Enabled; { FSave.Enabled is kept up-to-date by UpdateSaveMenuItemAndButton } FSaveEncodingAuto.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TIDEScintFileEdit).SaveEncoding = seAuto); FSaveEncodingUTF8WithBOM.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TIDEScintFileEdit).SaveEncoding = seUTF8WithBOM); FSaveEncodingUTF8WithoutBOM.Checked := FSaveEncoding.Enabled and ((FActiveMemo as TIDEScintFileEdit).SaveEncoding = seUTF8WithoutBOM); FSaveAll.Visible := FOptions.OpenIncludedFiles; ReadMRUMainFilesList; FRecent.Visible := FMRUMainFilesList.Count <> 0; for I := 0 to High(FMRUMainFilesMenuItems) do with FMRUMainFilesMenuItems[I] do begin if I < FMRUMainFilesList.Count then begin Visible := True; Caption := '&' + IntToStr((I+1) mod 10) + ' ' + DoubleAmp(FMRUMainFilesList[I]); end else Visible := False; end; ApplyMenuBitmaps(Sender as TMenuItem); end; procedure TMainForm.FNewMainFileClick(Sender: TObject); begin if ConfirmCloseFile(True) then NewMainFile; end; procedure TMainForm.FNewMainFileUserWizardClick(Sender: TObject); begin if ConfirmCloseFile(True) then NewMainFileUsingWizard; end; procedure TMainForm.ShowOpenMainFileDialog(const Examples: Boolean); var InitialDir, FileName: String; begin if Examples then begin InitialDir := PathExtractPath(NewParamStr(0)) + 'Examples'; Filename := PathExtractPath(NewParamStr(0)) + 'Examples\Example1.iss'; end else begin InitialDir := PathExtractDir(FMainMemo.Filename); Filename := ''; end; if ConfirmCloseFile(True) then if NewGetOpenFileName('', FileName, InitialDir, SCompilerOpenFilter, 'iss', Handle) then OpenFile(FMainMemo, Filename, False); end; procedure TMainForm.FOpenMainFileClick(Sender: TObject); begin ShowOpenMainFileDialog(False); end; procedure TMainForm.FSaveClick(Sender: TObject); begin SaveFile((FActiveMemo as TIDEScintFileEdit), Sender = FSaveMainFileAs); end; procedure TMainForm.FSaveEncodingItemClick(Sender: TObject); begin var Memo := (FActiveMemo as TIDEScintFileEdit); var OldSaveEncoding := Memo.SaveEncoding; if Sender = FSaveEncodingUTF8WithBOM then Memo.SaveEncoding := seUTF8WithBOM else if Sender = FSaveEncodingUTF8WithoutBOM then Memo.SaveEncoding := seUTF8WithoutBOM else Memo.SaveEncoding := seAuto; if Memo.SaveEncoding <> OldSaveEncoding then Memo.ForceModifiedState; end; procedure TMainForm.FSaveAllClick(Sender: TObject); var Memo: TIDEScintFileEdit; begin for Memo in FFileMemos do if Memo.Used and Memo.Modified then SaveFile(Memo, False); end; procedure TMainForm.FPrintClick(Sender: TObject); procedure SetupNonDarkPrintStyler(var PrintStyler: TInnoSetupStyler; var PrintTheme: TTheme; var OldStyler: TScintCustomStyler; var OldTheme: TTheme); begin { Not the most pretty code, would ideally make a copy of FActiveMemo and print that instead or somehow convince Scintilla to use different print styles but don't know of a good way to do either. Using SC_PRINT_COLOURONWHITE doesn't help, this gives white on white in dark mode. } PrintStyler := TInnoSetupStyler.Create(nil); PrintTheme := TTheme.Create; PrintStyler.ISPPInstalled := ISPPInstalled; PrintStyler.Theme := PrintTheme; if not FTheme.Dark then PrintTheme.Typ := FTheme.Typ else PrintTheme.Typ := ttModernLight; OldStyler := FActiveMemo.Styler; OldTheme := FActiveMemo.Theme; FActiveMemo.Styler := PrintStyler; FActiveMemo.Theme := PrintTheme; FActiveMemo.UpdateThemeColorsAndStyleAttributes; end; procedure DeinitPrintStyler(const PrintStyler: TInnoSetupStyler; const PrintTheme: TTheme; const OldStyler: TScintCustomStyler; const OldTheme: TTheme); begin if (OldStyler <> nil) or (OldTheme <> nil) then begin if OldStyler <> nil then FActiveMemo.Styler := OldStyler; if OldTheme <> nil then FActiveMemo.Theme := OldTheme; FActiveMemo.UpdateThemeColorsAndStyleAttributes; end; if PrintTheme <> FTheme then PrintTheme.Free; PrintStyler.Free; end; var PrintStyler: TInnoSetupStyler; OldStyler: TScintCustomStyler; PrintTheme, OldTheme: TTheme; PrintMemo: TIDEScintEdit; HeaderMemo: TIDEScintFileEdit; FileTitle, S: String; pdlg: TPrintDlg; hdc: Windows.HDC; rectMargins, rectPhysMargins, rectSetup, rcw: TRect; ptPage, ptDpi: TPoint; headerLineHeight, footerLineHeight: Integer; fontHeader, fontFooter: HFONT; tm: TTextMetric; di: TDocInfo; lengthDoc, lengthDocMax, lengthPrinted: Integer; frPrint: TScintRangeToFormat; pageNum: Integer; printPage: Boolean; ta: UINT; sHeader, sFooter: String; pen, penOld: HPEN; begin if FActiveMemo is TIDEScintFileEdit then HeaderMemo := TIDEScintFileEdit(FActiveMemo) else HeaderMemo := FMainMemo; sHeader := HeaderMemo.Filename; FileTitle := GetFileTitle(HeaderMemo.Filename); if HeaderMemo <> FActiveMemo then begin S := ' - ' + MemosTabSet.Tabs[MemoToTabIndex(FActiveMemo)]; sHeader := Format('%s %s', [sHeader, S]); FileTitle := Format('%s %s', [FileTitle, S]); end; sHeader := Format('%s - %s', [sHeader, DateTimeToStr(Now())]); { Based on SciTE 5.50's SciTEWin::Print } ZeroMemory(@pdlg, SizeOf(pdlg)); pdlg.lStructSize := SizeOf(pdlg); pdlg.hwndOwner := Handle; pdlg.hInstance := hInstance; pdlg.Flags := PD_USEDEVMODECOPIES or PD_ALLPAGES or PD_RETURNDC; pdlg.nFromPage := 1; pdlg.nToPage := 1; pdlg.nMinPage := 1; pdlg.nMaxPage := $ffff; // We do not know how many pages in the document until the printer is selected and the paper size is known. pdlg.nCopies := 1; pdlg.hDC := 0; pdlg.hDevMode := FDevMode; pdlg.hDevNames := FDevNames; // See if a range has been selected var rangeSelection := FActiveMemo.Selection; if rangeSelection.StartPos = rangeSelection.EndPos then pdlg.Flags := pdlg.Flags or PD_NOSELECTION else pdlg.Flags := pdlg.Flags or PD_SELECTION; if not PrintDlg(pdlg) then Exit; PrintStyler := nil; PrintTheme := nil; OldStyler := nil; OldTheme := nil; try if FTheme.Dark then SetupNonDarkPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme) else PrintTheme := FTheme; FDevMode := pdlg.hDevMode; FDevNames := pdlg.hDevNames; hdc := pdlg.hDC; // Get printer resolution ptDpi.x := GetDeviceCaps(hdc, LOGPIXELSX); // dpi in X direction ptDpi.y := GetDeviceCaps(hdc, LOGPIXELSY); // dpi in Y direction // Start by getting the physical page size (in device units). ptPage.x := GetDeviceCaps(hdc, PHYSICALWIDTH); // device units ptPage.y := GetDeviceCaps(hdc, PHYSICALHEIGHT); // device units // Get the dimensions of the unprintable // part of the page (in device units). rectPhysMargins.left := GetDeviceCaps(hdc, PHYSICALOFFSETX); rectPhysMargins.top := GetDeviceCaps(hdc, PHYSICALOFFSETY); // To get the right and lower unprintable area, // we take the entire width and height of the paper and // subtract everything else. rectPhysMargins.right := ptPage.x // total paper width - GetDeviceCaps(hdc, HORZRES) // printable width - rectPhysMargins.left; // left unprintable margin rectPhysMargins.bottom := ptPage.y // total paper height - GetDeviceCaps(hdc, VERTRES) // printable height - rectPhysMargins.top; // right unprintable margin // At this point, rectPhysMargins contains the widths of the // unprintable regions on all four sides of the page in device units. (* // Take in account the page setup given by the user (if one value is not null) if (pagesetupMargin.left != 0 || pagesetupMargin.right != 0 || pagesetupMargin.top != 0 || pagesetupMargin.bottom != 0) { GUI::Rectangle rectSetup; // Convert the hundredths of millimeters (HiMetric) or // thousandths of inches (HiEnglish) margin values // from the Page Setup dialog to device units. // (There are 2540 hundredths of a mm in an inch.) TCHAR localeInfo[3]; GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, localeInfo, 3); if (localeInfo[0] == '0') { // Metric system. '1' is US System *) rectSetup.left := MulDiv(500 {pagesetupMargin.left}, ptDpi.x, 2540); rectSetup.top := MulDiv(500 {pagesetupMargin.top}, ptDpi.y, 2540); rectSetup.right := MulDiv(500 {pagesetupMargin.right}, ptDpi.x, 2540); rectSetup.bottom := MulDiv(500 {pagesetupMargin.bottom}, ptDpi.y, 2540); (* } else { rectSetup.left = MulDiv(pagesetupMargin.left, ptDpi.x, 1000); rectSetup.top = MulDiv(pagesetupMargin.top, ptDpi.y, 1000); rectSetup.right = MulDiv(pagesetupMargin.right, ptDpi.x, 1000); rectSetup.bottom = MulDiv(pagesetupMargin.bottom, ptDpi.y, 1000); } *) // Don't reduce margins below the minimum printable area rectMargins.left := Max(rectPhysMargins.left, rectSetup.left); rectMargins.top := Max(rectPhysMargins.top, rectSetup.top); rectMargins.right := Max(rectPhysMargins.right, rectSetup.right); rectMargins.bottom := Max(rectPhysMargins.bottom, rectSetup.bottom); (* } else { rectMargins := rectPhysMargins; } *) // rectMargins now contains the values used to shrink the printable // area of the page. // Convert device coordinates into logical coordinates DPtoLP(hdc, rectMargins, 2); DPtoLP(hdc, rectPhysMargins, 2); // Convert page size to logical units and we're done! DPtoLP(hdc, ptPage, 1); headerLineHeight := MulDiv(9, ptDpi.y, 72); fontHeader := CreateFont(headerLineHeight, 0, 0, 0, FW_REGULAR, 1, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name)); SelectObject(hdc, fontHeader); GetTextMetrics(hdc, &tm); headerLineHeight := tm.tmHeight + tm.tmExternalLeading; footerLineHeight := MulDiv(9, ptDpi.y, 72); fontFooter := CreateFont(footerLineHeight, 0, 0, 0, FW_REGULAR, 0, 0, 0, 0, 0, 0, 0, 0, PChar(FActiveMemo.Font.Name)); SelectObject(hdc, fontFooter); GetTextMetrics(hdc, &tm); footerLineHeight := tm.tmHeight + tm.tmExternalLeading; ZeroMemory(@di, SizeOf(di)); di.cbSize := SizeOf(di); di.lpszDocName := PChar(FileTitle); di.lpszOutput := nil; di.lpszDatatype := nil; di.fwType := 0; if StartDoc(hdc, &di) < 0 then begin DeleteDC(hdc); DeleteObject(fontHeader); DeleteObject(fontFooter); MsgBox('Can not start printer document.', SCompilerFormCaption, mbError, MB_OK); Exit; end; lengthDocMax := FActiveMemo.GetRawTextLength; // PD_SELECTION -> requested to print selection. lengthDoc := IfThen((pdlg.Flags and PD_SELECTION) <> 0, rangeSelection.EndPos, lengthDocMax); lengthPrinted := IfThen((pdlg.Flags and PD_SELECTION) <> 0, rangeSelection.StartPos, 0); // We must subtract the physical margins from the printable area frPrint.hdc := hdc; frPrint.hdcTarget := hdc; frPrint.rc.left := rectMargins.left - rectPhysMargins.left; frPrint.rc.top := rectMargins.top - rectPhysMargins.top; frPrint.rc.right := ptPage.x - rectMargins.right - rectPhysMargins.left; frPrint.rc.bottom := ptPage.y - rectMargins.bottom - rectPhysMargins.top; frPrint.rcPage.left := 0; frPrint.rcPage.top := 0; frPrint.rcPage.right := ptPage.x - rectPhysMargins.left - rectPhysMargins.right - 1; frPrint.rcPage.bottom := ptPage.y - rectPhysMargins.top - rectPhysMargins.bottom - 1; frPrint.rc.top := frPrint.rc.top + headerLineHeight + headerLineHeight div 2; frPrint.rc.bottom := frPrint.rc.bottom - (footerLineHeight + footerLineHeight div 2); // Print each page pageNum := 1; while lengthPrinted < lengthDoc do begin printPage := ((pdlg.Flags and PD_PAGENUMS) = 0) or ((pageNum >= pdlg.nFromPage) and (pageNum <= pdlg.nToPage)); sFooter := Format('- %d -', [pageNum]); if printPage then begin StartPage(hdc); SetTextColor(hdc, PrintTheme.Colors[tcFore]); SetBkColor(hdc, PrintTheme.Colors[tcBack]); SelectObject(hdc, fontHeader); ta := SetTextAlign(hdc, TA_BOTTOM); rcw := Rect(frPrint.rc.left, frPrint.rc.top - headerLineHeight - headerLineHeight div 2, frPrint.rc.right, frPrint.rc.top - headerLineHeight div 2); rcw.bottom := rcw.top + headerLineHeight; ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.top - headerLineHeight div 2, ETO_OPAQUE, rcw, sHeader, Length(sHeader), nil); SetTextAlign(hdc, ta); pen := CreatePen(0, 1, GetTextColor(hdc)); penOld := SelectObject(hdc, pen); MoveToEx(hdc, frPrint.rc.left, frPrint.rc.top - headerLineHeight div 4, nil); LineTo(hdc, frPrint.rc.right, frPrint.rc.top - headerLineHeight div 4); SelectObject(hdc, penOld); DeleteObject(pen); end; frPrint.chrg.StartPos := lengthPrinted; frPrint.chrg.EndPos := lengthDoc; lengthPrinted := FActiveMemo.FormatRange(printPage, @frPrint); if printPage then begin SetTextColor(hdc, PrintTheme.Colors[tcFore]); SetBkColor(hdc, PrintTheme.Colors[tcBack]); SelectObject(hdc, fontFooter); ta := SetTextAlign(hdc, TA_TOP); rcw := Rect(frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 2, frPrint.rc.right, frPrint.rc.bottom + footerLineHeight + footerLineHeight div 2); ExtTextOut(hdc, frPrint.rc.left + 5, frPrint.rc.bottom + footerLineHeight div 2, ETO_OPAQUE, rcw, sFooter, Length(sFooter), nil); SetTextAlign(hdc, ta); pen := CreatePen(0, 1, GetTextColor(hdc)); penOld := SelectObject(hdc, pen); MoveToEx(hdc, frPrint.rc.left, frPrint.rc.bottom + footerLineHeight div 4, nil); LineTo(hdc, frPrint.rc.right, frPrint.rc.bottom + footerLineHeight div 4); SelectObject(hdc, penOld); DeleteObject(pen); EndPage(hdc); end; Inc(pageNum); if ((pdlg.Flags and PD_PAGENUMS) <> 0) and (pageNum > pdlg.nToPage) then Break; end; FActiveMemo.FormatRange(False, nil); EndDoc(hdc); DeleteDC(hdc); DeleteObject(fontHeader); DeleteObject(fontFooter); finally DeinitPrintStyler(PrintStyler, PrintTheme, OldStyler, OldTheme); end; end; procedure TMainForm.FClearRecentClick(Sender: TObject); begin if MsgBox('Are you sure you want to clear the list of recently opened files?', SCompilerFormCaption, mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then ClearMRUMainFilesList; end; procedure TMainForm.FMRUClick(Sender: TObject); var I: Integer; begin if ConfirmCloseFile(True) then for I := 0 to High(FMRUMainFilesMenuItems) do if FMRUMainFilesMenuItems[I] = Sender then begin OpenMRUMainFile(FMRUMainFilesList[I]); Break; end; end; procedure TMainForm.FExitClick(Sender: TObject); begin Close; end; procedure TMainForm.EMenuClick(Sender: TObject); var MemoHasFocus, MemoIsReadOnly: Boolean; begin MemoHasFocus := FActiveMemo.Focused; MemoIsReadOnly := FActiveMemo.ReadOnly; EUndo.Enabled := MemoHasFocus and FActiveMemo.CanUndo; ERedo.Enabled := MemoHasFocus and FActiveMemo.CanRedo; ECut.Enabled := MemoHasFocus and not MemoIsReadOnly and not FActiveMemo.SelEmpty; ECopy.Enabled := MemoHasFocus and not FActiveMemo.SelEmpty; EPaste.Enabled := MemoHasFocus and FActiveMemo.CanPaste; EDelete.Enabled := MemoHasFocus and not FActiveMemo.SelEmpty; ESelectAll.Enabled := MemoHasFocus; ESelectNextOccurrence.Enabled := MemoHasFocus; ESelectAllOccurrences.Enabled := MemoHasFocus; ESelectAllFindMatches.Enabled := MemoHasFocus and (FLastFindText <> ''); EFind.Enabled := MemoHasFocus; EFindNext.Enabled := MemoHasFocus; EFindPrevious.Enabled := MemoHasFocus; EReplace.Enabled := MemoHasFocus and not MemoIsReadOnly; EFindRegEx.Checked := FOptions.FindRegEx; EFoldLine.Visible := FOptions.UseFolding; EFoldLine.Enabled := MemoHasFocus; EUnfoldLine.Visible := EFoldLine.Visible; EUnfoldLine.Enabled := EFoldLine.Enabled; EGoto.Enabled := MemoHasFocus; EToggleLinesComment.Enabled := not MemoIsReadOnly; EBraceMatch.Enabled := MemoHasFocus; ApplyMenuBitmaps(Sender as TMenuItem); end; procedure TMainForm.EUndoClick(Sender: TObject); begin FActiveMemo.Undo; end; procedure TMainForm.ERedoClick(Sender: TObject); begin FActiveMemo.Redo; end; procedure TMainForm.ECutClick(Sender: TObject); begin FActiveMemo.CutToClipboard; end; procedure TMainForm.ECopyClick(Sender: TObject); begin FActiveMemo.CopyToClipboard; end; function TMainForm.MultipleSelectionPasteFromClipboard(const AMemo: TIDEScintEdit): Boolean; begin { Scintilla doesn't yet properly support multiple selection paste. Handle it here, just like VS and VSCode do: if there's multiple selections and the paste text has the same amount of lines then paste 1 line per selection. Do this even if the paste text is marked as rectangular. Otherwise (so no match between the selection count and the line count) paste all lines into each selection. For the latter we don't need handling here: this is Scintilla's default behaviour if SC_MULTIPASTE_EACH is on. } Result := False; var SelectionCount := AMemo.SelectionCount; if SelectionCount > 1 then begin var PasteLines := Clipboard.AsText.Replace(#13#10, #13).Split([#13, #10]); if SelectionCount = Length(PasteLines) then begin AMemo.BeginUndoAction; try for var I := 0 to SelectionCount-1 do begin var StartPos := AMemo.SelectionStartPosition[I]; { Can't use AMemo.GetSelections because each paste can update other selections } var EndPos := AMemo.SelectionEndPosition[I]; AMemo.ReplaceTextRange(StartPos, EndPos, PasteLines[I], srmMinimal); { Update the selection to an empty selection at the end of the inserted text, just like ReplaceMainSelText } var Pos := AMemo.Target.EndPos; { ReplaceTextRange updates the target } AMemo.SelectionCaretPosition[I] := Pos; AMemo.SelectionAnchorPosition[I] := Pos; end; { Be like SCI_PASTE } AMemo.ChooseCaretX; AMemo.ScrollCaretIntoView; finally AMemo.EndUndoAction; end; Result := True; end; end; end; procedure TMainForm.EPasteClick(Sender: TObject); begin if not MultipleSelectionPasteFromClipboard(FActiveMemo) then FActiveMemo.PasteFromClipboard; end; procedure TMainForm.EDeleteClick(Sender: TObject); begin FActiveMemo.ClearSelection; end; procedure TMainForm.ESelectAllClick(Sender: TObject); begin FActiveMemo.SelectAll; end; procedure TMainForm.ESelectAllOccurrencesClick(Sender: TObject); begin { Might be called even if ESelectAllOccurrences.Enabled would be False in EMenuClick } if FActiveMemo.SelEmpty then begin { If the selection is empty then SelectAllOccurrences will actually just select the word at caret which is not what we want, so preselect this word ourselves } var Range := FActiveMemo.WordAtCaretRange; if Range.StartPos <> Range.EndPos then FActiveMemo.SetSingleSelection(Range.EndPos, Range.StartPos); end; FActiveMemo.SelectAllOccurrences([sfoMatchCase]); end; procedure TMainForm.ESelectNextOccurrenceClick(Sender: TObject); begin { Might be called even if ESelectNextOccurrence.Enabled would be False in EMenuClick } FActiveMemo.SelectNextOccurrence([sfoMatchCase]); end; procedure TMainForm.EToggleLinesCommentClick(Sender: TObject); begin var AMemo := FActiveMemo; { Based on SciTE 5.50's SciTEBase::StartBlockComment - only toggles comments for the main selection } var Selection := AMemo.Selection; var CaretPosition := AMemo.CaretPosition; // checking if caret is located in _beginning_ of selected block var MoveCaret := CaretPosition < Selection.EndPos; var SelStartLine := AMemo.GetLineFromPosition(Selection.StartPos); var SelEndLine := AMemo.GetLineFromPosition(Selection.EndPos); var Lines := SelEndLine - SelStartLine; var FirstSelLineStart := AMemo.GetPositionFromLine(SelStartLine); // "caret return" is part of the last selected line if (Lines > 0) and (Selection.EndPos = AMemo.GetPositionFromLine(SelEndLine)) then Dec(SelEndLine); { We rely on the styler to identify [Code] section lines, but we may be searching into areas that haven't been styled yet } AMemo.StyleNeeded(Selection.EndPos); AMemo.BeginUndoAction; try var LastLongCommentLength := 0; for var I := SelStartLine to SelEndLine do begin var LineIndent := AMemo.GetLineIndentPosition(I); var LineEnd := AMemo.GetLineEndPosition(I); var LineBuf := AMemo.GetTextRange(LineIndent, LineEnd); // empty lines are not commented if LineBuf = '' then Continue; var Comment: String; if LineBuf.StartsWith('//') or (FMemosStyler.GetSectionFromLineState(AMemo.Lines.State[I]) = scCode) then Comment := '//' else Comment := ';'; var LongComment := Comment + ' '; LastLongCommentLength := Length(LongComment); if LineBuf.StartsWith(Comment) then begin var CommentLength := Length(Comment); if LineBuf.StartsWith(LongComment) then begin // Removing comment with space after it. CommentLength := Length(LongComment); end; AMemo.Selection := TScintRange.Create(LineIndent, LineIndent + CommentLength); AMemo.SelText := ''; if I = SelStartLine then // is this the first selected line? Dec(Selection.StartPos, CommentLength); Dec(Selection.EndPos, CommentLength); // every iteration Continue; end; if I = SelStartLine then // is this the first selected line? Inc(Selection.StartPos, Length(LongComment)); Inc(Selection.EndPos, Length(LongComment)); // every iteration AMemo.Call(SCI_INSERTTEXT, LineIndent, AMemo.ConvertStringToRawString(LongComment)); end; // after uncommenting selection may promote itself to the lines // before the first initially selected line; // another problem - if only comment symbol was selected; if Selection.StartPos < FirstSelLineStart then begin if Selection.StartPos >= Selection.EndPos - (LastLongCommentLength - 1) then Selection.EndPos := FirstSelLineStart; Selection.StartPos := FirstSelLineStart; end; if MoveCaret then begin // moving caret to the beginning of selected block AMemo.CaretPosition := Selection.EndPos; AMemo.CaretPositionWithSelectFromAnchor := Selection.StartPos; end else AMemo.Selection := Selection; finally AMemo.EndUndoAction; end; end; procedure TMainForm.EBraceMatchClick(Sender: TObject); begin var AMemo := FActiveMemo; var Selections: TScintCaretAndAnchorList := nil; var VirtualSpaces: TScintCaretAndAnchorList := nil; try Selections := TScintCaretAndAnchorList.Create; VirtualSpaces := TScintCaretAndAnchorList.Create; AMemo.GetSelections(Selections, VirtualSpaces); for var I := 0 to Selections.Count-1 do begin if VirtualSpaces[I].CaretPos = 0 then begin var Pos := Selections[I].CaretPos; var MatchPos := AMemo.GetPositionOfMatchingBrace(Pos); if MatchPos = -1 then begin Pos := AMemo.GetPositionBefore(Pos); MatchPos := AMemo.GetPositionOfMatchingBrace(Pos) end; if MatchPos <> -1 then begin AMemo.SelectionCaretPosition[I] := MatchPos; AMemo.SelectionAnchorPosition[I] := MatchPos; if I = 0 then AMemo.ScrollCaretIntoView; end; end; end; finally VirtualSpaces.Free; Selections.Free; end; end; procedure TMainForm.ESelectAllFindMatchesClick(Sender: TObject); begin { Might be called even if ESelectAllFindMatches.Enabled would be False in EMenuClick } if FLastFindText <> '' then begin var StartPos := 0; var EndPos := FActiveMemo.RawTextLength; var FoundRange: TScintRange; var ClosestSelection := -1; var ClosestSelectionDistance := 0; { Silence compiler } var CaretPos := FActiveMemo.CaretPosition; while (StartPos < EndPos) and FActiveMemo.FindText(StartPos, EndPos, FLastFindText, FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), FoundRange) do begin if StartPos = 0 then FActiveMemo.SetSingleSelection(FoundRange.EndPos, FoundRange.StartPos) else FActiveMemo.AddSelection(FoundRange.EndPos, FoundRange.StartPos); var Distance := Abs(CaretPos-FoundRange.EndPos); if (ClosestSelection = -1) or (Distance < ClosestSelectionDistance) then begin ClosestSelection := FActiveMemo.SelectionCount-1; ClosestSelectionDistance := Distance; end; StartPos := FoundRange.EndPos; end; if ClosestSelection <> -1 then begin FActiveMemo.MainSelection := ClosestSelection; FActiveMemo.ScrollCaretIntoView; end; end; end; procedure TMainForm.VMenuClick(Sender: TObject); begin VZoomIn.Enabled := (FActiveMemo.Zoom < 20); VZoomOut.Enabled := (FActiveMemo.Zoom > -10); VZoomReset.Enabled := (FActiveMemo.Zoom <> 0); VToolbar.Checked := ToolbarPanel.Visible; VStatusBar.Checked := StatusBar.Visible; VNextTab.Enabled := MemosTabSet.Visible and (MemosTabSet.Tabs.Count > 1); VPreviousTab.Enabled := VNextTab.Enabled; VCloseCurrentTab.Enabled := MemosTabSet.Visible and (FActiveMemo <> FMainMemo) and (FActiveMemo <> FPreprocessorOutputMemo); VReopenTab.Visible := MemosTabSet.Visible and (FHiddenFiles.Count > 0); if VReopenTab.Visible then UpdateReopenTabMenu(VReopenTab); VReopenTabs.Visible := VReopenTab.Visible; VHide.Checked := not StatusPanel.Visible; VCompilerOutput.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiCompilerOutput); VDebugOutput.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiDebugOutput); VDebugCallStack.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiDebugCallStack); VFindResults.Checked := StatusPanel.Visible and (OutputTabSet.TabIndex = tiFindResults); VWordWrap.Checked := FOptions.WordWrap; ApplyMenuBitmaps(Sender as TMenuItem); end; procedure TMainForm.VNextTabClick(Sender: TObject); var NewTabIndex: Integer; begin NewTabIndex := MemosTabSet.TabIndex+1; if NewTabIndex >= MemosTabSet.Tabs.Count then NewTabIndex := 0; MemosTabSet.TabIndex := NewTabIndex; end; procedure TMainForm.VPreviousTabClick(Sender: TObject); var NewTabIndex: Integer; begin NewTabIndex := MemosTabSet.TabIndex-1; if NewTabIndex < 0 then NewTabIndex := MemosTabSet.Tabs.Count-1; MemosTabSet.TabIndex := NewTabIndex; end; procedure TMainForm.CloseTab(const TabIndex: Integer); begin var Memo := TabIndexToMemo(TabIndex, MemosTabSet.Tabs.Count-1); var MemoWasActiveMemo := Memo = FActiveMemo; MemosTabSet.Tabs.Delete(TabIndex); { This will not change MemosTabset.TabIndex } MemosTabSet.Hints.Delete(TabIndex); MemosTabSet.CloseButtons.Delete(TabIndex); FHiddenFiles.Add((Memo as TIDEScintFileEdit).Filename); InvalidateStatusPanel(spHiddenFilesCount); BuildAndSaveKnownIncludedAndHiddenFiles; { Because MemosTabSet.Tabs and FHiddenFiles have both been updated now, hereafter setting TabIndex will not select the memo we're closing even if it's not hidden yet because TabIndexToMemo as called by MemosTabSetClick will skip it } if MemoWasActiveMemo then begin { Select next tab, except when we're already at the end. Avoiding flicker by doing this before hiding old active memo. We do this in a dirty way by clicking two tabs while making sure TabSetClick doesn't see the first 'fake' one. } FIgnoreTabSetClick := True; try VNextTabClick(Self); finally FIgnoreTabSetClick := False; end; VPreviousTabClick(Self); Memo.CancelAutoCompleteAndCallTip; Memo.Visible := False; end else if TabIndex < MemosTabset.TabIndex then MemosTabSet.TabIndex := MemosTabset.TabIndex-1; { Reselect old selected tab } end; procedure TMainForm.VCloseCurrentTabClick(Sender: TObject); begin CloseTab(MemosTabSet.TabIndex); end; procedure TMainForm.ReopenTabOrTabs(const HiddenFileIndex: Integer; const Activate: Boolean); begin var ReopenFilename: String; if HiddenFileIndex >= 0 then begin ReopenFilename := FHiddenFiles[HiddenFileIndex]; FHiddenFiles.Delete(HiddenFileIndex); end else begin ReopenFilename := FHiddenFiles[0]; FHiddenFiles.Clear; end; InvalidateStatusPanel(spHiddenFilesCount); UpdatePreprocMemos; BuildAndSaveKnownIncludedAndHiddenFiles; { Activate the memo if requested } if Activate then begin for var Memo in FFileMemos do begin if Memo.Used and (PathCompare(Memo.Filename, ReopenFilename) = 0) then begin MemosTabSet.TabIndex := MemoToTabIndex(memo); Break; end; end end; end; procedure TMainForm.ReopenTabClick(Sender: TObject); begin ReopenTabOrTabs((Sender as TMenuItem).Tag, True); end; procedure TMainForm.VReopenTabsClick(Sender: TObject); begin ReopenTabOrTabs(-1, True); end; procedure TMainForm.VZoomInClick(Sender: TObject); begin FActiveMemo.ZoomIn; { MemoZoom will zoom the other memos } end; procedure TMainForm.VZoomOutClick(Sender: TObject); begin FActiveMemo.ZoomOut; end; procedure TMainForm.VZoomResetClick(Sender: TObject); begin FActiveMemo.Zoom := 0; end; procedure TMainForm.VToolbarClick(Sender: TObject); begin ToolbarPanel.Visible := not ToolbarPanel.Visible; end; procedure TMainForm.VStatusBarClick(Sender: TObject); begin StatusBar.Visible := not StatusBar.Visible; end; procedure TMainForm.VWordWrapClick(Sender: TObject); begin FOptions.WordWrap := not FOptions.WordWrap; SyncEditorOptions; var Ini := TConfigIniFile.Create; try Ini.WriteBool('Options', 'WordWrap', FOptions.WordWrap); finally Ini.Free; end; end; procedure TMainForm.SetStatusPanelVisible(const AVisible: Boolean); var CaretWasInView: Boolean; begin if StatusPanel.Visible <> AVisible then begin CaretWasInView := FActiveMemo.IsPositionInViewVertically(FActiveMemo.CaretPosition); if AVisible then begin { Ensure the status panel height isn't out of range before showing } UpdateStatusPanelHeight(StatusPanel.Height); SplitPanel.Top := ClientHeight; StatusPanel.Top := ClientHeight; end else begin if StatusPanel.ContainsControl(ActiveControl) then ActiveControl := FActiveMemo; end; SplitPanel.Visible := AVisible; StatusPanel.Visible := AVisible; if AVisible and CaretWasInView then begin { If the caret was in view, make sure it still is } FActiveMemo.ScrollCaretIntoView; end; end; end; procedure TMainForm.VHideClick(Sender: TObject); begin SetStatusPanelVisible(False); end; procedure TMainForm.VCompilerOutputClick(Sender: TObject); begin OutputTabSet.TabIndex := tiCompilerOutput; SetStatusPanelVisible(True); end; procedure TMainForm.VDebugOutputClick(Sender: TObject); begin OutputTabSet.TabIndex := tiDebugOutput; SetStatusPanelVisible(True); end; procedure TMainForm.VDebugCallStackClick(Sender: TObject); begin OutputTabSet.TabIndex := tiDebugCallStack; SetStatusPanelVisible(True); end; procedure TMainForm.VFindResultsClick(Sender: TObject); begin OutputTabSet.TabIndex := tiFindResults; SetStatusPanelVisible(True); end; procedure TMainForm.BMenuClick(Sender: TObject); begin BLowPriority.Checked := FOptions.LowPriorityDuringCompile; BOpenOutputFolder.Enabled := (FCompiledExe <> ''); ApplyMenuBitmaps(Sender as TMenuItem); end; procedure TMainForm.BCompileClick(Sender: TObject); begin CompileFile('', False); end; procedure TMainForm.BStopCompileClick(Sender: TObject); begin SetAppTaskbarProgressState(tpsPaused); try if MsgBox('Are you sure you want to abort the compile?', SCompilerFormCaption, mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDNO then FCompileWantAbort := True; finally SetAppTaskbarProgressState(tpsNormal); end; end; procedure TMainForm.BLowPriorityClick(Sender: TObject); begin FOptions.LowPriorityDuringCompile := not FOptions.LowPriorityDuringCompile; { If a compile is already in progress, change the priority now } if FCompiling then SetLowPriority(FOptions.LowPriorityDuringCompile, FSavePriorityClass); end; procedure TMainForm.BOpenOutputFolderClick(Sender: TObject); begin LaunchFileOrURL(AddBackslash(GetSystemWinDir) + 'explorer.exe', Format('/select,"%s"', [FCompiledExe])); end; procedure TMainForm.HShortcutsDocClick(Sender: TObject); begin if Assigned(HtmlHelp) then HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_compformshortcuts.htm'))); end; procedure TMainForm.HRegExDocClick(Sender: TObject); begin if Assigned(HtmlHelp) then HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_compformregex.htm'))); end; procedure TMainForm.HDocClick(Sender: TObject); begin if Assigned(HtmlHelp) then HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, 0); end; procedure TMainForm.HExamplesClick(Sender: TObject); begin LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'Examples'); end; procedure TMainForm.HFaqClick(Sender: TObject); begin LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + 'isfaq.url'); end; procedure TMainForm.HWhatsNewClick(Sender: TObject); begin LaunchFileOrURL(PathExtractPath(NewParamStr(0)) + {$IFDEF DEBUG} '..\..\' + {$ENDIF} 'whatsnew.htm'); end; procedure TMainForm.HWebsiteClick(Sender: TObject); begin LaunchFileOrURL('https://jrsoftware.org/isinfo.php'); end; procedure TMainForm.HMailingListClick(Sender: TObject); begin OpenMailingListSite; end; procedure TMainForm.HISPPDocClick(Sender: TObject); begin if Assigned(HtmlHelp) then HtmlHelp(GetDesktopWindow, PChar(GetHelpFile), HH_DISPLAY_TOPIC, Cardinal(PChar('topic_isppoverview.htm'))); end; procedure TMainForm.HDonateClick(Sender: TObject); begin OpenDonateSite; end; procedure TMainForm.HAboutClick(Sender: TObject); var S: String; begin { Removing the About box or modifying any existing text inside it is a violation of the Inno Setup license agreement; see LICENSE.TXT. However, adding additional lines to the About box is permitted, as long as they are placed below the original copyright notice. } S := FCompilerVersion.Title + ' Compiler version ' + String(FCompilerVersion.Version) + SNewLine; if FCompilerVersion.Title <> 'Inno Setup' then S := S + (SNewLine + 'Based on Inno Setup' + SNewLine); S := S + ('Copyright (C) 1997-2025 Jordan Russell' + SNewLine + 'Portions Copyright (C) 2000-2025 Martijn Laan' + SNewLine + 'All rights reserved.' + SNewLine2 + 'Inno Setup home page:' + SNewLine + 'https://www.innosetup.com/' + SNewLine2 + 'RemObjects Pascal Script home page:' + SNewLine + 'https://www.remobjects.com/ps' + SNewLine2 + 'Refer to LICENSE.TXT for conditions of distribution and use.'); MsgBox(S, 'About ' + FCompilerVersion.Title, mbInformation, MB_OK); end; procedure TMainForm.WMStartCommandLineCompile(var Message: TMessage); var Code: Integer; begin UpdateStatusPanelHeight(ClientHeight); Code := 0; try try CompileFile(CommandLineFilename, True); except Code := 2; Application.HandleException(Self); end; finally Halt(Code); end; end; procedure TMainForm.WMStartCommandLineWizard(var Message: TMessage); var Code: Integer; begin Code := 0; try try NewMainFileUsingWizard; except Code := 2; Application.HandleException(Self); end; finally Halt(Code); end; end; procedure TMainForm.WMStartNormally(var Message: TMessage); procedure ShowStartupForm; var StartupForm: TStartupForm; Ini: TConfigIniFile; begin ReadMRUMainFilesList; StartupForm := TStartupForm.Create(Application); try StartupForm.MRUFilesList := FMRUMainFilesList; StartupForm.StartupCheck.Checked := not FOptions.ShowStartupForm; if StartupForm.ShowModal = mrOK then begin if FOptions.ShowStartupForm <> not StartupForm.StartupCheck.Checked then begin FOptions.ShowStartupForm := not StartupForm.StartupCheck.Checked; Ini := TConfigIniFile.Create; try Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm); finally Ini.Free; end; end; case StartupForm.Result of srEmpty: FNewMainFileClick(Self); srWizard: FNewMainFileUserWizardClick(Self); srOpenFile: if ConfirmCloseFile(True) then OpenMRUMainFile(StartupForm.ResultMainFileName); srOpenDialog: ShowOpenMainFileDialog(False); srOpenDialogExamples: ShowOpenMainFileDialog(True); end; end; finally StartupForm.Free; end; end; begin if CommandLineFilename = '' then begin if FOptions.ShowStartupForm then ShowStartupForm; end else OpenFile(FMainMemo, CommandLineFilename, False); end; procedure TMainForm.WMSysColorChange(var Message: TMessage); begin inherited; for var Memo in FMemos do Memo.SysColorChange(Message); end; procedure TMainForm.UpdateReopenTabMenu(const Menu: TMenuItem); begin Menu.Clear; for var I := 0 to FHiddenFiles.Count-1 do begin var MenuItem := TMenuItem.Create(Menu); MenuItem.Caption := '&' + IntToStr((I+1) mod 10) + ' ' + DoubleAmp(PathExtractName(FHiddenFiles[I])); MenuItem.Tag := I; MenuItem.OnClick := ReopenTabClick; Menu.Add(MenuItem); end; end; procedure TMainForm.MemosTabSetPopupMenuClick(Sender: TObject); begin { Main and preprocessor memos can't be hidden } VCloseCurrentTab2.Enabled := (FActiveMemo <> FMainMemo) and (FActiveMemo <> FPreprocessorOutputMemo); VReopenTab2.Visible := FHiddenFiles.Count > 0; if VReopenTab2.Visible then UpdateReopenTabMenu(VReopenTab2); VReopenTabs2.Visible := VReopenTab2.Visible; ApplyMenuBitmaps(Sender as TMenuItem) end; procedure TMainForm.MemosTabSetClick(Sender: TObject); begin if FIgnoreTabSetClick then Exit; var NewActiveMemo := TabIndexToMemo(MemosTabSet.TabIndex, MemosTabSet.Tabs.Count-1); if NewActiveMemo <> FActiveMemo then begin { Avoiding flicker by showing new before hiding old } NewActiveMemo.Visible := True; var OldActiveMemo := FActiveMemo; FActiveMemo := NewActiveMemo; ActiveControl := NewActiveMemo; OldActiveMemo.CancelAutoCompleteAndCallTip; OldActiveMemo.Visible := False; UpdateSaveMenuItemAndButton; UpdateRunMenu; UpdateCaretPosPanelAndBackNavStack; UpdateEditModePanel; UpdateModifiedPanel; end; end; procedure TMainForm.MemosTabSetOnCloseButtonClick(Sender: TObject; Index: Integer); begin CloseTab(Index); end; procedure TMainForm.InitializeFindText(Dlg: TFindDialog); var S: String; begin S := FActiveMemo.MainSelText; if (S <> '') and (Pos(#13, S) = 0) and (Pos(#10, S) = 0) then Dlg.FindText := S else Dlg.FindText := FLastFindText; end; const OldFindReplaceWndProcProp = 'OldFindReplaceWndProc'; function FindReplaceWndProc(Wnd: HWND; Msg: Cardinal; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall; function CallDefWndProc: LRESULT; begin Result := CallWindowProc(Pointer(GetProp(Wnd, OldFindReplaceWndProcProp)), Wnd, Msg, WParam, LParam); end; begin case Msg of WM_MENUCHAR: if LoWord(wParam) = VK_RETURN then begin var hwndCtl := GetDlgItem(Wnd, idOk); if (hWndCtl <> 0) and IsWindowEnabled(hWndCtl) then PostMessage(Wnd, WM_COMMAND, MakeWParam(idOk, BN_CLICKED), Windows.LPARAM(hWndCtl)); end; WM_NCDESTROY: begin Result := CallDefWndProc; RemoveProp(Wnd, OldFindReplaceWndProcProp); Exit; end; end; Result := CallDefWndProc; end; procedure ExecuteFindDialogAllowingAltEnter(const FindDialog: TFindDialog); begin var DoHook := FindDialog.Handle = 0; FindDialog.Execute; if DoHook then begin SetProp(FindDialog.Handle, OldFindReplaceWndProcProp, GetWindowLong(FindDialog.Handle, GWL_WNDPROC)); SetWindowLong(FindDialog.Handle, GWL_WNDPROC, IntPtr(@FindReplaceWndProc)); end; end; procedure TMainForm.EFindClick(Sender: TObject); begin ReplaceDialog.CloseDialog; if FindDialog.Handle = 0 then InitializeFindText(FindDialog); if (Sender = EFind) or (Sender = EFindNext) then FindDialog.Options := FindDialog.Options + [frDown] else FindDialog.Options := FindDialog.Options - [frDown]; ExecuteFindDialogAllowingAltEnter(FindDialog); end; procedure TMainForm.EFindInFilesClick(Sender: TObject); begin InitializeFindText(FindInFilesDialog); FindInFilesDialog.Execute; end; procedure TMainForm.EFindNextOrPreviousClick(Sender: TObject); begin if FLastFindText = '' then EFindClick(Sender) else begin if Sender = EFindNext then FLastFindOptions := FLastFindOptions + [frDown] else FLastFindOptions := FLastFindOptions - [frDown]; FLastFindRegEx := FOptions.FindRegEx; if not TestLastFindOptions then Exit; FindNext(False); end; end; procedure TMainForm.FindNext(const ReverseDirection: Boolean); var StartPos, EndPos: Integer; Range: TScintRange; begin var Down := frDown in FLastFindOptions; if ReverseDirection then Down := not Down; if Down then begin StartPos := FActiveMemo.Selection.EndPos; EndPos := FActiveMemo.RawTextLength; end else begin StartPos := FActiveMemo.Selection.StartPos; EndPos := 0; end; if FActiveMemo.FindText(StartPos, EndPos, FLastFindText, FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), Range) then FActiveMemo.SelectAndEnsureVisible(Range) else MsgBoxFmt('Cannot find "%s"', [FLastFindText], SCompilerFormCaption, mbInformation, MB_OK); end; function TMainForm.StoreAndTestLastFindOptions(Sender: TObject): Boolean; begin { TReplaceDialog is a subclass of TFindDialog must check for TReplaceDialog first } if Sender is TReplaceDialog then begin with Sender as TReplaceDialog do begin FLastFindOptions := Options; FLastFindText := FindText; end; end else begin with Sender as TFindDialog do begin FLastFindOptions := Options; FLastFindText := FindText; end; end; FLastFindRegEx := FOptions.FindRegEx; Result := TestLastFindOptions; end; function TMainForm.TestLastFindOptions; begin if FLastFindRegEx then begin Result := FActiveMemo.TestRegularExpression(FLastFindText); if not Result then MsgBoxFmt('Invalid regular expression "%s"', [FLastFindText], SCompilerFormCaption, mbError, MB_OK); end else Result := True; end; procedure TMainForm.FindDialogFind(Sender: TObject); begin { This event handler is shared between FindDialog & ReplaceDialog } if not StoreAndTestLastFindOptions(Sender) then Exit; if GetKeyState(VK_MENU) < 0 then begin { Alt+Enter was used to close the dialog } (Sender as TFindDialog).CloseDialog; ESelectAllFindMatchesClick(Self); { Uses the copy made above } end else FindNext(GetKeyState(VK_SHIFT) < 0); end; procedure TMainForm.FindInFilesDialogFind(Sender: TObject); begin if not StoreAndTestLastFindOptions(Sender) then Exit; FindResultsList.Clear; SendMessage(FindResultsList.Handle, LB_SETHORIZONTALEXTENT, 0, 0); FFindResults.Clear; var Hits := 0; var Files := 0; for var Memo in FFileMemos do begin if Memo.Used then begin var StartPos := 0; var EndPos := Memo.RawTextLength; var FileHits := 0; var Range: TScintRange; while (StartPos < EndPos) and Memo.FindText(StartPos, EndPos, FLastFindText, FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), Range) do begin { Also see UpdateFindResult } var Line := Memo.GetLineFromPosition(Range.StartPos); var Prefix := Format(' Line %d: ', [Line+1]); var FindResult := TFindResult.Create; FindResult.Filename := Memo.Filename; FindResult.Line := Line; FindResult.LineStartPos := Memo.GetPositionFromLine(Line); FindResult.Range := Range; FindResult.PrefixStringLength := Length(Prefix); FFindResults.Add(FindResult); FindResultsList.Items.AddObject(Prefix + Memo.Lines[Line], FindResult); Inc(FileHits); StartPos := Range.EndPos; end; Inc(Files); if FileHits > 0 then begin Inc(Hits, FileHits); FindResultsList.Items.Insert(FindResultsList.Count-FileHits, Format('%s (%d hits):', [Memo.Filename, FileHits])); end; end; end; FindResultsList.Items.Insert(0, Format('Find "%s" (%d hits in %d files)', [FindInFilesDialog.FindText, Hits, Files])); FindInFilesDialog.CloseDialog; OutputTabSet.TabIndex := tiFindResults; SetStatusPanelVisible(True); end; function TMainForm.FindSetupDirectiveValue(const DirectiveName, DefaultValue: String): String; begin Result := DefaultValue; var Memo := FMainMemo; { This function only searches the main file } var StartPos := 0; var EndPos := Memo.RawTextLength; var Range: TScintRange; { We rely on the styler to identify [Setup] section lines, but we may be searching into areas that haven't been styled yet } Memo.StyleNeeded(EndPos); while (StartPos < EndPos) and Memo.FindText(StartPos, EndPos, DirectiveName, [sfoWholeWord], Range) do begin var Line := Memo.GetLineFromPosition(Range.StartPos); if FMemosStyler.GetSectionFromLineState(Memo.Lines.State[Line]) = scSetup then begin var LineValue := Memo.Lines[Line].Trim; { LineValue can't be empty } if LineValue[1] <> ';' then begin var LineParts := LineValue.Split(['=']); if (Length(LineParts) = 2) and SameText(LineParts[0].Trim, DirectiveName) then begin Result := LineParts[1].Trim; { If Result is surrounded in quotes, remove them, just like TSetupCompiler.SeparateDirective } if (Length(Result) >= 2) and (Result[1] = '"') and (Result[Length(Result)] = '"') then Result := Copy(Result, 2, Length(Result)-2); Exit; { Compiler doesn't allow a directive to be specified twice so we can exit now } end; end; end; StartPos := Range.EndPos; end; end; function TMainForm.FindSetupDirectiveValue(const DirectiveName: String; DefaultValue: Boolean): Boolean; begin var Value := FindSetupDirectiveValue(DirectiveName, IfThen(DefaultValue, '1', '0')); if not TryStrToBoolean(Value, Result) then Result := DefaultValue; end; procedure TMainForm.EReplaceClick(Sender: TObject); begin FindDialog.CloseDialog; if ReplaceDialog.Handle = 0 then begin InitializeFindText(ReplaceDialog); ReplaceDialog.ReplaceText := FLastReplaceText; end; ExecuteFindDialogAllowingAltEnter(ReplaceDialog); end; procedure TMainForm.ReplaceDialogReplace(Sender: TObject); begin if not StoreAndTestLastFindOptions(Sender) then Exit; FLastReplaceText := ReplaceDialog.ReplaceText; var ReplaceMode := RegExToReplaceMode(FLastFindRegEx); if frReplaceAll in FLastFindOptions then begin var ReplaceCount := 0; FActiveMemo.BeginUndoAction; try var Pos := 0; var Range: TScintRange; while FActiveMemo.FindText(Pos, FActiveMemo.RawTextLength, FLastFindText, FindOptionsToSearchOptions(FLastFindOptions, FLastFindRegEx), Range) do begin var NewRange := FActiveMemo.ReplaceTextRange(Range.StartPos, Range.EndPos, FLastReplaceText, ReplaceMode); Pos := NewRange.EndPos; Inc(ReplaceCount); end; finally FActiveMemo.EndUndoAction; end; if ReplaceCount = 0 then MsgBoxFmt('Cannot find "%s"', [FLastFindText], SCompilerFormCaption, mbInformation, MB_OK) else MsgBoxFmt('%d occurrence(s) replaced.', [ReplaceCount], SCompilerFormCaption, mbInformation, MB_OK); end else begin if FActiveMemo.MainSelTextEquals(FLastFindText, FindOptionsToSearchOptions(frMatchCase in FLastFindOptions, FLastFindRegEx)) then begin { Note: the MainSelTextEquals above performs a search so the replacement below is safe even if the user just enabled regex } FActiveMemo.ReplaceMainSelText(FLastReplaceText, ReplaceMode); end; FindNext(GetKeyState(VK_SHIFT) < 0); end; end; procedure TMainForm.EFindRegExClick(Sender: TObject); begin { If EFindRegEx uses Alt+R as the shortcut just like VSCode then also handle it like VSCode: when the memo does not have the focus open the Run menu (also Alt+R) instead } if not FActiveMemo.Focused and (EFindRegEx.ShortCut = ShortCut(Ord('R'), [ssAlt])) then SendMessage(Handle, WM_SYSCOMMAND, SC_KEYMENU, Ord('r')) else begin FOptions.FindRegEx := not FOptions.FindRegEx; UpdateFindRegExUI; var Ini := TConfigIniFile.Create; try Ini.WriteBool('Options', 'FindRegEx', FOptions.FindRegEx); finally Ini.Free; end; end; end; procedure TMainForm.EFoldOrUnfoldLineClick(Sender: TObject); begin FActiveMemo.FoldLine(FActiveMemo.CaretLine, Sender = EFoldLine); end; procedure TMainForm.UpdateStatusPanelHeight(H: Integer); var MinHeight, MaxHeight: Integer; begin MinHeight := (3 * DebugOutputList.ItemHeight + ToCurrentPPI(4)) + OutputTabSet.Height; MaxHeight := BodyPanel.ClientHeight - ToCurrentPPI(48) - SplitPanel.Height; if H > MaxHeight then H := MaxHeight; if H < MinHeight then H := MinHeight; StatusPanel.Height := H; end; procedure TMainForm.UpdateOccurrenceIndicators(const AMemo: TIDEScintEdit); procedure FindTextAndAddRanges(const AMemo: TIDEScintEdit; const TextToFind: TScintRawString; const Options: TScintFindOptions; const Selections, IndicatorRanges: TScintRangeList); begin if TScintEdit.RawStringIsBlank(TextToFind) then Exit; var StartPos := 0; var EndPos := AMemo.RawTextLength; var FoundRange: TScintRange; while (StartPos < EndPos) and AMemo.FindRawText(StartPos, EndPos, TextToFind, Options, FoundRange) do begin StartPos := FoundRange.EndPos; { Don't add indicators on lines which have a line marker } var Line := AMemo.GetLineFromPosition(FoundRange.StartPos); var Markers := AMemo.GetMarkers(Line); if Markers * [mlmError, mlmBreakpointBad, mlmStep] <> [] then Continue; { Add indicator while making sure it does not overlap any regular selection styling for either the main selection or any additional selection. Does not account for an indicator overlapping more than 1 selection. } var OverlappingSelection: TScintRange; if Selections.Overlaps(FoundRange, OverlappingSelection) then begin if FoundRange.StartPos < OverlappingSelection.StartPos then IndicatorRanges.Add(TScintRange.Create(FoundRange.StartPos, OverlappingSelection.StartPos)); if FoundRange.EndPos > OverlappingSelection.EndPos then IndicatorRanges.Add(TScintRange.Create(OverlappingSelection.EndPos, FoundRange.EndPos)); end else IndicatorRanges.Add(FoundRange); end; end; function HighlightAtCursorAllowed(const Word: TScintRawString): Boolean; begin const Section = FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]); Result := FMemosStyler.HighlightAtCursorAllowed(Section, FActiveMemo.ConvertRawStringToString(Word)); end; begin { Add occurrence indicators for the word at cursor if there's any and the main selection is within this word. On top of those add occurrence indicators for the main selected text if there's any. Don't do anything if the main selection is not single line. All of these things are just like VSCode. } var MainSelection: TScintRange; var MainSelNotEmpty := AMemo.SelNotEmpty(MainSelection); var MainSelSingleLine := AMemo.GetLineFromPosition(MainSelection.StartPos) = AMemo.GetLineFromPosition(MainSelection.EndPos); var IndicatorRanges: TScintRangeList := nil; var Selections: TScintRangeList := nil; try IndicatorRanges := TScintRangeList.Create; Selections := TScintRangeList.Create; if FOptions.HighlightWordAtCursorOccurrences and (AMemo.CaretVirtualSpace = 0) and MainSelSingleLine then begin var Word := AMemo.WordAtCaretRange; if (Word.StartPos <> Word.EndPos) and MainSelection.Within(Word) then begin var TextToIndicate := AMemo.GetRawTextRange(Word.StartPos, Word.EndPos); if HighlightAtCursorAllowed(TextToIndicate) then begin AMemo.GetSelections(Selections); { Gets any additional selections as well } FindTextAndAddRanges(AMemo, TextToIndicate, [sfoMatchCase, sfoWholeWord], Selections, IndicatorRanges); end; end; end; AMemo.UpdateIndicators(IndicatorRanges, minWordAtCursorOccurrence); IndicatorRanges.Clear; if FOptions.HighlightSelTextOccurrences and MainSelNotEmpty and MainSelSingleLine then begin var TextToIndicate := AMemo.RawMainSelText; if Selections.Count = 0 then { If 0 then we didn't already call GetSelections above} AMemo.GetSelections(Selections); FindTextAndAddRanges(AMemo, TextToIndicate, [], Selections, IndicatorRanges); end; AMemo.UpdateIndicators(IndicatorRanges, minSelTextOccurrence); finally Selections.Free; IndicatorRanges.Free; end; end; procedure TMainForm.UpdateImages; { Should be called at startup and after DPI changes } begin var WH := MulDiv(16, CurrentPPI, 96); var Images := ImagesModule.LightToolBarImageCollection; var Image := Images.GetSourceImage(Images.GetIndexByName('heart-filled'), WH, WH); UpdatePanelDonateImage.Picture.Graphic:= Image; end; procedure TMainForm.UpdateOutputTabSetListsItemHeightAndDebugTimeWidth; { Should be called at startup and after DPI changes } begin CompilerOutputList.Canvas.Font.Assign(CompilerOutputList.Font); CompilerOutputList.ItemHeight := CompilerOutputList.Canvas.TextHeight('0') + 1; DebugOutputList.Canvas.Font.Assign(DebugOutputList.Font); FDebugLogListTimestampsWidth := DebugOutputList.Canvas.TextWidth(Format('[00%s00%s00%s000] ', [FormatSettings.TimeSeparator, FormatSettings.TimeSeparator, FormatSettings.DecimalSeparator])); DebugOutputList.ItemHeight := DebugOutputList.Canvas.TextHeight('0') + 1; DebugCallStackList.Canvas.Font.Assign(DebugCallStackList.Font); DebugCallStackList.ItemHeight := DebugCallStackList.Canvas.TextHeight('0') + 1; FindResultsList.Canvas.Font.Assign(FindResultsList.Font); FindResultsList.ItemHeight := FindResultsList.Canvas.TextHeight('0') + 1; end; type TBitmapWithBits = class Handle: HBITMAP; pvBits: Pointer; destructor Destroy; override; end; destructor TBitmapWithBits.Destroy; begin if Handle <> 0 then DeleteObject(Handle); inherited; end; procedure TMainForm.UpdateMarginsAndAutoCompleteIcons; { Should be called at startup and after theme and DPI changes } type TMarkerOrACBitmaps = TObjectDictionary; procedure SwapRedBlue(const pvBits: PByte; Width, Height: Integer); begin var pvPixel := pvBits; var pvMax := pvBits + 4*Width*Height; while pvPixel < pvMax do begin var Tmp := PByte(pvPixel)^; PByte(pvPixel)^ := PByte(pvPixel + 2)^; PByte(pvPixel + 2)^ := Tmp; Inc(pvPixel, 4); end; end; procedure AddMarkerOrACBitmap(const MarkerOrACBitmaps: TMarkerOrACBitmaps; const DC: HDC; const BitmapInfo: TBitmapInfo; const MarkerNumberOrACType: Integer; const BkBrush: TBrush; const ImageList: TVirtualImageList; const ImageName: String); begin { Prepare a bitmap and select it } var pvBits: Pointer; var Bitmap := CreateDIBSection(DC, BitmapInfo, DIB_RGB_COLORS, pvBits, 0, 0); var OldBitmap := SelectObject(DC, Bitmap); { Fill the entire bitmap to avoid any alpha so we don't have to worry about whether will be premultiplied or not (it was in tests) when Scintilla wants it without premultiplication } var Width := BitmapInfo.bmiHeader.biWidth; var Height := Abs(BitmapInfo.bmiHeader.biHeight); var Rect := TRect.Create(0, 0, Width, Height); FillRect(DC, Rect, BkBrush.Handle); { Draw the image - the result will be in pvBits } if ImageList_Draw(ImageList.Handle, ImageList.GetIndexByName(ImageName), DC, 0, 0, ILD_TRANSPARENT) then begin SwapRedBlue(pvBits, Width, Height); { Change pvBits from BGRA to RGBA like Scintilla wants } var Bitmap2 := TBitmapWithBits.Create; Bitmap2.Handle := Bitmap; Bitmap2.pvBits := pvBits; MarkerOrACBitmaps.Add(MarkerNumberOrACType, Bitmap2); end else begin SelectObject(DC, OldBitmap); DeleteObject(Bitmap); end; end; type TMarkerNumberOrACType = TPair; function NNT(const MarkerNumberOrACType: Integer; const Name: String): TMarkerNumberOrACType; begin Result := TMarkerNumberOrACType.Create(MarkerNumberOrACType, Name); { This is a record so no need to free } end; begin var ImageList := ThemedMarkersAndACVirtualImageList; var DC := CreateCompatibleDC(0); if DC <> 0 then begin try var MarkerBitmaps: TMarkerOrACBitmaps := nil; var MarkerBkBrush: TBrush := nil; var AutoCompleteBitmaps: TMarkerOrACBitmaps := nil; var AutoCompleteBkBrush: TBrush := nil; try var BitmapInfo := CreateBitmapInfo(ImageList.Width, -ImageList.Height, 32); { This is a record so no need to free } MarkerBitmaps := TMarkerOrACBitmaps.Create([doOwnsValues]); MarkerBkBrush := TBrush.Create; MarkerBkBrush.Color := FTheme.Colors[tcMarginBack]; var NamedMarkers := [ NNT(mmiHasEntry, 'markers\debug-stop-filled'), NNT(mmiEntryProcessed, 'markers\debug-stop-filled_2'), NNT(mmiBreakpoint, 'markers\debug-breakpoint-filled'), NNT(mmiBreakpointBad, 'markers\debug-breakpoint-filled-cancel-2'), NNT(mmiBreakpointGood, 'markers\debug-breakpoint-filled-ok-2'), NNT(mmiStep, 'markers\symbol-arrow-right'), NNT(mmiBreakpointStep, 'markers\debug-breakpoint-filled-ok2-symbol-arrow-right'), NNT(SC_MARKNUM_FOLDER, 'markers\symbol-add'), NNT(SC_MARKNUM_FOLDEROPEN, 'markers\symbol-remove')]; for var NamedMarker in NamedMarkers do AddMarkerOrAcBitmap(MarkerBitmaps, DC, BitmapInfo, NamedMarker.Key, MarkerBkBrush, ImageList, NamedMarker.Value); AutoCompleteBitmaps := TMarkerOrACBitmaps.Create([doOwnsValues]); AutoCompleteBkBrush := TBrush.Create; AutoCompleteBkBrush.Color := FTheme.Colors[tcIntelliBack]; var NamedTypes := [ NNT(awtSection, 'ac\structure-filled'), NNT(awtParameter, 'ac\xml-filled'), NNT(awtDirective, 'ac\xml-filled'), NNT(awtFlag, 'ac\values'), NNT(awtPreprocessorDirective, 'ac\symbol-hashtag'), NNT(awtConstant, 'ac\constant-filled_2'), NNT(awtScriptFunction, 'ac\method-filled'), NNT(awtScriptType, 'ac\types'), NNT(awtScriptVariable, 'ac\variables'), NNT(awtScriptConstant, 'ac\constant-filled'), NNT(awtScriptInterface, 'ac\interface-filled'), NNT(awtScriptProperty, 'ac\properties-filled'), NNT(awtScriptEvent, 'ac\event-filled'), NNT(awtScriptKeyword, 'ac\list'), NNT(awtScriptEnumValue, 'ac\constant-filled')]; for var NamedType in NamedTypes do AddMarkerOrAcBitmap(AutoCompleteBitmaps, DC, BitmapInfo, NamedType.Key, AutoCompleteBkBrush, ImageList, NamedType.Value); for var Memo in FMemos do begin Memo.Call(SCI_RGBAIMAGESETWIDTH, ImageList.Width, 0); Memo.Call(SCI_RGBAIMAGESETHEIGHT, ImageList.Height, 0); for var MarkerBitmap in MarkerBitmaps do Memo.Call(SCI_MARKERDEFINERGBAIMAGE, MarkerBitmap.Key, LPARAM(MarkerBitmap.Value.pvBits)); for var AutoCompleteBitmap in AutoCompleteBitmaps do Memo.Call(SCI_REGISTERRGBAIMAGE, AutoCompleteBitmap.Key, LPARAM(AutoCompleteBitmap.Value.pvBits)); end; finally AutoCompleteBkBrush.Free; AutoCompleteBitmaps.Free; MarkerBkBrush.Free; MarkerBitmaps.Free; end; finally DeleteDC(DC); end; end; end; procedure TMainForm.UpdateMarginsAndSquigglyAndCaretWidths; { Update the width of our two margins. Note: the width of the line numbers margin is fully handled by TScintEdit. Should be called at startup and after DPI change. } begin var IconMarkersWidth := ToCurrentPPI(18); { 3 pixel margin on both sides of the icon } var BaseChangeHistoryWidth := ToCurrentPPI(6); { 6 = 2 pixel bar with 2 pixel margin on both sides because: "SC_MARK_BAR ... takes ... 1/3 of the margin width" } var FolderMarkersWidth := ToCurrentPPI(14); { 1 pixel margin on boths side of the icon } var LeftBlankMarginWidth := ToCurrentPPI(2); { 2 pixel margin between gutter and the main text } var SquigglyWidth := ToCurrentPPI(100); { 100 = 1 pixel } var CaretWidth := ToCurrentPPI(2); var WhiteSpaceSize := CaretWidth; for var Memo in FMemos do Memo.UpdateWidthsAndSizes(IconMarkersWidth, BaseChangeHistoryWidth, FolderMarkersWidth, LeftBlankMarginWidth, 0, SquigglyWidth, CaretWidth, WhiteSpaceSize); end; procedure TMainForm.SplitPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if (ssLeft in Shift) and StatusPanel.Visible then begin UpdateStatusPanelHeight(BodyPanel.ClientToScreen(Point(0, 0)).Y - SplitPanel.ClientToScreen(Point(0, Y)).Y + BodyPanel.ClientHeight - (SplitPanel.Height div 2)); end; end; procedure TMainForm.SimpleMenuClick(Sender: TObject); begin ApplyMenuBitmaps(Sender as TMenuItem); end; procedure TMainForm.TMenuClick(Sender: TObject); var MemoIsReadOnly: Boolean; begin MemoIsReadOnly := FActiveMemo.ReadOnly; TGenerateGUID.Enabled := not MemoIsReadOnly; TMsgBoxDesigner.Enabled := not MemoIsReadOnly; TFilesDesigner.Enabled := not MemoIsReadOnly; TRegistryDesigner.Enabled := not MemoIsReadOnly; ApplyMenuBitmaps(Sender as TMenuItem); end; procedure TMainForm.TAddRemoveProgramsClick(Sender: TObject); begin StartAddRemovePrograms; end; procedure TMainForm.TGenerateGUIDClick(Sender: TObject); begin if MsgBox('The generated GUID will be inserted into the editor at the cursor position. Continue?', SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then FActiveMemo.MainSelText := GenerateGuid; end; procedure TMainForm.TMsgBoxDesignerClick(Sender: TObject); begin if (FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]) <> scCode) and (MsgBox('The generated Pascal script will be inserted into the editor at the cursor position, but the cursor is not in the [Code] section. Continue anyway?', SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDNO) then Exit; var MsgBoxForm := TMsgBoxDesignerForm.Create(Application); try if MsgBoxForm.ShowModal = mrOk then FActiveMemo.MainSelText := MsgBoxForm.GetText(FOptions.TabWidth, FOptions.UseTabCharacter); finally MsgBoxForm.Free; end; end; procedure TMainForm.TRegistryDesignerClick(Sender: TObject); begin var RegistryDesignerForm := TRegistryDesignerForm.Create(Application); try var PrivilegesRequired := FindSetupDirectiveValue('PrivilegesRequired', 'admin'); var PrivilegesRequiredOverridesAllowed := FindSetupDirectiveValue('PrivilegesRequiredOverridesAllowed', ''); if PrivilegesRequiredOverridesAllowed = '' then begin if SameText(PrivilegesRequired, 'admin') then RegistryDesignerForm.PrivilegesRequired := prAdmin else RegistryDesignerForm.PrivilegesRequired := prLowest end else RegistryDesignerForm.PrivilegesRequired := prDynamic; if RegistryDesignerForm.ShowModal = mrOk then begin FActiveMemo.CaretColumn := 0; var Text := RegistryDesignerForm.Text; if FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]) <> scRegistry then Text := '[Registry]' + SNewLine + Text; FActiveMemo.MainSelText := Text; end; finally RegistryDesignerForm.Free; end; end; procedure TMainForm.TFilesDesignerClick(Sender: TObject); begin var FilesDesignerForm := TFilesDesignerForm.Create(Application); try FilesDesignerForm.CreateAppDir := FindSetupDirectiveValue('CreateAppDir', True); if FilesDesignerForm.ShowModal = mrOk then begin FActiveMemo.CaretColumn := 0; var Text := FilesDesignerForm.Text; if FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.CaretLine]) <> scFiles then Text := '[Files]' + SNewLine + Text; FActiveMemo.MainSelText := Text; end; finally FilesDesignerForm.Free; end; end; procedure TMainForm.TSignToolsClick(Sender: TObject); var SignToolsForm: TSignToolsForm; Ini: TConfigIniFile; I: Integer; begin SignToolsForm := TSignToolsForm.Create(Application); try SignToolsForm.SignTools := FSignTools; if SignToolsForm.ShowModal <> mrOK then Exit; FSignTools.Assign(SignToolsForm.SignTools); { Save new options } Ini := TConfigIniFile.Create; try Ini.EraseSection('SignTools'); for I := 0 to FSignTools.Count-1 do Ini.WriteString('SignTools', 'SignTool' + IntToStr(I), FSignTools[I]); finally Ini.Free; end; finally SignToolsForm.Free; end; end; procedure TMainForm.TOptionsClick(Sender: TObject); var OptionsForm: TOptionsForm; Ini: TConfigIniFile; Memo: TIDEScintEdit; begin OptionsForm := TOptionsForm.Create(Application); try OptionsForm.StartupCheck.Checked := FOptions.ShowStartupForm; OptionsForm.WizardCheck.Checked := FOptions.UseWizard; OptionsForm.AutosaveCheck.Checked := FOptions.Autosave; OptionsForm.BackupCheck.Checked := FOptions.MakeBackups; OptionsForm.FullPathCheck.Checked := FOptions.FullPathInTitleBar; OptionsForm.UndoAfterSaveCheck.Checked := FOptions.UndoAfterSave; OptionsForm.PauseOnDebuggerExceptionsCheck.Checked := FOptions.PauseOnDebuggerExceptions; OptionsForm.RunAsDifferentUserCheck.Checked := FOptions.RunAsDifferentUser; OptionsForm.AutoAutoCompleteCheck.Checked := FOptions.AutoAutoComplete; OptionsForm.UseSynHighCheck.Checked := FOptions.UseSyntaxHighlighting; OptionsForm.ColorizeCompilerOutputCheck.Checked := FOptions.ColorizeCompilerOutput; OptionsForm.UnderlineErrorsCheck.Checked := FOptions.UnderlineErrors; OptionsForm.CursorPastEOLCheck.Checked := FOptions.CursorPastEOL; OptionsForm.TabWidthEdit.Text := IntToStr(FOptions.TabWidth); OptionsForm.UseTabCharacterCheck.Checked := FOptions.UseTabCharacter; OptionsForm.ShowWhiteSpaceCheck.Checked := FOptions.ShowWhiteSpace; OptionsForm.UseFoldingCheck.Checked := FOptions.UseFolding; OptionsForm.AutoIndentCheck.Checked := FOptions.AutoIndent; OptionsForm.IndentationGuidesCheck.Checked := FOptions.IndentationGuides; OptionsForm.GutterLineNumbersCheck.Checked := FOptions.GutterLineNumbers; OptionsForm.ShowPreprocessorOutputCheck.Checked := FOptions.ShowPreprocessorOutput; OptionsForm.OpenIncludedFilesCheck.Checked := FOptions.OpenIncludedFiles; OptionsForm.KeyMappingComboBox.ItemIndex := Ord(FOptions.KeyMappingType); OptionsForm.MemoKeyMappingComboBox.ItemIndex := Ord(FOptions.MemoKeyMappingType); OptionsForm.ThemeComboBox.ItemIndex := Ord(FOptions.ThemeType); OptionsForm.FontPanel.Font.Assign(FMainMemo.Font); OptionsForm.FontPanel.ParentBackground := False; OptionsForm.FontPanel.Color := FMainMemo.Color; OptionsForm.HighlightWordAtCursorOccurrencesCheck.Checked := FOptions.HighlightWordAtCursorOccurrences; OptionsForm.HighlightSelTextOccurrencesCheck.Checked := FOptions.HighlightSelTextOccurrences; if OptionsForm.ShowModal <> mrOK then Exit; FOptions.ShowStartupForm := OptionsForm.StartupCheck.Checked; FOptions.UseWizard := OptionsForm.WizardCheck.Checked; FOptions.Autosave := OptionsForm.AutosaveCheck.Checked; FOptions.MakeBackups := OptionsForm.BackupCheck.Checked; FOptions.FullPathInTitleBar := OptionsForm.FullPathCheck.Checked; FOptions.UndoAfterSave := OptionsForm.UndoAfterSaveCheck.Checked; FOptions.PauseOnDebuggerExceptions := OptionsForm.PauseOnDebuggerExceptionsCheck.Checked; FOptions.RunAsDifferentUser := OptionsForm.RunAsDifferentUserCheck.Checked; FOptions.AutoAutoComplete := OptionsForm.AutoAutoCompleteCheck.Checked; FOptions.UseSyntaxHighlighting := OptionsForm.UseSynHighCheck.Checked; FOptions.ColorizeCompilerOutput := OptionsForm.ColorizeCompilerOutputCheck.Checked; FOptions.UnderlineErrors := OptionsForm.UnderlineErrorsCheck.Checked; FOptions.CursorPastEOL := OptionsForm.CursorPastEOLCheck.Checked; FOptions.TabWidth := StrToInt(OptionsForm.TabWidthEdit.Text); FOptions.UseTabCharacter := OptionsForm.UseTabCharacterCheck.Checked; FOptions.ShowWhiteSpace := OptionsForm.ShowWhiteSpaceCheck.Checked; FOptions.UseFolding := OptionsForm.UseFoldingCheck.Checked; FOptions.AutoIndent := OptionsForm.AutoIndentCheck.Checked; FOptions.IndentationGuides := OptionsForm.IndentationGuidesCheck.Checked; FOptions.GutterLineNumbers := OptionsForm.GutterLineNumbersCheck.Checked; FOptions.ShowPreprocessorOutput := OptionsForm.ShowPreprocessorOutputCheck.Checked; FOptions.OpenIncludedFiles := OptionsForm.OpenIncludedFilesCheck.Checked; FOptions.KeyMappingType := TKeyMappingType(OptionsForm.KeyMappingComboBox.ItemIndex); FOptions.MemoKeyMappingType := TIDEScintKeyMappingType(OptionsForm.MemoKeyMappingComboBox.ItemIndex); FOptions.ThemeType := TThemeType(OptionsForm.ThemeComboBox.ItemIndex); FOptions.HighlightWordAtCursorOccurrences := OptionsForm.HighlightWordAtCursorOccurrencesCheck.Checked; FOptions.HighlightSelTextOccurrences := OptionsForm.HighlightSelTextOccurrencesCheck.Checked; UpdateCaption; UpdatePreprocMemos; InvalidateStatusPanel(spHiddenFilesCount); for Memo in FMemos do begin { Move caret to start of line to ensure it doesn't end up in the middle of a double-byte character if the code page changes from SBCS to DBCS } Memo.CaretLine := Memo.CaretLine; Memo.Font.Assign(OptionsForm.FontPanel.Font); end; SyncEditorOptions; UpdateMarginsAndSquigglyAndCaretWidths; UpdateNewMainFileButtons; UpdateOccurrenceIndicators(FActiveMemo); UpdateKeyMapping; UpdateTheme; { Save new options } Ini := TConfigIniFile.Create; try Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm); Ini.WriteBool('Options', 'UseWizard', FOptions.UseWizard); Ini.WriteBool('Options', 'Autosave', FOptions.Autosave); Ini.WriteBool('Options', 'MakeBackups', FOptions.MakeBackups); Ini.WriteBool('Options', 'FullPathInTitleBar', FOptions.FullPathInTitleBar); Ini.WriteBool('Options', 'UndoAfterSave', FOptions.UndoAfterSave); Ini.WriteBool('Options', 'PauseOnDebuggerExceptions', FOptions.PauseOnDebuggerExceptions); Ini.WriteBool('Options', 'RunAsDifferentUser', FOptions.RunAsDifferentUser); Ini.WriteBool('Options', 'AutoComplete', FOptions.AutoAutoComplete); Ini.WriteBool('Options', 'AutoCallTips', FOptions.AutoCallTips); Ini.WriteBool('Options', 'UseSynHigh', FOptions.UseSyntaxHighlighting); Ini.WriteBool('Options', 'ColorizeCompilerOutput', FOptions.ColorizeCompilerOutput); Ini.WriteBool('Options', 'UnderlineErrors', FOptions.UnderlineErrors); Ini.WriteBool('Options', 'HighlightWordAtCursorOccurrences', FOptions.HighlightWordAtCursorOccurrences); Ini.WriteBool('Options', 'HighlightSelTextOccurrences', FOptions.HighlightSelTextOccurrences); Ini.WriteBool('Options', 'EditorCursorPastEOL', FOptions.CursorPastEOL); Ini.WriteInteger('Options', 'TabWidth', FOptions.TabWidth); Ini.WriteBool('Options', 'UseTabCharacter', FOptions.UseTabCharacter); Ini.WriteBool('Options', 'ShowWhiteSpace', FOptions.ShowWhiteSpace); Ini.WriteBool('Options', 'UseFolding', FOptions.UseFolding); Ini.WriteBool('Options', 'AutoIndent', FOptions.AutoIndent); Ini.WriteBool('Options', 'IndentationGuides', FOptions.IndentationGuides); Ini.WriteBool('Options', 'GutterLineNumbers', FOptions.GutterLineNumbers); Ini.WriteBool('Options', 'ShowPreprocessorOutput', FOptions.ShowPreprocessorOutput); Ini.WriteBool('Options', 'OpenIncludedFiles', FOptions.OpenIncludedFiles); Ini.WriteInteger('Options', 'KeyMappingType', Ord(FOptions.KeyMappingType)); Ini.WriteInteger('Options', 'MemoKeyMappingType', Ord(FOptions.MemoKeyMappingType)); Ini.WriteInteger('Options', 'ThemeType', Ord(FOptions.ThemeType)); { Also see Destroy } Ini.WriteString('Options', 'EditorFontName', FMainMemo.Font.Name); Ini.WriteInteger('Options', 'EditorFontSize', FMainMemo.Font.Size); Ini.WriteInteger('Options', 'EditorFontCharset', FMainMemo.Font.Charset); finally Ini.Free; end; finally OptionsForm.Free; end; end; { Also see TabIndexToMemoIndex } function TMainForm.MemoToTabIndex(const AMemo: TIDEScintEdit): Integer; begin if AMemo = FMainMemo then Result := 0 { First tab displays the main memo } else if AMemo = FPreprocessorOutputMemo then begin if not FPreprocessorOutputMemo.Used then raise Exception.Create('not FPreprocessorOutputMemo.Used'); Result := MemosTabSet.Tabs.Count-1 { Last tab displays the preprocessor output memo } end else begin Result := FFileMemos.IndexOf(AMemo as TIDEScintFileEdit); { Other tabs display include files which start second tab } { Filter memos explicitly hidden by the user } for var MemoIndex := Result-1 downto 0 do if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) <> -1 then Dec(Result); end; end; { Also see MemoToTabIndex } function TMainForm.TabIndexToMemo(const ATabIndex, AMaxTabIndex: Integer): TIDEScintEdit; begin if ATabIndex = 0 then Result := FMemos[0] { First tab displays the main memo which is FMemos[0] } else if FPreprocessorOutputMemo.Used and (ATabIndex = AMaxTabIndex) then Result := FMemos[1] { Last tab displays the preprocessor output memo which is FMemos[1] } else begin { Only count memos not explicitly hidden by the user } var TabIndex := 0; for var MemoIndex := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin if FHiddenFiles.IndexOf(FFileMemos[MemoIndex].Filename) = -1 then begin Inc(TabIndex); if TabIndex = ATabIndex then begin Result := FMemos[MemoIndex + 1]; { Other tabs display include files which start at second tab but at FMemos[2] } Exit; end; end; end; raise Exception.Create('TabIndexToMemo failed'); end; end; procedure TMainForm.MoveCaretAndActivateMemo(AMemo: TIDEScintEdit; const LineNumberOrPosition: Integer; const AlwaysResetColumnEvenIfOnRequestedLineAlready: Boolean; const IsPosition: Boolean; const PositionVirtualSpace: Integer); var Pos: Integer; begin { Reopen tab if needed } if AMemo is TIDEScintFileEdit then begin var FileName := (AMemo as TIDEScintFileEdit).Filename; var HiddenFileIndex := FHiddenFiles.IndexOf(Filename); if HiddenFileIndex <> -1 then begin ReopenTabOrTabs(HiddenFileIndex, False); { The above call to ReopenTabOrTabs will currently lead to a call to UpdateIncludedFilesMemos which sets up all the memos. Currently it will keep same memo for the reopened file but in case it no longer does at some point: look it up again } AMemo := nil; for var Memo in FFileMemos do begin if Memo.Used and (PathCompare(Memo.Filename, Filename) = 0) then begin AMemo := Memo; Break; end; end; if AMemo = nil then raise Exception.Create('AMemo MIA'); end; end; { Move caret } if IsPosition then Pos := LineNumberOrPosition else if AlwaysResetColumnEvenIfOnRequestedLineAlready or (AMemo.CaretLine <> LineNumberOrPosition) then Pos := AMemo.GetPositionFromLine(LineNumberOrPosition) else Pos := AMemo.CaretPosition; { Not actually moving caret - it's already were we want it} { If the line is in a contracted section, expand it } AMemo.EnsureLineVisible(AMemo.GetLineFromPosition(Pos)); { If the line isn't in view, scroll so that it's in the center } if not AMemo.IsPositionInViewVertically(Pos) then AMemo.TopLine := AMemo.GetVisibleLineFromDocLine(AMemo.GetLineFromPosition(Pos)) - (AMemo.LinesInWindow div 2); AMemo.CaretPosition := Pos; if IsPosition then AMemo.CaretVirtualSpace := PositionVirtualSpace; { Activate memo } MemosTabSet.TabIndex := MemoToTabIndex(AMemo); { This causes MemosTabSetClick to show the memo } end; procedure TMainForm.SetErrorLine(const AMemo: TIDEScintFileEdit; const ALine: Integer); var OldLine: Integer; begin if AMemo <> FErrorMemo then begin SetErrorLine(FErrorMemo, -1); FErrorMemo := AMemo; end; if FErrorMemo.ErrorLine <> ALine then begin OldLine := FErrorMemo.ErrorLine; FErrorMemo.ErrorLine := ALine; if OldLine >= 0 then UpdateLineMarkers(FErrorMemo, OldLine); if FErrorMemo.ErrorLine >= 0 then begin FErrorMemo.ErrorCaretPosition := FErrorMemo.CaretPosition; UpdateLineMarkers(FErrorMemo, FErrorMemo.ErrorLine); end; end; end; procedure TMainForm.SetStepLine(const AMemo: TIDEScintFileEdit; ALine: Integer); var OldLine: Integer; begin if AMemo <> FStepMemo then begin SetStepLine(FStepMemo, -1); FStepMemo := AMemo; end; if FStepMemo.StepLine <> ALine then begin OldLine := FStepMemo.StepLine; FStepMemo.StepLine := ALine; if OldLine >= 0 then UpdateLineMarkers(FStepMemo, OldLine); if FStepMemo.StepLine >= 0 then UpdateLineMarkers(FStepMemo, FStepMemo.StepLine); end; end; procedure TMainForm.HideError; begin SetErrorLine(FErrorMemo, -1); if not FCompiling then StatusBar.Panels[spExtraStatus].Text := ''; end; procedure TMainForm.RemoveMemoFromNav(const AMemo: TIDEScintEdit); begin if FNavStacks.RemoveMemo(AMemo) then UpdateNavButtons; if FCurrentNavItem.Memo = AMemo then FCurrentNavItem.Invalidate; end; procedure TMainForm.RemoveMemoBadLinesFromNav(const AMemo: TIDEScintEdit); begin if FNavStacks.RemoveMemoBadLines(AMemo) then UpdateNavButtons; { We do NOT update FCurrentNav here so it might point to a line that's deleted until next UpdateCaretPosPanelAndBackStack by UpdateMemoUI } end; procedure TMainForm.UpdateNavButtons; begin ForwardNavButton.Enabled := FNavStacks.Forward.Count > 0; BackNavButton.Enabled := (FNavStacks.Back.Count > 0) or ForwardNavButton.Enabled; { for the dropdown } end; procedure TMainForm.BackNavButtonClick(Sender: TObject); begin { Delphi does not support BTNS_WHOLEDROPDOWN so we can't be like VS which can have a disabled back nav button with an enabled dropdown. To avoid always showing two dropdowns we keep the back button enabled when we need the dropdown. So we need to check for this. } if FNavStacks.Back.Count = 0 then begin Beep; Exit; end; FNavStacks.Forward.Add(FCurrentNavItem); var NewNavItem := FNavStacks.Back.ExtractAt(FNavStacks.Back.Count-1); UpdateNavButtons; FCurrentNavItem := NewNavItem; { Must be done *before* moving } MoveCaretAndActivateMemo(NewNavItem.Memo, NewNavItem.Memo.GetPositionFromLineColumn(NewNavItem.Line, NewNavItem.Column), False, True, NewNavItem.VirtualSpace); end; procedure TMainForm.ForwardNavButtonClick(Sender: TObject); begin FNavStacks.Back.Add(FCurrentNavItem); var NewNavItem := FNavStacks.Forward.ExtractAt(FNavStacks.Forward.Count-1); UpdateNavButtons; FCurrentNavItem := NewNavItem; { Must be done *before* moving } MoveCaretAndActivateMemo(NewNavItem.Memo, NewNavItem.Memo.GetPositionFromLineColumn(NewNavItem.Line, NewNavItem.Column), False, True, NewNavItem.VirtualSpace); end; procedure TMainForm.WMAppCommand(var Message: TMessage); begin var Command := GET_APPCOMMAND_LPARAM(Message.LParam); if Command = APPCOMMAND_BROWSER_BACKWARD then begin if BackNavButton.Enabled then BackNavButton.Click; Message.Result := 1; end else if Command = APPCOMMAND_BROWSER_FORWARD then begin if ForwardNavButton.Enabled then ForwardNavButton.Click; Message.Result := 1; end; end; procedure TMainForm.NavItemClick(Sender: TObject); begin var MenuItem := Sender as TMenuItem; var Clicks := Abs(MenuItem.Tag); if Clicks > 0 then begin var ButtonToClick: TToolButton; if MenuItem.Tag > 0 then ButtonToClick := ForwardNavButton else ButtonToClick := BackNavButton; while Clicks > 0 do begin if not ButtonToClick.Enabled then raise Exception.Create('not ButtonToClick.Enabled'); ButtonToClick.Click; Dec(Clicks); end; end; end; procedure TMainForm.NavPopupMenuClick(Sender: TObject); procedure AddNavItemToMenu(const NavItem: TIDEScintEditNavItem; const Checked: Boolean; const ClicksNeeded: Integer; const Menu: TMenuItem); begin if NavItem.Line >= NavItem.Memo.Lines.Count then raise Exception.Create('NavItem.Line >= NavItem.Memo.Lines.Count'); var LineInfo := NavItem.Memo.Lines[NavItem.Line]; if LineInfo.Trim = '' then LineInfo := Format('Line %d', [NavItem.Line+1]); var Caption: String; if MemosTabSet.Visible then Caption := Format('%s: %s', [MemosTabSet.Tabs[MemoToTabIndex(NavItem.Memo)], LineInfo]) else Caption := LineInfo; var MenuItem := TMenuItem.Create(Menu); MenuItem.Caption := DoubleAmp(Caption); MenuItem.Checked := Checked; MenuItem.RadioItem := True; MenuItem.Tag := ClicksNeeded; MenuItem.OnClick := NavItemClick; Menu.Add(MenuItem); end; begin var Menu := Sender as TMenuItem; Menu.Clear; { Setup dropdown. The result should end up being just like Visual Studio 2022 which means from top to bottom: - Furthest (=oldest) forward item - ... - Closest (=next) forward item - Current position in the active memo, checked - Closest (=next) back item - ... - Furthest (=oldest) back item The Tag parameter should be set to the amount of clicks needed to get to the item, positive for forward and negative for back } for var I := 0 to FNavStacks.Forward.Count-1 do AddNavItemToMenu(FNavStacks.Forward[I], False, FNavStacks.Forward.Count-I, Menu); AddNavItemToMenu(FCurrentNavItem, True, 0, Menu); for var I := FNavStacks.Back.Count-1 downto 0 do AddNavItemToMenu(FNavStacks.Back[I], False, -(FNavStacks.Back.Count-I), Menu); end; procedure TMainForm.UpdateCaretPosPanelAndBackNavStack; begin { Update panel } var Text := Format('%4d:%4d', [FActiveMemo.CaretLine + 1, FActiveMemo.CaretColumnExpandedForTabs + 1]); if FOptions.ShowCaretPosition then begin const CaretPos = FActiveMemo.CaretPosition; const Style = FActiveMemo.GetStyleAtPosition(CaretPos); Text := Format('%s@%d+%d:%s', [Copy(GetEnumName(TypeInfo(TInnoSetupStylerStyle), Style), 3, MaxInt), CaretPos, FActiveMemo.CaretVirtualSpace, Text]); end; StatusBar.Panels[spCaretPos].Text := Text; { Update NavStacks.Back if needed and remember new position } var NewNavItem := TIDEScintEditNavItem.Create(FActiveMemo); { This is a record so no need to free } if FCurrentNavItem.Valid and FNavStacks.AddNewBackForJump(FCurrentNavItem, NewNavItem) then UpdateNavButtons; FCurrentNavItem := NewNavItem; end; procedure TMainForm.UpdateEditModePanel; const InsertText: array[Boolean] of String = ('Overwrite', 'Insert'); begin if FActiveMemo.ReadOnly then StatusBar.Panels[spEditMode].Text := 'Read only' else StatusBar.Panels[spEditMode].Text := InsertText[FActiveMemo.InsertMode]; end; procedure TMainForm.UpdateFindRegExUI; const FindRegExText: array[Boolean] of String = ('', '.*'); begin StatusBar.Panels[spFindRegEx].Text := FindRegExText[FOptions.FindRegEx]; if FOptions.FindRegEx then begin FindDialog.Options := FindDialog.Options + [frHideWholeWord]; ReplaceDialog.Options := ReplaceDialog.Options + [frHideWholeWord]; end else begin FindDialog.Options := FindDialog.Options - [frHideWholeWord]; ReplaceDialog.Options := ReplaceDialog.Options - [frHideWholeWord]; end; end; procedure TMainForm.UpdateMemosTabSetVisibility; begin MemosTabSet.Visible := FPreprocessorOutputMemo.Used or FFileMemos[FirstIncludedFilesMemoIndex].Used; if not MemosTabSet.Visible then MemosTabSet.TabIndex := 0; { For next time } end; procedure TMainForm.UpdateModifiedPanel; begin if FActiveMemo.Modified then StatusBar.Panels[spModified].Text := 'Modified' else StatusBar.Panels[spModified].Text := ''; end; procedure TMainForm.UpdatePreprocMemos; procedure UpdatePreprocessorOutputMemo(const NewTabs, NewHints: TStringList; const NewCloseButtons: TBoolList); begin if FOptions.ShowPreprocessorOutput and (FPreprocessorOutput <> '') and (FMainMemo.Lines.Text.TrimRight <> FPreprocessorOutput) then begin NewTabs.Add('Preprocessor Output'); NewHints.Add(''); NewCloseButtons.Add(False); FPreprocessorOutputMemo.ReadOnly := False; try FPreprocessorOutputMemo.Lines.Text := FPreprocessorOutput; FPreprocessorOutputMemo.ClearUndo; finally FPreprocessorOutputMemo.ReadOnly := True; end; FPreprocessorOutputMemo.Used := True; end else begin if FPreprocessorOutputMemo.Used then RemoveMemoFromNav(FPreprocessorOutputMemo); FPreprocessorOutputMemo.Used := False; FPreprocessorOutputMemo.Visible := False; end; end; procedure UpdateIncludedFilesMemos(const NewTabs, NewHints: TStringList; const NewCloseButtons: TBoolList); var IncludedFile: TIncludedFile; I: Integer; begin if FOptions.OpenIncludedFiles and (FIncludedFiles.Count > 0) then begin var NextMemoIndex := FirstIncludedFilesMemoIndex; var NextTabIndex := 1; { First tab displays the main memo } for IncludedFile in FIncludedFiles do begin IncludedFile.Memo := FFileMemos[NextMemoIndex]; try if not IncludedFile.Memo.Used or ((PathCompare(IncludedFile.Memo.Filename, IncludedFile.Filename) <> 0) or not IncludedFile.HasLastWriteTime or (CompareFileTime(IncludedFile.Memo.FileLastWriteTime, IncludedFile.LastWriteTime) <> 0)) then begin IncludedFile.Memo.Filename := IncludedFile.Filename; IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex; OpenFile(IncludedFile.Memo, IncludedFile.Filename, False); { Also updates FileLastWriteTime } IncludedFile.Memo.Used := True; end else begin { The memo assigned to the included file already has that file loaded and is up-to-date so no call to OpenFile is needed. However, it could be that CompilerFileIndex is not set yet. This happens if the initial load was from the history loaded by LoadKnownIncludedAndHiddenFiles and is followed by the user doing a compile. } if IncludedFile.Memo.CompilerFileIndex = UnknownCompilerFileIndex then IncludedFile.Memo.CompilerFileIndex := IncludedFile.CompilerFileIndex; end; if FHiddenFiles.IndexOf(IncludedFile.Filename) = -1 then begin NewTabs.Insert(NextTabIndex, GetDisplayFilename(IncludedFile.Filename)); NewHints.Insert(NextTabIndex, GetFileTitle(IncludedFile.Filename)); NewCloseButtons.Insert(NextTabIndex, True); Inc(NextTabIndex); end; Inc(NextMemoIndex); if NextMemoIndex = FFileMemos.Count then Break; { We're out of memos :( } except on E: Exception do begin StatusMessage(smkWarning, 'Failed to open included file: ' + E.Message); IncludedFile.Memo := nil; end; end; end; { Hide any remaining memos } for I := NextMemoIndex to FFileMemos.Count-1 do begin FFileMemos[I].BreakPoints.Clear; if FFileMemos[I].Used then RemoveMemoFromNav(FFileMemos[I]); FFileMemos[I].Used := False; FFileMemos[I].Visible := False; end; end else begin for I := FirstIncludedFilesMemoIndex to FFileMemos.Count-1 do begin FFileMemos[I].BreakPoints.Clear; if FFileMemos[I].Used then RemoveMemoFromNav(FFileMemos[I]); FFileMemos[I].Used := False; FFileMemos[I].Visible := False; end; for IncludedFile in FIncludedFiles do IncludedFile.Memo := nil; end; end; var NewTabs, NewHints: TStringList; NewCloseButtons: TBoolList; I, SaveTabIndex: Integer; SaveTabName: String; begin NewTabs := nil; NewHints := nil; NewCloseButtons := nil; try NewTabs := TStringList.Create; NewTabs.Add(MemosTabSet.Tabs[0]); { 'Main Script' } NewHints := TStringList.Create; NewHints.Add(GetFileTitle(FMainMemo.Filename)); NewCloseButtons := TBoolList.Create; NewCloseButtons.Add(False); UpdatePreprocessorOutputMemo(NewTabs, NewHints, NewCloseButtons); UpdateIncludedFilesMemos(NewTabs, NewHints, NewCloseButtons); { Set new tabs, try keep same file open } SaveTabIndex := MemosTabSet.TabIndex; SaveTabName := MemosTabSet.Tabs[MemosTabSet.TabIndex]; MemosTabSet.Tabs := NewTabs; MemosTabSet.Hints := NewHints; MemosTabSet.CloseButtons := NewCloseButtons; I := MemosTabSet.Tabs.IndexOf(SaveTabName); if I <> -1 then MemosTabSet.TabIndex := I; if MemosTabSet.TabIndex = SaveTabIndex then begin { If TabIndex stayed the same then the tabset won't perform a Click but we need this to make sure the right memo is visible - so trigger it ourselves } MemosTabSetClick(MemosTabSet); end; finally NewCloseButtons.Free; NewHints.Free; NewTabs.Free; end; UpdateMemosTabSetVisibility; UpdateBevel1Visibility; end; procedure TMainForm.MemoUpdateUI(Sender: TObject; Updated: TScintEditUpdates); procedure UpdatePendingSquiggly(const AMemo: TIDEScintEdit); var Pos: Integer; Value: Boolean; begin { Check for the inPendingSquiggly indicator on either side of the caret } Pos := AMemo.CaretPosition; Value := False; if AMemo.CaretVirtualSpace = 0 then begin Value := AMemo.GetIndicatorAtPosition(minPendingSquiggly, Pos); if not Value and (Pos > 0) then Value := AMemo.GetIndicatorAtPosition(minPendingSquiggly, Pos-1); end; if FOnPendingSquiggly <> Value then begin FOnPendingSquiggly := Value; { If caret has left a pending squiggly, force restyle of the line } if not Value then begin { Stop reporting the caret position to the styler (until the next Change event) so the token doesn't re-enter pending-squiggly state if the caret comes back and something restyles the line } AMemo.ReportCaretPositionToStyler := False; AMemo.RestyleLine(AMemo.GetLineFromPosition(FPendingSquigglyCaretPos)); end; end; FPendingSquigglyCaretPos := Pos; end; procedure UpdateBraceHighlighting(const AMemo: TIDEScintEdit); const OpeningBraces: TSysCharSet = ['(', '[', '{', '<']; ClosingBraces: TSysCharSet = [')', ']', '}', '>']; function HighlightPos(const AMemo: TIDEScintEdit; const CaretPos: Integer; const Before: Boolean; const Braces: TSysCharSet): Boolean; begin var Pos := CaretPos; if Before then begin if Pos > 0 then Pos := AMemo.GetPositionBefore(Pos) else Exit(False); end; var C := AMemo.GetByteAtPosition(Pos); Result := C in Braces; if Result then begin var MatchPos := AMemo.GetPositionOfMatchingBrace(Pos); if MatchPos >= 0 then AMemo.SetBraceHighlighting(Pos, MatchPos) else begin { Found an unmatched brace: highlight it as bad unless it's an opening brace and the caret is at the end of the line } var CaretLineEndPos := AMemo.GetLineEndPosition(AMemo.CaretLine); if (C in ClosingBraces) or (CaretPos <> CaretLineEndPos) then AMemo.SetBraceBadHighlighting(Pos) else AMemo.SetBraceHighlighting(-1, -1); end; end; end; begin var Highlighted := False; var Section := FMemosStyler.GetSectionFromLineState(AMemo.Lines.State[AMemo.CaretLine]); if (Section <> scNone) and (AMemo.CaretVirtualSpace = 0) then begin var Pos := AMemo.CaretPosition; Highlighted := Highlighted or HighlightPos(AMemo, Pos, False, OpeningBraces); Highlighted := Highlighted or HighlightPos(AMemo, Pos, False, ClosingBraces); Highlighted := Highlighted or HighlightPos(AMemo, Pos, True, ClosingBraces); Highlighted := Highlighted or HighlightPos(AMemo, Pos, True, OpeningBraces); end; if not Highlighted then AMemo.SetBraceHighlighting(-1, -1); end; begin if Updated * [suContent, suSelection] = [] then Exit; var Memo := Sender as TIDEScintEdit; if (Memo = FErrorMemo) and ((FErrorMemo.ErrorLine < 0) or (FErrorMemo.CaretPosition <> FErrorMemo.ErrorCaretPosition)) then HideError; if Memo = FActiveMemo then begin UpdateCaretPosPanelAndBackNavStack; UpdateEditModePanel; end; UpdatePendingSquiggly(Memo); UpdateBraceHighlighting(Memo); UpdateOccurrenceIndicators(Memo); end; procedure TMainForm.MemoModifiedChange(Sender: TObject); begin if Sender = FActiveMemo then UpdateModifiedPanel; end; procedure TMainForm.MemoCallTipArrowClick(Sender: TObject; const Up: Boolean); begin { Based on SciTE 5.50's SciTEBase::Notify SA::Notification::CallTipClick } if Up and (FCallTipState.CurrentCallTip > 0) then begin Dec(FCallTipState.CurrentCallTip); UpdateCallTipFunctionDefinition; end else if not Up and (FCallTipState.CurrentCallTip + 1 < FCallTipState.MaxCallTips) then begin Inc(FCallTipState.CurrentCallTip); UpdateCallTipFunctionDefinition; end; end; procedure TMainForm.MemoChange(Sender: TObject; const Info: TScintEditChangeInfo); procedure MemoLinesInsertedOrDeleted(Memo: TIDEScintFileEdit); var FirstAffectedLine, Line, LinePos: Integer; begin Line := Memo.GetLineFromPosition(Info.StartPos); LinePos := Memo.GetPositionFromLine(Line); FirstAffectedLine := Line; { If the deletion/insertion does not start on the first character of Line, then we consider the first deleted/inserted line to be the following line (Line+1). This way, if you press Del at the end of line 1, the dot on line 2 is removed, while line 1's dot stays intact. } if Info.StartPos > LinePos then Inc(Line); if Info.LinesDelta > 0 then MemoLinesInserted(Memo, Line, Info.LinesDelta) else MemoLinesDeleted(Memo, Line, -Info.LinesDelta, FirstAffectedLine); end; var Memo: TIDEScintFileEdit; begin if not (Sender is TIDEScintFileEdit) then Exit; Memo := TIDEScintFileEdit(Sender); if Memo.OpeningFile then Exit; FModifiedAnySinceLastCompile := True; if FDebugging then FModifiedAnySinceLastCompileAndGo := True else begin { Modified while not debugging or opening a file; free the debug info and clear the dots } DestroyDebugInfo; end; if Info.LinesDelta <> 0 then MemoLinesInsertedOrDeleted(Memo); if Memo = FErrorMemo then begin { When the Delete key is pressed, the caret doesn't move, so reset FErrorCaretPosition to ensure that OnUpdateUI calls HideError } FErrorMemo.ErrorCaretPosition := -1; end; { The change should trigger restyling. Allow the styler to see the current caret position in case it wants to set a pending squiggly indicator. } Memo.ReportCaretPositionToStyler := True; end; function TMainForm.InitiateAutoCompleteOrCallTipAllowedAtPos(const AMemo: TIDEScintEdit; const WordStartLinePos, PositionBeforeWordStartPos: Integer): Boolean; begin Result := (PositionBeforeWordStartPos < WordStartLinePos) or not FMemosStyler.IsCommentOrPascalStringStyle(AMemo.GetStyleAtPosition(PositionBeforeWordStartPos)); end; procedure TMainForm.InitiateAutoComplete(const Key: AnsiChar); function OnlyWhiteSpaceBeforeWord(const Memo: TIDEScintEdit; const LinePos, WordStartPos: Integer): Boolean; var I: Integer; C: AnsiChar; begin { Only allow autocompletion if no non-whitespace characters exist before the current word on the line } I := WordStartPos; Result := False; while I > LinePos do begin I := FActiveMemo.GetPositionBefore(I); if I < LinePos then Exit; { shouldn't get here } C := FActiveMemo.GetByteAtPosition(I); if C > ' ' then Exit; end; Result := True; end; var CaretPos, Line, LinePos, WordStartPos, WordEndPos, CharsBefore, LangNamePos: Integer; Section: TInnoSetupStylerSection; IsParamSection: Boolean; WordList: AnsiString; FoundSemicolon, FoundFlagsOrType, FoundDot: Boolean; C: AnsiChar; begin if FActiveMemo.AutoCompleteActive or FActiveMemo.ReadOnly then Exit; if Key = #0 then begin { If a character is typed then Scintilla will handle selections but otherwise we should empty them and also make sure the caret is visible before we start autocompletion } FActiveMemo.SetEmptySelections; FActiveMemo.ScrollCaretIntoView; end; CaretPos := FActiveMemo.CaretPosition; Line := FActiveMemo.GetLineFromPosition(CaretPos); LinePos := FActiveMemo.GetPositionFromLine(Line); WordStartPos := FActiveMemo.GetWordStartPosition(CaretPos, True); WordEndPos := FActiveMemo.GetWordEndPosition(CaretPos, True); CharsBefore := CaretPos - WordStartPos; { Don't auto start autocompletion after a character is typed if there are any word characters adjacent to the character } if Key <> #0 then begin if CharsBefore > 1 then Exit; if WordEndPos > CaretPos then Exit; end; case FActiveMemo.GetByteAtPosition(WordStartPos) of '#': begin if not OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, WordStartPos) then Exit; WordList := FMemosStyler.ISPPDirectivesWordList; FActiveMemo.SetAutoCompleteFillupChars(' '); end; '{': begin WordList := FMemosStyler.ConstantsWordList; FActiveMemo.SetAutoCompleteFillupChars('\:'); end; '[': begin if not OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, WordStartPos) then Exit; WordList := FMemosStyler.SectionsWordList; FActiveMemo.SetAutoCompleteFillupChars(''); end; else begin Section := FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[Line]); if Section = scCode then begin { Space can only initiate autocompletion after non whitespace } if (Key = ' ') and OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, WordStartPos) then Exit; var PositionBeforeWordStartPos := FActiveMemo.GetPositionBefore(WordStartPos); if Key <> #0 then begin FActiveMemo.StyleNeeded(PositionBeforeWordStartPos); { Make sure the typed character has been styled } if not InitiateAutoCompleteOrCallTipAllowedAtPos(FActiveMemo, LinePos, PositionBeforeWordStartPos) then Exit; end; WordList := ''; { Autocomplete event functions if the current word on the line has exactly 1 space before it which has the word 'function' or 'procedure' before it which has only whitespace before it } if (PositionBeforeWordStartPos >= LinePos) and (FActiveMemo.GetByteAtPosition(PositionBeforeWordStartPos) <= ' ') then begin var FunctionWordEndPos := PositionBeforeWordStartPos; var FunctionWordStartPos := FActiveMemo.GetWordStartPosition(FunctionWordEndPos, True); if OnlyWhiteSpaceBeforeWord(FActiveMemo, LinePos, FunctionWordStartPos) then begin var FunctionWord := FActiveMemo.GetTextRange(FunctionWordStartPos, FunctionWordEndPos); if SameText(FunctionWord, 'procedure') then WordList := FMemosStyler.EventFunctionsWordList[True] else if SameText(FunctionWord, 'function') then WordList := FMemosStyler.EventFunctionsWordList[False]; if WordList <> '' then FActiveMemo.SetAutoCompleteFillupChars(''); end; end; { If no event function was found then autocomplete script functions, types, etc if the current word has no dot before it } if WordList = '' then begin var ClassOrRecordMember := (PositionBeforeWordStartPos >= LinePos) and (FActiveMemo.GetByteAtPosition(PositionBeforeWordStartPos) = '.'); WordList := FMemosStyler.ScriptWordList[ClassOrRecordMember]; FActiveMemo.SetAutoCompleteFillupChars(''); end; if WordList = '' then Exit; end else begin IsParamSection := FMemosStyler.IsParamSection(Section); { Autocomplete if the current word on the line has only whitespace before it, or else also: after the last ';' or after 'Flags:' or 'Type:' in parameterized sections } FoundSemicolon := False; FoundFlagsOrType := False; FoundDot := False; var I := WordStartPos; while I > LinePos do begin I := FActiveMemo.GetPositionBefore(I); if I < LinePos then Exit; { shouldn't get here } C := FActiveMemo.GetByteAtPosition(I); if IsParamSection and (C in [';', ':']) and FMemosStyler.IsSymbolStyle(FActiveMemo.GetStyleAtPosition(I)) then begin { Make sure it's an stSymbol ';' or ':' and not one inside a quoted string } FoundSemicolon := C = ';'; if not FoundSemicolon then begin var ParameterWordEndPos := I; var ParameterWordStartPos := FActiveMemo.GetWordStartPosition(ParameterWordEndPos, True); var ParameterWord := FActiveMemo.GetTextRange(ParameterWordStartPos, ParameterWordEndPos); FoundFlagsOrType := SameText(ParameterWord, 'Flags') or ((Section in [scInstallDelete, scUninstallDelete]) and SameText(ParameterWord, 'Type')); end else FoundFlagsOrType := False; if FoundSemicolon or FoundFlagsOrType then Break; end; if (Section = scLangOptions) and (C = '.') and not FoundDot then begin { Verify that a word (language name) precedes the '.', then check for any non-whitespace characters before the word } LangNamePos := FActiveMemo.GetWordStartPosition(I, True); if LangNamePos >= I then Exit; I := LangNamePos; FoundDot := True; end else if C > ' ' then begin if IsParamSection and not (Section in [scInstallDelete, scUninstallDelete]) and (FMemosStyler.FlagsWordList[Section] <> '') then begin { Verify word before the current word (or before that when we get here again) is a valid flag and if so, continue looking before it instead of stopping } var FlagEndPos := FActiveMemo.GetWordEndPosition(I, True); var FlagStartPos := FActiveMemo.GetWordStartPosition(I, True); var FlagWord := FActiveMemo.GetTextRange(FlagStartPos, FlagEndPos); if FMemosStyler.SectionHasFlag(Section, FlagWord) then I := FlagStartPos else Exit; end else Exit; end; end; { Space can only initiate autocompletion after ';' or 'Flags:' or 'Type:' in parameterized sections } if (Key = ' ') and not (FoundSemicolon or FoundFlagsOrType) then Exit; if FoundFlagsOrType then begin WordList := FMemosStyler.FlagsWordList[Section]; if WordList = '' then Exit; FActiveMemo.SetAutoCompleteFillupChars(' '); end else begin WordList := FMemosStyler.KeywordsWordList[Section]; if WordList = '' then { CustomMessages } Exit; if IsParamSection then FActiveMemo.SetAutoCompleteFillupChars(':') else FActiveMemo.SetAutoCompleteFillupChars('='); end; end; end; end; FActiveMemo.ShowAutoComplete(CharsBefore, WordList); end; procedure TMainForm.UpdateCallTipFunctionDefinition(const Pos: Integer { = -1 }); begin { Based on SciTE 5.50's SciTEBase::FillFunctionDefinition } if Pos > 0 then FCallTipState.LastPosCallTip := Pos; // Should get current api definition var FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(FCallTipState.ClassOrRecordMember, FCallTipState.CurrentCallTipWord, FCallTipState.CurrentCallTip, FCallTipState.MaxCallTips); if ((FCallTipState.MaxCallTips = 1) and FunctionDefinition.HasParams) or //if there's a single definition then only show if it has a parameter (FCallTipState.MaxCallTips > 1) then begin //if there's multiple then show always just like MemoHintShow, so even the one without parameters if it exists FCallTipState.FunctionDefinition := FunctionDefinition.ScriptFuncWithoutHeader; if FCallTipState.MaxCallTips > 1 then FCallTipState.FunctionDefinition := AnsiString(Format(#1'%d of %d'#2'%s', [FCallTipState.CurrentCallTip+1, FCallTipState.MaxCallTips, FCallTipState.FunctionDefinition])); FActiveMemo.ShowCallTip(FCallTipState.LastPosCallTip - Length(FCallTipState.CurrentCallTipWord), FCallTipState.FunctionDefinition); ContinueCallTip; end; end; procedure TMainForm.InitiateCallTip(const Key: AnsiChar); begin var Pos := FActiveMemo.CaretPosition; if (FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[FActiveMemo.GetLineFromPosition(Pos)]) <> scCode) or ((Key <> #0) and not InitiateAutoCompleteOrCallTipAllowedAtPos(FActiveMemo, FActiveMemo.GetPositionFromLine(FActiveMemo.GetLineFromPosition(Pos)), FActiveMemo.GetPositionBefore(Pos))) then Exit; { Based on SciTE 5.50's SciTEBase::StartAutoComplete } FCallTipState.CurrentCallTip := 0; FCallTipState.CurrentCallTipWord := ''; var Line := FActiveMemo.CaretLineText; var Current := FActiveMemo.CaretPositionInLine; var CallTipWordCharacters := FActiveMemo.WordCharsAsSet; {$ZEROBASEDSTRINGS ON} repeat var Braces := 0; while ((Current > 0) and ((Braces <> 0) or not (Line[Current-1] = '('))) do begin if Line[Current-1] = '(' then Dec(Braces) else if Line[Current-1] = ')' then Inc(Braces); Dec(Current); Dec(Pos); end; if Current > 0 then begin Dec(Current); Dec(Pos); end else Break; while (Current > 0) and (Line[Current-1] <= ' ') do begin Dec(Current); Dec(Pos); end until not ((Current > 0) and not CharInSet(Line[Current-1], CallTipWordCharacters)); {$ZEROBASEDSTRINGS OFF} if Current <= 0 then Exit; FCallTipState.StartCallTipWord := Current - 1; {$ZEROBASEDSTRINGS ON} while (FCallTipState.StartCallTipWord > 0) and CharInSet(Line[FCallTipState.StartCallTipWord-1], CallTipWordCharacters) do Dec(FCallTipState.StartCallTipWord); FCallTipState.ClassOrRecordMember := (FCallTipState.StartCallTipWord > 0) and (Line[FCallTipState.StartCallTipWord-1] = '.'); {$ZEROBASEDSTRINGS OFF} SetLength(Line, Current); FCallTipState.CurrentCallTipWord := Line.Substring(FCallTipState.StartCallTipWord); { Substring is zero-based } FCallTipState.FunctionDefinition := ''; UpdateCallTipFunctionDefinition(Pos); end; procedure TMainForm.ContinueCallTip; begin { Based on SciTE 5.50's SciTEBase::ContinueCallTip } var Line := FActiveMemo.CaretLineText; var Current := FActiveMemo.CaretPositionInLine; var Braces := 0; var Commas := 0; for var I := FCallTipState.StartCallTipWord to Current-1 do begin {$ZEROBASEDSTRINGS ON} if CharInSet(Line[I], ['(', '[']) then Inc(Braces) else if CharInSet(Line[I], [')', ']']) and (Braces > 0) then Dec(Braces) else if (Braces = 1) and (Line[I] = ',') then Inc(Commas); {$ZEROBASEDSTRINGS OFF} end; {$ZEROBASEDSTRINGS ON} var StartHighlight := 0; var FunctionDefinition := FCallTipState.FunctionDefinition; var FunctionDefinitionLength := Length(FunctionDefinition); while (StartHighlight < FunctionDefinitionLength) and not (FunctionDefinition[StartHighlight] = '(') do Inc(StartHighlight); if (StartHighlight < FunctionDefinitionLength) and (FunctionDefinition[StartHighlight] = '(') then Inc(StartHighlight); while (StartHighlight < FunctionDefinitionLength) and (Commas > 0) do begin if FunctionDefinition[StartHighlight] in [',', ';'] then Dec(Commas); // If it reached the end of the argument list it means that the user typed in more // arguments than the ones listed in the calltip if FunctionDefinition[StartHighlight] = ')' then Commas := 0 else Inc(StartHighlight); end; if (StartHighlight < FunctionDefinitionLength) and (FunctionDefinition[StartHighlight] in [',', ';']) then Inc(StartHighlight); var EndHighlight := StartHighlight; while (EndHighlight < FunctionDefinitionLength) and not (FunctionDefinition[EndHighlight] in [',', ';']) and not (FunctionDefinition[EndHighlight] = ')') do Inc(EndHighlight); {$ZEROBASEDSTRINGS OFF} FActiveMemo.SetCallTipHighlight(StartHighlight, EndHighlight); end; procedure TMainForm.MemoCharAdded(Sender: TObject; Ch: AnsiChar); function LineIsBlank(const Line: Integer): Boolean; begin var S := FActiveMemo.Lines.RawLines[Line]; Result := TScintEdit.RawStringIsBlank(S); end; var NewLine, PreviousLine, NewIndent, PreviousIndent: Integer; begin if FOptions.AutoIndent and (Ch = FActiveMemo.LineEndingString[Length(FActiveMemo.LineEndingString)]) then begin { Add to the new line any (remaining) indentation from the previous line } NewLine := FActiveMemo.CaretLine; PreviousLine := NewLine-1; if PreviousLine >= 0 then begin NewIndent := FActiveMemo.GetLineIndentation(NewLine); { If no indentation was moved from the previous line to the new line (i.e., there are no spaces/tabs directly to the right of the new caret position), and the previous line is completely empty (0 length), then use the indentation from the last line containing non-space characters. } if (NewIndent = 0) and (FActiveMemo.Lines.RawLineLengths[PreviousLine] = 0) then begin Dec(PreviousLine); while (PreviousLine >= 0) and LineIsBlank(PreviousLine) do Dec(PreviousLine); end; if PreviousLine >= 0 then begin PreviousIndent := FActiveMemo.GetLineIndentation(PreviousLine); FActiveMemo.SetLineIndentation(NewLine, NewIndent + PreviousIndent); FActiveMemo.CaretPosition := FActiveMemo.GetPositionFromLineExpandedColumn(NewLine, PreviousIndent); end; end; end; { Based on SciTE 5.50's SciTEBase::CharAdded but with an altered interaction between calltips and autocomplete } var DoAutoComplete := False; if FActiveMemo.CallTipActive then begin if Ch = ')' then begin Dec(FCallTipState.BraceCount); if FCallTipState.BraceCount < 1 then FActiveMemo.CancelCallTip else if FOptions.AutoCallTips then InitiateCallTip(Ch); end else if Ch = '(' then begin Inc(FCallTipState.BraceCount); if FOptions.AutoCallTips then InitiateCallTip(Ch); end else ContinueCallTip; end else if FActiveMemo.AutoCompleteActive then begin if Ch = '(' then begin Inc(FCallTipState.BraceCount); if FOptions.AutoCallTips then begin InitiateCallTip(Ch); if not FActiveMemo.CallTipActive then begin { Normally the calltip activation means any active autocompletion gets cancelled by Scintilla but if the current word has no call tip then we should make sure ourselves that the added brace still cancels the currently active autocompletion } DoAutoComplete := True; end; end; end else if Ch = ')' then Dec(FCallTipState.BraceCount) else DoAutoComplete := True; end else if Ch = '(' then begin FCallTipState.BraceCount := 1; if FOptions.AutoCallTips then InitiateCallTip(Ch); end else DoAutoComplete := True; if DoAutoComplete then begin case Ch of 'A'..'Z', 'a'..'z', '_', '#', '{', '[', '<', '0'..'9': if not FActiveMemo.AutoCompleteActive and FOptions.AutoAutoComplete and not (Ch in ['0'..'9']) then InitiateAutoComplete(Ch); else var RestartAutoComplete := (Ch in [' ', '.']) and (FOptions.AutoAutoComplete or FActiveMemo.AutoCompleteActive); FActiveMemo.CancelAutoComplete; if RestartAutoComplete then InitiateAutoComplete(Ch); end; end; end; procedure TMainForm.MemoHintShow(Sender: TObject; var Info: TScintHintInfo); function GetCodeVariableDebugEntryFromFileLineCol(FileIndex, Line, Col: Integer; out DebugEntry: PVariableDebugEntry): Boolean; var I: Integer; begin { FVariableDebugEntries uses 1-based line and column numbers } Inc(Line); Inc(Col); Result := False; for I := 0 to FVariableDebugEntriesCount-1 do begin if (FVariableDebugEntries[I].FileIndex = FileIndex) and (FVariableDebugEntries[I].LineNumber = Line) and (FVariableDebugEntries[I].Col = Col) then begin DebugEntry := @FVariableDebugEntries[I]; Result := True; Break; end; end; end; function GetCodeColumnFromPosition(const Pos: Integer): Integer; var LinePos: Integer; S: TScintRawString; U: String; begin { [Code] lines get converted from the editor's UTF-8 to UTF-16 Strings when passed to the compiler. This can lead to column number discrepancies between Scintilla and ROPS. This code simulates the conversion to try to find out where ROPS thinks a Pos resides. } LinePos := FActiveMemo.GetPositionFromLine(FActiveMemo.GetLineFromPosition(Pos)); S := FActiveMemo.GetRawTextRange(LinePos, Pos); U := FActiveMemo.ConvertRawStringToString(S); Result := Length(U); end; function FindVarOrFuncRange(const Pos: Integer): TScintRange; begin { Note: The GetPositionAfter is needed so that when the mouse is over a '.' between two words, it won't match the word to the left of the '.' } FActiveMemo.SetDefaultWordChars; Result.StartPos := FActiveMemo.GetWordStartPosition(FActiveMemo.GetPositionAfter(Pos), True); Result.EndPos := FActiveMemo.GetWordEndPosition(Pos, True); end; function FindConstRange(const Pos: Integer): TScintRange; var BraceLevel, ConstStartPos, Line, LineEndPos, I: Integer; C: AnsiChar; begin Result.StartPos := 0; Result.EndPos := 0; BraceLevel := 0; ConstStartPos := -1; Line := FActiveMemo.GetLineFromPosition(Pos); LineEndPos := FActiveMemo.GetLineEndPosition(Line); I := FActiveMemo.GetPositionFromLine(Line); while I < LineEndPos do begin if (I > Pos) and (BraceLevel = 0) then Break; C := FActiveMemo.GetByteAtPosition(I); if C = '{' then begin if FActiveMemo.GetByteAtPosition(I + 1) = '{' then Inc(I) else begin if BraceLevel = 0 then ConstStartPos := I; Inc(BraceLevel); end; end else if (C = '}') and (BraceLevel > 0) then begin Dec(BraceLevel); if (BraceLevel = 0) and (ConstStartPos <> -1) then begin if (Pos >= ConstStartPos) and (Pos <= I) then begin Result.StartPos := ConstStartPos; Result.EndPos := I + 1; Exit; end; ConstStartPos := -1; end; end; I := FActiveMemo.GetPositionAfter(I); end; end; procedure UpdateInfo(var Info: TScintHintInfo; const HintStr: String; const Range: TScintRange; const Memo: TIDEScintEdit); begin Info.HintStr := HintStr; Info.CursorRect.TopLeft := Memo.GetPointFromPosition(Range.StartPos); Info.CursorRect.BottomRight := Memo.GetPointFromPosition(Range.EndPos); Info.CursorRect.Bottom := Info.CursorRect.Top + Memo.LineHeight; Info.HideTimeout := High(Integer); { infinite } end; begin var Pos := FActiveMemo.GetPositionFromPoint(Info.CursorPos, True, True); if Pos < 0 then Exit; var Line := FActiveMemo.GetLineFromPosition(Pos); { Check if cursor is over a [Code] variable or function } if FMemosStyler.GetSectionFromLineState(FActiveMemo.Lines.State[Line]) = scCode then begin var VarOrFuncRange := FindVarOrFuncRange(Pos); if VarOrFuncRange.EndPos > VarOrFuncRange.StartPos then begin var HintStr := ''; var DebugEntry: PVariableDebugEntry; if (FActiveMemo is TIDEScintFileEdit) and (FDebugClientWnd <> 0) and GetCodeVariableDebugEntryFromFileLineCol((FActiveMemo as TIDEScintFileEdit).CompilerFileIndex, Line, GetCodeColumnFromPosition(VarOrFuncRange.StartPos), DebugEntry) then begin var Output: String; case EvaluateVariableEntry(DebugEntry, Output) of 1: HintStr := Output; 2: HintStr := Output; else HintStr := 'Unknown error'; end; end else begin var ClassMember := False; var Name := FActiveMemo.GetTextRange(VarOrFuncRange.StartPos, VarOrFuncRange.EndPos); var Index := 0; var Count: Integer; var FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index, Count); if Count = 0 then begin ClassMember := not ClassMember; FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index, Count); end; while Index < Count do begin if Index <> 0 then FunctionDefinition := FMemosStyler.GetScriptFunctionDefinition(ClassMember, Name, Index); if HintStr <> '' then HintStr := HintStr + #13; if FunctionDefinition.WasFunction then HintStr := HintStr + 'function ' else HintStr := HintStr + 'procedure '; HintStr := HintStr + String(FunctionDefinition.ScriptFuncWithoutHeader); Inc(Index); end; end; if HintStr <> '' then begin UpdateInfo(Info, HintStr, VarOrFuncRange, FActiveMemo); Exit; end; end; end; if FDebugClientWnd <> 0 then begin { Check if cursor is over a constant } var ConstRange := FindConstRange(Pos); if ConstRange.EndPos > ConstRange.StartPos then begin var HintStr := FActiveMemo.GetTextRange(ConstRange.StartPos, ConstRange.EndPos); var Output: String; case EvaluateConstant(Info.HintStr, Output) of 1: HintStr := HintStr + ' = "' + Output + '"'; 2: HintStr := HintStr + ' = Exception: ' + Output; else HintStr := HintStr + ' = Unknown error'; end; UpdateInfo(Info, HintStr, ConstRange, FActiveMemo); end; end; end; procedure TMainForm.MainMemoDropFiles(Sender: TObject; X, Y: Integer; AFiles: TStrings); begin if (AFiles.Count > 0) and ConfirmCloseFile(True) then OpenFile(FMainMemo, AFiles[0], True); end; procedure TMainForm.MemoZoom(Sender: TObject); begin if not FSynchingZoom then begin FSynchingZoom := True; try for var Memo in FMemos do if Memo <> Sender then Memo.Zoom := (Sender as TScintEdit).Zoom; finally FSynchingZoom := False; end; end; end; procedure TMainForm.StatusBarResize(Sender: TObject); begin { Without this, on Windows XP with themes, the status bar's size grip gets corrupted as the form is resized } if StatusBar.HandleAllocated then InvalidateRect(StatusBar.Handle, nil, True); end; procedure TMainForm.WMDebuggerQueryVersion(var Message: TMessage); begin Message.Result := FCompilerVersion.BinVersion; end; procedure TMainForm.WMDebuggerHello(var Message: TMessage); var PID: DWORD; WantCodeText: Boolean; begin FDebugClientWnd := HWND(Message.WParam); { Save debug client process handle } if FDebugClientProcessHandle <> 0 then begin { Shouldn't get here, but just in case, don't leak a handle } CloseHandle(FDebugClientProcessHandle); FDebugClientProcessHandle := 0; end; PID := 0; if GetWindowThreadProcessId(FDebugClientWnd, @PID) <> 0 then FDebugClientProcessHandle := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, PID); WantCodeText := Bool(Message.LParam); if WantCodeText then SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeTextA, FCompiledCodeText); SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeDebugInfoA, FCompiledCodeDebugInfo); UpdateRunMenu; end; procedure TMainForm.WMDebuggerGoodbye(var Message: TMessage); begin ReplyMessage(0); DebuggingStopped(True); end; procedure TMainForm.GetMemoAndDebugEntryFromMessage(Kind, Index: Integer; var Memo: TIDEScintFileEdit; var DebugEntry: PDebugEntry); function GetMemoFromDebugEntryFileIndex(const FileIndex: Integer): TIDEScintFileEdit; var Memo: TIDEScintFileEdit; begin Result := nil; if FOptions.OpenIncludedFiles then begin for Memo in FFileMemos do begin if Memo.Used and (Memo.CompilerFileIndex = FileIndex) then begin Result := Memo; Exit; end; end; end else if FMainMemo.CompilerFileIndex = FileIndex then Result := FMainMemo; end; var I: Integer; begin for I := 0 to FDebugEntriesCount-1 do begin if (FDebugEntries[I].Kind = Kind) and (FDebugEntries[I].Index = Index) then begin Memo := GetMemoFromDebugEntryFileIndex(FDebugEntries[I].FileIndex); DebugEntry := @FDebugEntries[I]; Exit; end; end; Memo := nil; DebugEntry := nil; end; procedure TMainForm.BringToForeground; { Brings our top window to the foreground. Called when pausing while debugging. } var TopWindow: HWND; begin TopWindow := GetThreadTopWindow; if TopWindow <> 0 then begin { First ask the debug client to call SetForegroundWindow() on our window. If we don't do this then Windows (98/2000+) will prevent our window from becoming activated if the debug client is currently in the foreground. } SendMessage(FDebugClientWnd, WM_DebugClient_SetForegroundWindow, WPARAM(TopWindow), 0); { Now call SetForegroundWindow() ourself. Why? When a remote thread calls SetForegroundWindow(), the request is queued; the window doesn't actually become active until the next time the window's thread checks the message queue. This call causes the window to become active immediately. } SetForegroundWindow(TopWindow); end; end; procedure TMainForm.DebuggerStepped(var Message: TMessage; const Intermediate: Boolean); var Memo: TIDEScintFileEdit; DebugEntry: PDebugEntry; LineNumber: Integer; begin GetMemoAndDebugEntryFromMessage(Message.WParam, Message.LParam, Memo, DebugEntry); if (Memo = nil) or (DebugEntry = nil) then Exit; LineNumber := DebugEntry.LineNumber; if LineNumber < 0 then { UninstExe has a DebugEntry but not a line number } Exit; if (LineNumber < Memo.LineStateCount) and (Memo.LineState[LineNumber] <> lnEntryProcessed) then begin Memo.LineState[LineNumber] := lnEntryProcessed; UpdateLineMarkers(Memo, LineNumber); end; if (FStepMode = smStepOut) and DebugEntry.StepOutMarker then FStepMode := smStepInto { Pause on next line } else if (FStepMode = smStepInto) or ((FStepMode = smStepOver) and not Intermediate) or ((FStepMode = smRunToCursor) and (FRunToCursorPoint.Kind = Integer(Message.WParam)) and (FRunToCursorPoint.Index = Message.LParam)) or (Memo.BreakPoints.IndexOf(LineNumber) <> -1) then begin MoveCaretAndActivateMemo(Memo, LineNumber, True); HideError; SetStepLine(Memo, LineNumber); BringToForeground; { Tell Setup to pause } Message.Result := 1; FPaused := True; FPausedAtCodeLine := DebugEntry.Kind = Ord(deCodeLine); UpdateRunMenu; UpdateCaption; end; end; procedure TMainForm.WMDebuggerStepped(var Message: TMessage); begin DebuggerStepped(Message, False); end; procedure TMainForm.WMDebuggerSteppedIntermediate(var Message: TMessage); begin DebuggerStepped(Message, True); end; procedure TMainForm.WMDPIChanged(var Message: TMessage); begin inherited; for var Memo in FMemos do Memo.DPIChanged(Message); end; procedure TMainForm.WMDebuggerException(var Message: TMessage); var Memo: TIDEScintFileEdit; DebugEntry: PDebugEntry; LineNumber: Integer; S: String; begin if FOptions.PauseOnDebuggerExceptions then begin GetMemoAndDebugEntryFromMessage(Message.WParam, Message.LParam, Memo, DebugEntry); if DebugEntry <> nil then LineNumber := DebugEntry.LineNumber else LineNumber := -1; if (Memo <> nil) and (LineNumber >= 0) then begin MoveCaretAndActivateMemo(Memo, LineNumber, True); SetStepLine(Memo, -1); SetErrorLine(Memo, LineNumber); end; BringToForeground; { Tell Setup to pause } Message.Result := 1; FPaused := True; FPausedAtCodeLine := (DebugEntry <> nil) and (DebugEntry.Kind = Ord(deCodeLine)); UpdateRunMenu; UpdateCaption; ReplyMessage(Message.Result); { so that Setup enters a paused state now } if LineNumber >= 0 then begin S := Format('Line %d:' + SNewLine + '%s', [LineNumber + 1, AddPeriod(FDebuggerException)]); if (Memo <> nil) and (Memo.Filename <> '') then S := Memo.Filename + SNewLine2 + S; MsgBox(S, 'Runtime Error', mbCriticalError, mb_Ok) end else MsgBox(AddPeriod(FDebuggerException), 'Runtime Error', mbCriticalError, mb_Ok); end; end; procedure TMainForm.WMDebuggerSetForegroundWindow(var Message: TMessage); begin SetForegroundWindow(HWND(Message.WParam)); end; procedure TMainForm.WMDebuggerCallStackCount(var Message: TMessage); begin FCallStackCount := Message.WParam; end; procedure TMainForm.WMCopyData(var Message: TWMCopyData); var S: String; begin case Message.CopyDataStruct.dwData of CD_Debugger_ReplyW: begin FReplyString := ''; SetString(FReplyString, PChar(Message.CopyDataStruct.lpData), Message.CopyDataStruct.cbData div SizeOf(Char)); Message.Result := 1; end; CD_Debugger_ExceptionW: begin SetString(FDebuggerException, PChar(Message.CopyDataStruct.lpData), Message.CopyDataStruct.cbData div SizeOf(Char)); Message.Result := 1; end; CD_Debugger_UninstExeW: begin SetString(FUninstExe, PChar(Message.CopyDataStruct.lpData), Message.CopyDataStruct.cbData div sizeOf(Char)); Message.Result := 1; end; CD_Debugger_LogMessageW: begin SetString(S, PChar(Message.CopyDataStruct.lpData), Message.CopyDataStruct.cbData div SizeOf(Char)); DebugLogMessage(S); Message.Result := 1; end; CD_Debugger_TempDirW: begin { Paranoia: Store it in a local variable first. That way, if there's a problem reading the string FTempDir will be left unmodified. Gotta be extra careful when storing a path we'll be deleting. } SetString(S, PChar(Message.CopyDataStruct.lpData), Message.CopyDataStruct.cbData div SizeOf(Char)); { Extreme paranoia: If there are any embedded nulls, discard it. } if Pos(#0, S) <> 0 then S := ''; FTempDir := S; Message.Result := 1; end; CD_Debugger_CallStackW: begin SetString(S, PChar(Message.CopyDataStruct.lpData), Message.CopyDataStruct.cbData div SizeOf(Char)); DebugShowCallStack(S, FCallStackCount); end; end; end; function TMainForm.DestroyLineState(const AMemo: TIDEScintFileEdit): Boolean; begin if Assigned(AMemo.LineState) then begin AMemo.LineStateCapacity := 0; AMemo.LineStateCount := 0; FreeMem(AMemo.LineState); AMemo.LineState := nil; Result := True; end else Result := False; end; procedure TMainForm.DestroyDebugInfo; var HadDebugInfo: Boolean; Memo: TIDEScintFileEdit; begin HadDebugInfo := False; for Memo in FFileMemos do if DestroyLineState(Memo) then HadDebugInfo := True; FDebugEntriesCount := 0; FreeMem(FDebugEntries); FDebugEntries := nil; FVariableDebugEntriesCount := 0; FreeMem(FVariableDebugEntries); FVariableDebugEntries := nil; FCompiledCodeText := ''; FCompiledCodeDebugInfo := ''; { Clear all dots and reset breakpoint icons (unless exiting; no point) } if HadDebugInfo and not(csDestroying in ComponentState) then UpdateAllMemosLineMarkers; end; var PrevCompilerFileIndex: Integer; PrevMemo: TIDEScintFileEdit; procedure TMainForm.ParseDebugInfo(DebugInfo: Pointer); function GetMemoFromCompilerFileIndex(const CompilerFileIndex: Integer): TIDEScintFileEdit; var Memo: TIDEScintFileEdit; begin if (PrevCompilerFileIndex <> CompilerFileIndex) then begin PrevMemo := nil; for Memo in FFileMemos do begin if Memo.Used and (Memo.CompilerFileIndex = CompilerFileIndex) then begin PrevMemo := Memo; Break; end; end; PrevCompilerFileIndex := CompilerFileIndex; end; Result := PrevMemo; end; { This creates and fills the DebugEntries and Memo LineState arrays } var Header: PDebugInfoHeader; Memo: TIDEScintFileEdit; Size: Cardinal; I: Integer; begin DestroyDebugInfo; Header := DebugInfo; if (Header.ID <> DebugInfoHeaderID) or (Header.Version <> DebugInfoHeaderVersion) then raise Exception.Create('Unrecognized debug info format'); try for Memo in FFileMemos do begin if Memo.Used then begin I := Memo.Lines.Count; Memo.LineState := AllocMem(SizeOf(TLineState) * (I + LineStateGrowAmount)); Memo.LineStateCapacity := I + LineStateGrowAmount; Memo.LineStateCount := I; end; end; Inc(Cardinal(DebugInfo), SizeOf(Header^)); FDebugEntriesCount := Header.DebugEntryCount; Size := FDebugEntriesCount * SizeOf(TDebugEntry); GetMem(FDebugEntries, Size); Move(DebugInfo^, FDebugEntries^, Size); for I := 0 to FDebugEntriesCount-1 do Dec(FDebugEntries[I].LineNumber); Inc(Cardinal(DebugInfo), Size); FVariableDebugEntriesCount := Header.VariableDebugEntryCount; Size := FVariableDebugEntriesCount * SizeOf(TVariableDebugEntry); GetMem(FVariableDebugEntries, Size); Move(DebugInfo^, FVariableDebugEntries^, Size); Inc(Cardinal(DebugInfo), Size); SetString(FCompiledCodeText, PAnsiChar(DebugInfo), Header.CompiledCodeTextLength); Inc(Cardinal(DebugInfo), Header.CompiledCodeTextLength); SetString(FCompiledCodeDebugInfo, PAnsiChar(DebugInfo), Header.CompiledCodeDebugInfoLength); PrevCompilerFileIndex := UnknownCompilerFileIndex; for I := 0 to FDebugEntriesCount-1 do begin if FDebugEntries[I].LineNumber >= 0 then begin Memo := GetMemoFromCompilerFileIndex(FDebugEntries[I].FileIndex); if (Memo <> nil) and (FDebugEntries[I].LineNumber < Memo.LineStateCount) then begin if Memo.LineState[FDebugEntries[I].LineNumber] = lnUnknown then Memo.LineState[FDebugEntries[I].LineNumber] := lnHasEntry; end; end; end; UpdateAllMemosLineMarkers; except DestroyDebugInfo; raise; end; end; procedure TMainForm.ResetAllMemosLineState; { Changes green dots back to grey dots } var Memo: TIDEScintFileEdit; I: Integer; begin for Memo in FFileMemos do begin if Memo.Used and Assigned(Memo.LineState) then begin for I := 0 to Memo.LineStateCount-1 do begin if Memo.LineState[I] = lnEntryProcessed then begin Memo.LineState[I] := lnHasEntry; UpdateLineMarkers(Memo, I); end; end; end; end; end; procedure TMainForm.CheckIfTerminated; var H: THandle; begin if FDebugging then begin { Check if the process hosting the debug client (e.g. Setup or the uninstaller second phase) has terminated. If the debug client hasn't connected yet, check the initial process (e.g. SetupLdr or the uninstaller first phase) instead. } if FDebugClientWnd <> 0 then H := FDebugClientProcessHandle else H := FProcessHandle; if WaitForSingleObject(H, 0) <> WAIT_TIMEOUT then DebuggingStopped(True); end; end; procedure TMainForm.DebuggingStopped(const WaitForTermination: Boolean); function GetExitCodeText: String; var ExitCode: DWORD; begin { Note: When debugging an uninstall, this will get the exit code off of the first phase process, since that's the exit code users will see when running the uninstaller outside the debugger. } case WaitForSingleObject(FProcessHandle, 0) of WAIT_OBJECT_0: begin if GetExitCodeProcess(FProcessHandle, ExitCode) then begin { If the high bit is set, the process was killed uncleanly (e.g. by a debugger). Show the exit code as hex in that case. } if ExitCode and $80000000 <> 0 then Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: 0x%.8x', [ExitCode]) else Result := Format(DebugTargetStrings[FDebugTarget] + ' exit code: %u', [ExitCode]); end else Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (GetExitCodeProcess failed)'; end; WAIT_TIMEOUT: Result := DebugTargetStrings[FDebugTarget] + ' is still running; can''t get exit code'; else Result := 'Unable to get ' + DebugTargetStrings[FDebugTarget] + ' exit code (WaitForSingleObject failed)'; end; end; var ExitCodeText: String; begin if WaitForTermination then begin { Give the initial process time to fully terminate so we can successfully get its exit code } WaitForSingleObject(FProcessHandle, 5000); end; FDebugging := False; FDebugClientWnd := 0; ExitCodeText := GetExitCodeText; if FDebugClientProcessHandle <> 0 then begin CloseHandle(FDebugClientProcessHandle); FDebugClientProcessHandle := 0; end; CloseHandle(FProcessHandle); FProcessHandle := 0; FTempDir := ''; CheckIfRunningTimer.Enabled := False; HideError; SetStepLine(FStepMemo, -1); UpdateRunMenu; UpdateCaption; DebugLogMessage('*** ' + ExitCodeText); StatusBar.Panels[spExtraStatus].Text := ' ' + ExitCodeText; end; procedure TMainForm.DetachDebugger; begin CheckIfTerminated; if not FDebugging then Exit; SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Detach, 0, 0); DebuggingStopped(False); end; function TMainForm.AskToDetachDebugger: Boolean; begin if FDebugClientWnd = 0 then begin MsgBox('Please stop the running ' + DebugTargetStrings[FDebugTarget] + ' process before performing this command.', SCompilerFormCaption, mbError, MB_OK); Result := False; end else if MsgBox('This command will detach the debugger from the running ' + DebugTargetStrings[FDebugTarget] + ' process. Continue?', SCompilerFormCaption, mbError, MB_OKCANCEL) = IDOK then begin DetachDebugger; Result := True; end else Result := False; end; function TMainForm.AnyMemoHasBreakPoint: Boolean; begin { Also see RDeleteBreakPointsClick } for var Memo in FFileMemos do if Memo.Used and (Memo.BreakPoints.Count > 0) then Exit(True); Result := False; end; procedure TMainForm.RMenuClick(Sender: TObject); begin RDeleteBreakPoints.Enabled := AnyMemoHasBreakPoint; { See UpdateRunMenu for other menu items } ApplyMenuBitmaps(RMenu); end; procedure TMainForm.BreakPointsPopupMenuClick(Sender: TObject); begin RToggleBreakPoint2.Enabled := FActiveMemo is TIDEScintFileEdit; RDeleteBreakPoints2.Enabled := AnyMemoHasBreakPoint; { Also see UpdateRunMenu } ApplyMenuBitmaps(Sender as TMenuItem); end; { Should always be called when one of the Enabled states would change because other code depends on the states being correct always even if the user never clicks the Run menu. This is unlike the other menus. Note: also updates BCompile and BStopCompile from the Build menu. } procedure TMainForm.UpdateRunMenu; begin CheckIfTerminated; BCompile.Enabled := not FCompiling and not FDebugging; CompileButton.Enabled := BCompile.Enabled; BStopCompile.Enabled := FCompiling; StopCompileButton.Enabled := BStopCompile.Enabled; RRun.Enabled := not FCompiling and (not FDebugging or FPaused); RunButton.Enabled := RRun.Enabled; RPause.Enabled := FDebugging and not FPaused; PauseButton.Enabled := RPause.Enabled; RRunToCursor.Enabled := RRun.Enabled and (FActiveMemo is TIDEScintFileEdit); RStepInto.Enabled := RRun.Enabled; RStepOver.Enabled := RRun.Enabled; RStepOut.Enabled := FPaused; RToggleBreakPoint.Enabled := FActiveMemo is TIDEScintFileEdit; RTerminate.Enabled := FDebugging and (FDebugClientWnd <> 0); TerminateButton.Enabled := RTerminate.Enabled; REvaluate.Enabled := FDebugging and (FDebugClientWnd <> 0); { See RMenuClick for other menu items and also see BreakPointsPopupMenuClick } end; procedure TMainForm.UpdateSaveMenuItemAndButton; begin FSave.Enabled := FActiveMemo is TIDEScintFileEdit; SaveButton.Enabled := FSave.Enabled; end; procedure TMainForm.UpdateTargetMenu; begin if FDebugTarget = dtSetup then begin RTargetSetup.Checked := True; TargetSetupButton.Down := True; end else begin RTargetUninstall.Checked := True; TargetUninstallButton.Down := True; end; end; procedure TMainForm.UpdateKeyMapping; type TKeyMappedMenu = TPair>; function KMM(const MenuItem: TMenuItem; const DelphiKey: Word; const DelphiShift: TShiftState; const VisualStudioKey: Word; const VisualStudioShift: TShiftState; const ToolButton: TToolButton = nil): TKeyMappedMenu; begin var AShortCut: TShortCut; case FOptions.KeyMappingType of kmtDelphi: AShortCut := ShortCut(DelphiKey, DelphiShift); kmtVisualStudio: AShortCut := ShortCut(VisualStudioKey, VisualStudioShift); else raise Exception.Create('Unknown FOptions.KeyMappingType'); end; Result := TKeyMappedMenu.Create(MenuItem, TPair.Create(AShortcut, ToolButton)); { These are records so no need to free } end; begin var KeyMappedMenus := [ KMM(EFindRegEx, Ord('R'), [ssCtrl, ssAlt], Ord('R'), [ssAlt]), KMM(BCompile, VK_F9, [ssCtrl], Ord('B'), [ssCtrl], CompileButton), { Also FCompileShortCut2 below } KMM(RRun, VK_F9, [], VK_F5, [], RunButton), KMM(RRunToCursor, VK_F4, [], VK_F10, [ssCtrl]), KMM(RStepInto, VK_F7, [], VK_F11, []), KMM(RStepOver, VK_F8, [], VK_F10, []), KMM(RStepOut, VK_F8, [ssShift], VK_F11, [ssShift]), KMM(RToggleBreakPoint, VK_F5, [], VK_F9, []), KMM(RDeleteBreakPoints, VK_F5, [ssShift, ssCtrl], VK_F9, [ssShift, ssCtrl]), KMM(RTerminate, VK_F2, [ssCtrl], VK_F5, [ssShift], TerminateButton), KMM(REvaluate, VK_F7, [ssCtrl], VK_F9, [ssShift])]; FKeyMappedMenus.Clear; for var KeyMappedMenu in KeyMappedMenus do begin var ShortCut := KeyMappedMenu.Value.Key; var ToolButton := KeyMappedMenu.Value.Value; KeyMappedMenu.Key.ShortCut := ShortCut; if ToolButton <> nil then begin var MenuItem := KeyMappedMenu.Key; ToolButton.Hint := Format('%s (%s)', [RemoveAccelChar(MenuItem.Caption), NewShortCutToText(ShortCut)]); end; FKeyMappedMenus.Add(ShortCut, ToolButton); end; { Set fake shortcuts on any duplicates of the above in popup menus } SetFakeShortCut(RToggleBreakPoint2, RToggleBreakPoint.ShortCut); SetFakeShortCut(RDeleteBreakPoints2, RDeleteBreakPoints.ShortCut); { Handle two special cases: -The Nav buttons have no corresponding menu item and also no ShortCut property so they need special handling -Visual Studio and Delphi have separate Compile and Build shortcuts and the Compile shortcut is displayed by the menu and is set above but we want to allow the Build shortcuts as well for our single Build/Compile command } FBackNavButtonShortCut := ShortCut(VK_LEFT, [ssAlt]); FForwardNavButtonShortCut := ShortCut(VK_RIGHT, [ssAlt]); case FOptions.KeyMappingType of kmtDelphi: begin FBackNavButtonShortCut2 := 0; FForwardNavButtonShortCut2 := 0; FCompileShortCut2 := ShortCut(VK_F9, [ssShift]); end; kmtVisualStudio: begin FBackNavButtonShortCut2 := ShortCut(VK_OEM_MINUS, [ssCtrl]); FForwardNavButtonShortCut2 := ShortCut(VK_OEM_MINUS, [ssCtrl, ssShift]); FCompileShortCut2 := ShortCut(VK_F7, []); end; else raise Exception.Create('Unknown FOptions.KeyMappingType'); end; BackNavButton.Hint := Format('Back (%s)', [NewShortCutToText(FBackNavButtonShortCut)]); FKeyMappedMenus.Add(FBackNavButtonShortCut, nil); ForwardNavButton.Hint := Format('Forward (%s)', [NewShortCutToText(FForwardNavButtonShortCut)]); FKeyMappedMenus.Add(FForwardNavButtonShortCut, nil); end; procedure TMainForm.UpdateTheme; begin FTheme.Typ := FOptions.ThemeType; SetHelpFileDark(FTheme.Dark); for var Memo in FMemos do begin Memo.UpdateThemeColorsAndStyleAttributes; SetControlWindowTheme(Memo, FTheme.Dark); end; InitFormTheme(Self); ToolbarPanel.Color := FTheme.Colors[tcToolBack]; if FTheme.Dark then begin ThemedToolbarVirtualImageList.ImageCollection := ImagesModule.DarkToolBarImageCollection; ThemedMarkersAndACVirtualImageList.ImageCollection := ImagesModule.DarkMarkersAndACImageCollection; end else begin ThemedToolbarVirtualImageList.ImageCollection := ImagesModule.LightToolBarImageCollection; ThemedMarkersAndACVirtualImageList.ImageCollection := ImagesModule.LightMarkersAndACImageCollection; end; UpdateBevel1Visibility; UpdateMarginsAndAutoCompleteIcons; SplitPanel.ParentBackground := False; SplitPanel.Color := FTheme.Colors[tcSplitterBack]; if FTheme.Dark then begin MemosTabSet.Theme := FTheme; OutputTabSet.Theme := FTheme; end else begin MemosTabSet.Theme := nil; OutputTabSet.Theme := nil; end; FMenuDarkBackgroundBrush.Color := FTheme.Colors[tcToolBack]; FMenuDarkHotOrSelectedBrush.Color := $2C2C2C; { Same as themed menu drawn by Windows 11, which is close to Colors[tcBack] } DrawMenuBar(Handle); { SetPreferredAppMode doesn't work without FlushMenuThemes here: it would have to be called before the form is created to have an effect without FlushMenuThemes. So don't call SetPreferredAppMode if FlushMenuThemes is missing. } if Assigned(SetPreferredAppMode) and Assigned(FlushMenuThemes) then begin FMenuImageList := ThemedToolbarVirtualImageList; if FTheme.Dark then SetPreferredAppMode(PAM_FORCEDARK) else SetPreferredAppMode(PAM_FORCELIGHT); FlushMenuThemes; end else FMenuImageList := LightToolbarVirtualImageList; end; procedure TMainForm.UpdateThemeData(const Open: Boolean); procedure CloseThemeDataIfNeeded(var ThemeData: HTHEME); begin if ThemeData <> 0 then begin CloseThemeData(ThemeData); ThemeData := 0; end; end; begin CloseThemeDataIfNeeded(FProgressThemeData); CloseThemeDataIfNeeded(FMenuThemeData); CloseThemeDataIfNeeded(FToolbarThemeData); if Open and UseThemes then begin FProgressThemeData := OpenThemeData(Handle, 'Progress'); FMenuThemeData := OpenThemeData(Handle, 'Menu'); FToolbarThemeData := OpenThemeData(Handle, 'Toolbar'); end; end; procedure TMainForm.UpdateUpdatePanel; begin UpdatePanel.Visible := FUpdatePanelMessages.Count > 0; if UpdatePanel.Visible then begin var MessageToShowIndex := FUpdatePanelMessages.Count-1; UpdateLinkLabel.Tag := MessageToShowIndex; UpdateLinkLabel.Caption := FUpdatePanelMessages[MessageToShowIndex].Msg; UpdatePanel.Color := FUpdatePanelMessages[MessageToShowIndex].Color; end; UpdateBevel1Visibility; end; procedure TMainForm.UpdateMenuBitmapsIfNeeded; procedure AddMenuBitmap(const MenuBitmaps: TMenuBitmaps; const DC: HDC; const BitmapInfo: TBitmapInfo; const MenuItem: TMenuItem; const ImageList: TVirtualImageList; const ImageIndex: Integer); overload; begin var pvBits: Pointer; var Bitmap := CreateDIBSection(DC, bitmapInfo, DIB_RGB_COLORS, pvBits, 0, 0); var OldBitmap := SelectObject(DC, Bitmap); if ImageList_Draw(ImageList.Handle, ImageIndex, DC, 0, 0, ILD_TRANSPARENT) then MenuBitmaps.Add(MenuItem, Bitmap) else begin SelectObject(DC, OldBitmap); DeleteObject(Bitmap); end; end; procedure AddMenuBitmap(const MenuBitmaps: TMenuBitmaps; const DC: HDC; const BitmapInfo: TBitmapInfo; const MenuItem: TMenuItem; const ImageList: TVirtualImageList; const ImageName: String); overload; begin AddMenuBitmap(MenuBitmaps, DC, BitmapInfo, MenuItem, ImageList, ImageList.GetIndexByName(ImageName)); end; type TButtonedMenu = TPair; TNamedMenu = TPair; function BM(const MenuItem: TMenuItem; const ToolButton: TToolButton): TButtonedMenu; begin Result := TButtonedMenu.Create(MenuItem, ToolButton); { This is a record so no need to free } end; function NM(const MenuItem: TMenuItem; const Name: String): TNamedMenu; begin Result := TNamedMenu.Create(MenuItem, Name); { This is a record so no need to free } end; begin { This will create bitmaps for the current DPI using ImageList_Draw. These draw perfectly even on Windows 7. Other techniques don't work because they loose transparency or only look good on Windows 8 and later. Or they do work but cause lots more VCL code to be run than just our simple CreateDIB+Draw combo. ApplyBitmaps will apply them to menu items using SetMenuItemInfo. The menu item does not copy the bitmap so they should still be alive after ApplyBitmaps is done. Depends on FMenuImageList to pick the best size icons for the current DPI from the collection. } var ImageList := FMenuImageList; var NewSize: TSize; NewSize.cx := ImageList.Width; NewSize.cy := ImageList.Height; if (NewSize.cx <> FMenuBitmapsSize.cx) or (NewSize.cy <> FMenuBitmapsSize.cy) or (ImageList.ImageCollection <> FMenuBitmapsSourceImageCollection) then begin { Cleanup previous } for var Bitmap in FMenuBitmaps.Values do DeleteObject(Bitmap); FMenuBitmaps.Clear; { Create } var DC := CreateCompatibleDC(0); if DC <> 0 then begin try var BitmapInfo := CreateBitmapInfo(NewSize.cx, NewSize.cy, 32); var ButtonedMenus := [ BM(FNewMainFile, NewMainFileButton), BM(FOpenMainFile, OpenMainFileButton), BM(FSave, SaveButton), BM(BCompile, CompileButton), BM(BStopCompile, StopCompileButton), BM(RRun, RunButton), BM(RPause, PauseButton), BM(RTerminate, TerminateButton), BM(HDoc, HelpButton)]; for var ButtonedMenu in ButtonedMenus do AddMenuBitmap(FMenuBitmaps, DC, BitmapInfo, ButtonedMenu.Key, ImageList, ButtonedMenu.Value.ImageIndex); var NamedMenus := [ NM(FClearRecent, 'eraser'), NM(FSaveMainFileAs, 'save-as-filled'), NM(FSaveAll, 'save-all-filled'), NM(FPrint, 'printer'), NM(EUndo, 'command-undo-1'), NM(ERedo, 'command-redo-1'), NM(ECut, 'clipboard-cut'), NM(ECopy, 'clipboard-copy'), NM(POutputListCopy, 'clipboard-copy'), NM(EPaste, 'clipboard-paste'), NM(EDelete, 'symbol-cancel'), NM(ESelectAll, 'select-all'), NM(POutputListSelectAll, 'select-all'), NM(EFind, 'find'), NM(EFindInFiles, 'folder-open-filled-find'), //NM(EFindNext, 'unused\find-arrow-right-2'), //NM(EFindPrevious, 'unused\find-arrow-left-2'), NM(EReplace, 'replace'), NM(EFoldLine, 'symbol-remove'), NM(EUnfoldLine, 'symbol-add'), NM(VZoomIn, 'zoom-in'), NM(VZoomOut, 'zoom-out'), NM(VNextTab, 'control-tab-filled-arrow-right-2'), NM(VPreviousTab, 'control-tab-filled-arrow-left-2'), //NM(VCloseCurrentTab, 'unused\control-tab-filled-cancel-2'), NM(VReopenTabs, 'control-tab-filled-redo-1'), NM(VReopenTabs2, 'control-tab-filled-redo-1'), NM(BOpenOutputFolder, 'folder-open-filled'), NM(RParameters, 'control-edit'), NM(RRunToCursor, 'debug-start-filled-arrow-right-2'), NM(RStepInto, 'debug-step-into'), NM(RStepOver, 'debug-step-over'), NM(RStepOut, 'debug-step-out'), NM(RToggleBreakPoint, 'debug-breakpoint-filled'), NM(RToggleBreakPoint2, 'debug-breakpoint-filled'), NM(RDeleteBreakPoints, 'debug-breakpoints-filled-eraser'), NM(RDeleteBreakPoints2, 'debug-breakpoints-filled-eraser'), NM(REvaluate, 'variables'), NM(TAddRemovePrograms, 'application'), NM(TGenerateGUID, 'tag-script-filled'), NM(TFilesDesigner, 'documents-script-filled'), NM(TRegistryDesigner, 'control-tree-script-filled'), NM(TMsgBoxDesigner, 'comment-text-script-filled'), NM(TSignTools, 'key-filled'), NM(TOptions, 'gear-filled'), NM(HDonate, 'heart-filled'), NM(HMailingList, 'alert-filled'), NM(HWhatsNew, 'announcement'), NM(HWebsite, 'home'), NM(HAbout, 'button-info')]; for var NamedMenu in NamedMenus do AddMenuBitmap(FMenuBitmaps, DC, BitmapInfo, NamedMenu.Key, ImageList, NamedMenu.Value); finally DeleteDC(DC); end; end; FMenuBitmapsSize := NewSize; FMenuBitmapsSourceImageCollection := FMenuImageList.ImageCollection; end; end; procedure TMainForm.ApplyMenuBitmaps(const ParentMenuItem: TMenuItem); begin UpdateMenuBitmapsIfNeeded; { Setting MainMenu1.ImageList or a menu item's .Bitmap to make a menu item show a bitmap is not OK: it causes the entire menu to become owner drawn which makes it looks different from native menus and additionally the trick SetFakeShortCut uses doesn't work with owner drawn menus. Instead UpdateMenuBitmapsIfNeeded has prepared images which can be applied to native menu items using SetMenuItemInfo and MIIM_BITMAP - which is what we do below. A problem with this is that Delphi's TMenu likes to constantly recreate the underlying native menu items, for example when updating the caption. Sometimes it will even destroy and repopulate an entire menu because of a simple change like setting the caption of a single item! This means the result of our SetMenuItemInfo call (which Delphi doesn't know about) will quickly become lost when Delphi recreates the menu item. Fixing this in the OnChange event is not possible, this is event is more than useless. The solution is shown by TMenu.DispatchPopup: in reaction to WM_INITMENUPOPUP it calls our Click events right before the menu is shown, giving us the opportunity to call SetMenuItemInfo for the menu's items. This works unless Delphi decides to destroy and repopulate the menu after calling Click. Most amazingly it can do that indeed: it does this if the DPI changed since the last popup or if a automatic hotkey change or line reduction happens due to the menu's AutoHotkeys or AutoLineReduction properties. To make things even worse: for the Run menu it does this each and every time it is opened: this menu currently has a 'Step Out' item which has no shortcut but also all its letters are taken by another item already. This confuses the AutoHotkeys code, making it destroy and repopulate the entire menu over and over because it erroneously thinks a hotkey changed. To avoid this MainMenu1.AutoHotkeys was set to maManual since we have always managed the hotkeys ourselves anyway and .AutoLineReduction was also set to maManual and we now manage that ourselves as well. This just leave an issue with the icons not appearing on the first popup after a DPI change and this seems like a minor issue only. For TPopupMenu: calling ApplyMenuBitmaps(PopupMenu.Items) does work but makes the popup only show icons without text. This seems to be a limitiation of menus created by CreatePopupMenu instead of CreateMenu. This is why our popups with icons are all menu items popped using TMainFormPopupMenu. These menu items are hidden in the main menu and temporarily shown on popup. Popping an always hidden menu item (or a visible one as a child of a hidden parent) doesnt work. } var mmi: TMenuItemInfo; mmi.cbSize := SizeOf(mmi); mmi.fMask := MIIM_BITMAP; for var I := 0 to ParentMenuItem.Count-1 do begin var MenuItem := ParentMenuItem.Items[I]; if MenuItem.Visible then begin if FMenuBitmaps.TryGetValue(MenuItem, mmi.hbmpItem) then SetMenuItemInfo(ParentMenuItem.Handle, MenuItem.Command, False, mmi); if MenuItem.Count > 0 then ApplyMenuBitmaps(MenuItem); end; end; end; procedure TMainForm.StartProcess; var RunFilename, RunParameters, WorkingDir: String; Info: TShellExecuteInfo; SaveFocusWindow: HWND; WindowList: Pointer; ShellExecuteResult: BOOL; ErrorCode: DWORD; begin if FDebugTarget = dtUninstall then begin if FUninstExe = '' then raise Exception.Create(SCompilerNeedUninstExe); RunFilename := FUninstExe; end else begin if FCompiledExe = '' then raise Exception.Create(SCompilerNeedCompiledExe); RunFilename := FCompiledExe; end; RunParameters := Format('/DEBUGWND=$%x ', [Handle]) + FRunParameters; ResetAllMemosLineState; DebugOutputList.Clear; SendMessage(DebugOutputList.Handle, LB_SETHORIZONTALEXTENT, 0, 0); DebugCallStackList.Clear; SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0); if not (OutputTabSet.TabIndex in [tiDebugOutput, tiDebugCallStack]) then OutputTabSet.TabIndex := tiDebugOutput; SetStatusPanelVisible(True); FillChar(Info, SizeOf(Info), 0); Info.cbSize := SizeOf(Info); Info.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_FLAG_DDEWAIT or SEE_MASK_NOCLOSEPROCESS or SEE_MASK_NOZONECHECKS; Info.Wnd := Handle; if FOptions.RunAsDifferentUser then Info.lpVerb := 'runas' else Info.lpVerb := 'open'; Info.lpFile := PChar(RunFilename); Info.lpParameters := PChar(RunParameters); WorkingDir := PathExtractDir(RunFilename); Info.lpDirectory := PChar(WorkingDir); Info.nShow := SW_SHOWNORMAL; { When the RunAsDifferentUser option is enabled, it's this process that waits on the UAC dialog, not Setup(Ldr), so we need to disable windows to prevent the user from clicking other things before the UAC dialog is dismissed (which is definitely a possibility if the "Switch to the secure desktop when prompting for elevation" setting is disabled in Group Policy). } SaveFocusWindow := GetFocus; WindowList := DisableTaskWindows(Handle); try { Also temporarily remove the focus since a disabled window's children can still receive keystrokes. This is needed if Windows doesn't switch to the secure desktop immediately and instead shows a flashing taskbar button that the user must click (which happened on Windows Vista; I'm unable to reproduce it on Windows 11). } Windows.SetFocus(0); ShellExecuteResult := ShellExecuteEx(@Info); ErrorCode := GetLastError; finally EnableTaskWindows(WindowList); Windows.SetFocus(SaveFocusWindow); end; if not ShellExecuteResult then begin { Don't display error message if user clicked Cancel at UAC dialog } if ErrorCode = ERROR_CANCELLED then Abort; raise Exception.CreateFmt(SCompilerExecuteSetupError2, [RunFilename, ErrorCode, Win32ErrorString(ErrorCode)]); end; FDebugging := True; FPaused := False; FProcessHandle := Info.hProcess; CheckIfRunningTimer.Enabled := True; UpdateRunMenu; UpdateCaption; DebugLogMessage('*** ' + DebugTargetStrings[FDebugTarget] + ' started'); end; procedure TMainForm.CompileIfNecessary; function UnopenedIncludedFileModifiedSinceLastCompile: Boolean; var IncludedFile: TIncludedFile; NewTime: TFileTime; begin Result := False; for IncludedFile in FIncludedFiles do begin if (IncludedFile.Memo = nil) and IncludedFile.HasLastWriteTime and GetLastWriteTimeOfFile(IncludedFile.Filename, @NewTime) and (CompareFileTime(IncludedFile.LastWriteTime, NewTime) <> 0) then begin Result := True; Exit; end; end; end; begin CheckIfTerminated; { Display warning if the user modified the script while running - does not support unopened included files } if FDebugging and FModifiedAnySinceLastCompileAndGo then begin if MsgBox('The changes you made will not take effect until you ' + 're-compile.' + SNewLine2 + 'Continue running anyway?', SCompilerFormCaption, mbError, MB_YESNO) <> IDYES then Abort; FModifiedAnySinceLastCompileAndGo := False; { The process may have terminated while the message box was up; check, and if it has, we want to recompile below } CheckIfTerminated; end; if not FDebugging and (FModifiedAnySinceLastCompile or UnopenedIncludedFileModifiedSinceLastCompile) then CompileFile('', False); end; procedure TMainForm.Go(AStepMode: TStepMode); begin CompileIfNecessary; FStepMode := AStepMode; HideError; SetStepLine(FStepMemo, -1); if FDebugging then begin if FPaused then begin FPaused := False; UpdateRunMenu; UpdateCaption; if DebugCallStackList.Items.Count > 0 then begin DebugCallStackList.Clear; SendMessage(DebugCallStackList.Handle, LB_SETHORIZONTALEXTENT, 0, 0); DebugCallStackList.Update; end; { Tell it to continue } SendNotifyMessage(FDebugClientWnd, WM_DebugClient_Continue, Ord(AStepMode = smStepOver), 0); end; end else StartProcess; end; function TMainForm.EvaluateConstant(const S: String; out Output: String): Integer; begin { This is about evaluating constants like 'app' and not [Code] variables } FReplyString := ''; Result := SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_EvaluateConstantW, S); if Result > 0 then Output := FReplyString; end; function TMainForm.EvaluateVariableEntry(const DebugEntry: PVariableDebugEntry; out Output: String): Integer; begin FReplyString := ''; Result := SendCopyDataMessage(FDebugClientWnd, Handle, CD_DebugClient_EvaluateVariableEntry, DebugEntry, SizeOf(DebugEntry^)); if Result > 0 then Output := FReplyString; end; procedure TMainForm.RRunClick(Sender: TObject); begin Go(smRun); end; procedure TMainForm.RParametersClick(Sender: TObject); begin ReadMRUParametersList; InputQueryCombo('Run Parameters', 'Command line parameters for ' + DebugTargetStrings[dtSetup] + ' and ' + DebugTargetStrings[dtUninstall] + ':', FRunParameters, FMRUParametersList); if FRunParameters <> '' then ModifyMRUParametersList(FRunParameters, True); end; procedure TMainForm.RPauseClick(Sender: TObject); begin if FDebugging and not FPaused then begin if FStepMode <> smStepInto then begin FStepMode := smStepInto; UpdateCaption; end else MsgBox('A pause is already pending.', SCompilerFormCaption, mbError, MB_OK); end; end; procedure TMainForm.RRunToCursorClick(Sender: TObject); function GetDebugEntryFromMemoAndLineNumber(Memo: TIDEScintFileEdit; LineNumber: Integer; var DebugEntry: TDebugEntry): Boolean; var I: Integer; begin Result := False; for I := 0 to FDebugEntriesCount-1 do begin if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and (FDebugEntries[I].LineNumber = LineNumber) then begin DebugEntry := FDebugEntries[I]; Result := True; Break; end; end; end; begin CompileIfNecessary; if not GetDebugEntryFromMemoAndLineNumber((FActiveMemo as TIDEScintFileEdit), FActiveMemo.CaretLine, FRunToCursorPoint) then begin MsgBox('No code was generated for the current line.', SCompilerFormCaption, mbError, MB_OK); Exit; end; Go(smRunToCursor); end; procedure TMainForm.RStepIntoClick(Sender: TObject); begin Go(smStepInto); end; procedure TMainForm.RStepOutClick(Sender: TObject); begin if FPausedAtCodeLine then Go(smStepOut) else Go(smStepInto); end; procedure TMainForm.RStepOverClick(Sender: TObject); begin Go(smStepOver); end; procedure TMainForm.RTerminateClick(Sender: TObject); var S, Dir: String; begin S := 'This will unconditionally terminate the running ' + DebugTargetStrings[FDebugTarget] + ' process. Continue?'; if FDebugTarget = dtSetup then S := S + #13#10#13#10'Note that if ' + DebugTargetStrings[FDebugTarget] + ' ' + 'is currently in the installation phase, any changes made to the ' + 'system thus far will not be undone, nor will uninstall data be written.'; if MsgBox(S, 'Terminate', mbConfirmation, MB_YESNO or MB_DEFBUTTON2) <> IDYES then Exit; CheckIfTerminated; if FDebugging then begin DebugLogMessage('*** Terminating process'); Win32Check(TerminateProcess(FDebugClientProcessHandle, 6)); if (WaitForSingleObject(FDebugClientProcessHandle, 5000) <> WAIT_TIMEOUT) and (FTempDir <> '') then begin Dir := FTempDir; FTempDir := ''; DebugLogMessage('*** Removing left-over temporary directory: ' + Dir); { Sleep for a bit to allow files to be unlocked by Windows, otherwise it fails intermittently (with Hyper-Threading, at least) } Sleep(50); if not DeleteDirTree(Dir) and DirExists(Dir) then DebugLogMessage('*** Failed to remove temporary directory'); end; DebuggingStopped(True); end; end; procedure TMainForm.REvaluateClick(Sender: TObject); var Output: String; begin if InputQuery('Evaluate', 'Constant to evaluate (e.g., "{app}"):', FLastEvaluateConstantText) then begin case EvaluateConstant(FLastEvaluateConstantText, Output) of 1: MsgBox(Output, 'Evaluate Result', mbInformation, MB_OK); 2: MsgBox(Output, 'Evaluate Error', mbError, MB_OK); else MsgBox('An unknown error occurred.', 'Evaluate Error', mbError, MB_OK); end; end; end; procedure TMainForm.CheckIfRunningTimerTimer(Sender: TObject); begin { In cases of normal Setup termination, we receive a WM_Debugger_Goodbye message. But in case we don't get that, use a timer to periodically check if the process is no longer running. } CheckIfTerminated; end; procedure TMainForm.POutputListCopyClick(Sender: TObject); var ListBox: TListBox; Text: String; I: Integer; begin if CompilerOutputList.Visible then ListBox := CompilerOutputList else if DebugOutputList.Visible then ListBox := DebugOutputList else if DebugCallStackList.Visible then ListBox := DebugCallStackList else ListBox := FindResultsList; Text := ''; if ListBox.SelCount > 0 then begin for I := 0 to ListBox.Items.Count-1 do begin if ListBox.Selected[I] then begin if Text <> '' then Text := Text + SNewLine; Text := Text + ListBox.Items[I]; end; end; end; Clipboard.AsText := Text; end; procedure TMainForm.POutputListSelectAllClick(Sender: TObject); var ListBox: TListBox; I: Integer; begin if CompilerOutputList.Visible then ListBox := CompilerOutputList else if DebugOutputList.Visible then ListBox := DebugOutputList else if DebugCallStackList.Visible then ListBox := DebugCallStackList else ListBox := FindResultsList; ListBox.Items.BeginUpdate; try for I := 0 to ListBox.Items.Count-1 do ListBox.Selected[I] := True; finally ListBox.Items.EndUpdate; end; end; procedure TMainForm.OutputListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Shift = [ssCtrl] then begin if Key = Ord('C') then POutputListCopyClick(Sender) else if Key = Ord('A') then POutputListSelectAllClick(Sender); end; end; procedure TMainForm.AppOnIdle(Sender: TObject; var Done: Boolean); begin { For an explanation of this, see the comment where HandleMessage is called } if FCompiling then Done := False; FBecameIdle := True; end; procedure TMainForm.EGotoClick(Sender: TObject); var S: String; L: Integer; begin S := IntToStr(FActiveMemo.CaretLine + 1); if InputQuery('Go to Line', 'Line number:', S) then begin L := StrToIntDef(S, Low(L)); if L <> Low(L) then FActiveMemo.CaretLine := L - 1; end; end; procedure TMainForm.StatusBarClick(Sender: TObject); begin if MemosTabSet.Visible and (FHiddenFiles.Count > 0) then begin var Point := SmallPointToPoint(TSmallPoint(GetMessagePos())); var X := StatusBar.ScreenToClient(Point).X; var W := 0; for var I := 0 to StatusBar.Panels.Count-1 do begin Inc(W, StatusBar.Panels[I].Width); if X < W then begin if I = spHiddenFilesCount then (MemosTabSet.PopupMenu as TMainFormPopupMenu).Popup(Point.X, Point.Y); Break; end else if I = spHiddenFilesCount then Break; end; end; end; procedure TMainForm.StatusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); const TP_DROPDOWNBUTTONGLYPH = 7; TS_NORMAL = 1; begin case Panel.Index of spHiddenFilesCount: if MemosTabSet.Visible and (FHiddenFiles.Count > 0) then begin var RText := Rect; if FToolbarThemeData <> 0 then begin Dec(RText.Right, RText.Bottom - RText.Top); var RGlyph := Rect; RGlyph.Left := RText.Right; { RGlyph is now a square } DrawThemeBackground(FToolbarThemeData, StatusBar.Canvas.Handle, TP_DROPDOWNBUTTONGLYPH, TS_NORMAL, RGlyph, nil); end; var S := Format('Tabs closed: %d', [FHiddenFiles.Count]); StatusBar.Canvas.TextRect(RText, S, [tfCenter]); end; spCompileIcon: if FCompiling then begin var BuildImageList := ImagesModule.BuildImageList; ImageList_Draw(BuildImageList.Handle, FBuildAnimationFrame, StatusBar.Canvas.Handle, Rect.Left + ((Rect.Right - Rect.Left) - BuildImageList.Width) div 2, Rect.Top + ((Rect.Bottom - Rect.Top) - BuildImageList.Height) div 2, ILD_NORMAL); end; spCompileProgress: if FCompiling and (FProgressMax > 0) then begin var R := Rect; InflateRect(R, -2, -2); if FProgressThemeData = 0 then begin { Border } StatusBar.Canvas.Pen.Color := clBtnShadow; StatusBar.Canvas.Brush.Style := bsClear; StatusBar.Canvas.Rectangle(R); InflateRect(R, -1, -1); { Filled part } var SaveRight := R.Right; R.Right := R.Left + MulDiv(FProgress, R.Right - R.Left, FProgressMax); StatusBar.Canvas.Brush.Color := clHighlight; StatusBar.Canvas.FillRect(R); { Unfilled part } R.Left := R.Right; R.Right := SaveRight; StatusBar.Canvas.Brush.Color := clBtnFace; StatusBar.Canvas.FillRect(R); end else begin DrawThemeBackground(FProgressThemeData, StatusBar.Canvas.Handle, PP_BAR, 0, R, nil); { PP_FILL drawing on Windows 11 (and probably 10) is bugged: when the width of the green bar is less than ~25 pixels, the bar is drawn over the left border. The same thing happens with TProgressBar, so I don't think the API is being used incorrectly. Work around the bug by passing a clipping rectangle that excludes the left edge when running on Windows 10/11 only. (I don't know if earlier versions need it, or if later versions will fix it.) } var CR := R; if (Win32MajorVersion = 10) and (Win32MinorVersion = 0) then Inc(CR.Left); { does this need to be DPI-scaled? } R.Right := R.Left + MulDiv(FProgress, R.Right - R.Left, FProgressMax); DrawThemeBackground(FProgressThemeData, StatusBar.Canvas.Handle, PP_FILL, PBFS_NORMAL, R, @CR); end; end; end; end; procedure TMainForm.InvalidateStatusPanel(const Index: Integer); var R: TRect; begin { For some reason, the VCL doesn't offer a method for this... } if SendMessage(StatusBar.Handle, SB_GETRECT, Index, LPARAM(@R)) <> 0 then begin InflateRect(R, -1, -1); InvalidateRect(StatusBar.Handle, @R, True); end; end; procedure TMainForm.UpdateCompileStatusPanels(const AProgress, AProgressMax: Cardinal; const ASecondsRemaining: Integer; const ABytesCompressedPerSecond: Cardinal); begin var CurTick := GetTickCount; var LastTick := FLastAnimationTick; FLastAnimationTick := CurTick; { Icon and text panels - updated every 500ms } if CurTick div 500 <> LastTick div 500 then begin InvalidateStatusPanel(spCompileIcon); FBuildAnimationFrame := (FBuildAnimationFrame + 1) mod 4; if ASecondsRemaining >= 0 then StatusBar.Panels[spExtraStatus].Text := Format( ' Estimated time remaining: %.2d%s%.2d%s%.2d Average KB/sec: %.0n', [(ASecondsRemaining div 60) div 60, FormatSettings.TimeSeparator, (ASecondsRemaining div 60) mod 60, FormatSettings.TimeSeparator, ASecondsRemaining mod 60, ABytesCompressedPerSecond / 1024]) else StatusBar.Panels[spExtraStatus].Text := ''; end; { Progress panel and taskbar progress bar - updated every 100ms } if (CurTick div 100 <> LastTick div 100) and ((FProgress <> AProgress) or (FProgressMax <> AProgressMax)) then begin FProgress := AProgress; FProgressMax := AProgressMax; InvalidateStatusPanel(spCompileProgress); { The taskbar progress updates are slow (on Windows 11). Limiting the range to 64 instead of 1024 improved compression KB/sec by about 4% (9000 to 9400) when the rate limit above is disabled. } var NewValue: Cardinal := 1; { must be at least 1 for progress bar to show } if AProgressMax > 0 then begin { Not using MulDiv here to avoid rounding up } NewValue := (AProgress * 64) div AProgressMax; if NewValue = 0 then NewValue := 1; end; { Don't call the function if the value hasn't changed, just in case there's a performance penalty. (There doesn't appear to be on Windows 11.) } if FTaskbarProgressValue <> NewValue then begin FTaskbarProgressValue := NewValue; SetAppTaskbarProgressValue(NewValue, 64); end; end; end; procedure TMainForm.WMSettingChange(var Message: TMessage); begin inherited; if (FTheme.Typ <> ttClassic) and IsWindows10 and (Message.LParam <> 0) and (StrIComp(PChar(Message.LParam), 'ImmersiveColorSet') = 0) then begin FOptions.ThemeType := GetDefaultThemeType; UpdateTheme; end; for var Memo in FMemos do Memo.SettingChange(Message); end; procedure TMainForm.WMThemeChanged(var Message: TMessage); begin { Don't Run to Cursor into this function, it will interrupt up the theme change } UpdateThemeData(True); inherited; end; procedure TMainForm.WMUAHDrawMenu(var Message: TMessage); begin if FTheme.Dark then begin var MenuBarInfo: TMenuBarInfo; MenuBarInfo.cbSize := SizeOf(MenuBarInfo); GetMenuBarInfo(Handle, Integer(OBJID_MENU), 0, MenuBarInfo); var WindowRect: TRect; GetWindowRect(Handle, WindowRect); var Rect := MenuBarInfo.rcBar; OffsetRect(Rect, -WindowRect.Left, -WindowRect.Top); var UAHMenu := PUAHMenu(Message.lParam); FillRect(UAHMenu.hdc, Rect, FMenuDarkBackgroundBrush.Handle); end else inherited; end; procedure TMainForm.WMUAHDrawMenuItem(var Message: TMessage); const ODS_NOACCEL = $100; DTT_TEXTCOLOR = 1; MENU_BARITEM = 8; MBI_NORMAL = 1; var Buffer: array of Char; begin if FTheme.Dark then begin var UAHDrawMenuItem := PUAHDrawMenuItem(Message.lParam); var MenuItemInfo: TMenuItemInfo; MenuItemInfo.cbSize := SizeOf(MenuItemInfo); MenuItemInfo.fMask := MIIM_STRING; MenuItemInfo.dwTypeData := nil; GetMenuItemInfo(UAHDrawMenuItem.um.hmenu, UAHDrawMenuItem.umi.iPosition, True, MenuItemInfo); Inc(MenuItemInfo.cch); SetLength(Buffer, MenuItemInfo.cch); MenuItemInfo.dwTypeData := @Buffer[0]; GetMenuItemInfo(UAHDrawMenuItem.um.hmenu, UAHDrawMenuItem.umi.iPosition, True, MenuItemInfo); var dwFlags: DWORD := DT_CENTER or DT_SINGLELINE or DT_VCENTER; if (UAHDrawMenuItem.dis.itemState and ODS_NOACCEL) <> 0 then dwFlags := dwFlags or DT_HIDEPREFIX; var Inactive := (UAHDrawMenuItem.dis.itemState and ODS_INACTIVE) <> 0; var TextColor: TThemeColor; if Inactive then TextColor := tcMarginFore else TextColor := tcFore; var opts: TDTTOpts; opts.dwSize := SizeOf(opts); opts.dwFlags := DTT_TEXTCOLOR; opts.crText := FTheme.Colors[TextColor]; var Brush: HBrush; { ODS_HOTLIGHT can be set when the menu is inactive so we check Inactive as well. } if not Inactive and ((UAHDrawMenuItem.dis.itemState and (ODS_HOTLIGHT or ODS_SELECTED)) <> 0) then Brush := FMenuDarkHotOrSelectedBrush.Handle else Brush := FMenuDarkBackgroundBrush.Handle; FillRect(UAHDrawMenuItem.um.hdc, UAHDrawMenuItem.dis.rcItem, Brush); DrawThemeTextEx(FMenuThemeData, UAHDrawMenuItem.um.hdc, MENU_BARITEM, MBI_NORMAL, MenuItemInfo.dwTypeData, MenuItemInfo.cch, dwFlags, @UAHDrawMenuItem.dis.rcItem, opts); end else inherited; end; { Should be removed if the main menu ever gets removed } procedure TMainForm.UAHDrawMenuBottomLine; begin if FTheme.Dark then begin var ClientRect: TRect; Windows.GetClientRect(Handle, ClientRect); MapWindowPoints(Handle, 0, ClientRect, 2); var WindowRect: TRect; GetWindowRect(Handle, WindowRect); var Rect := ClientRect; OffsetRect(Rect, -WindowRect.Left, -WindowRect.Top); Rect.Bottom := Rect.Top; Dec(Rect.Top); var DC := GetWindowDC(Handle); FillRect(DC, Rect, FMenuDarkBackgroundBrush.Handle); ReleaseDC(Handle, DC); end; end; procedure TMainForm.WMNCActivate(var Message: TMessage); begin inherited; UAHDrawMenuBottomLine; end; procedure TMainForm.WMNCPaint(var Message: TMessage); begin inherited; UAHDrawMenuBottomLine; end; procedure TMainForm.RTargetClick(Sender: TObject); var NewTarget: TDebugTarget; begin if (Sender = RTargetSetup) or (Sender = TargetSetupButton) then NewTarget := dtSetup else NewTarget := dtUninstall; if (FDebugTarget <> NewTarget) and (not FDebugging or AskToDetachDebugger) then FDebugTarget := NewTarget; { Update always even if the user decided not to switch so the states are restored } UpdateTargetMenu; end; procedure TMainForm.AppOnActivate(Sender: TObject); const ReloadMessages: array[Boolean] of String = ( 'The %s file has been modified outside of the source editor.' + SNewLine2 + 'Do you want to reload the file?', 'The %s file has been modified outside of the source editor. Changes have ' + 'also been made in the source editor.' + SNewLine2 + 'Do you want to ' + 'reload the file and lose the changes made in the source editor?'); var Memo: TIDEScintFileEdit; NewTime: TFileTime; Changed: Boolean; begin for Memo in FFileMemos do begin if (Memo.Filename = '') or not Memo.Used then Continue; { See if the file has been modified outside the editor } Changed := False; if GetLastWriteTimeOfFile(Memo.Filename, @NewTime) then begin if CompareFileTime(Memo.FileLastWriteTime, NewTime) <> 0 then begin Memo.FileLastWriteTime := NewTime; Changed := True; end; end; { If it has been, offer to reload it } if Changed then begin if IsWindowEnabled(Handle) then begin if MsgBox(Format(ReloadMessages[Memo.Modified], [Memo.Filename]), SCompilerFormCaption, mbConfirmation, MB_YESNO) = IDYES then if ConfirmCloseFile(False) then begin OpenFile(Memo, Memo.Filename, False); if Memo = FMainMemo then Break; { Reloading the main script will also reload all include files } end; end else begin { When a modal dialog is up, don't offer to reload the file. Probably not a good idea since the dialog might be manipulating the file. } MsgBox('The ' + Memo.Filename + ' file has been modified outside ' + 'of the source editor. You might want to reload it.', SCompilerFormCaption, mbInformation, MB_OK); end; end; end; end; procedure TMainForm.CompilerOutputListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); const ThemeColors: array [TStatusMessageKind] of TThemeColor = (tcGreen, tcFore, tcOrange, tcRed); var Canvas: TCanvas; S: String; StatusMessageKind: TStatusMessageKind; begin Canvas := CompilerOutputList.Canvas; S := CompilerOutputList.Items[Index]; Canvas.FillRect(Rect); Inc(Rect.Left, 2); if FOptions.ColorizeCompilerOutput and not (odSelected in State) then begin StatusMessageKind := TStatusMessageKind(CompilerOutputList.Items.Objects[Index]); Canvas.Font.Color := FTheme.Colors[ThemeColors[StatusMessageKind]]; end; Canvas.TextOut(Rect.Left, Rect.Top, S); end; procedure TMainForm.DebugOutputListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var Canvas: TCanvas; S: String; begin Canvas := DebugOutputList.Canvas; S := DebugOutputList.Items[Index]; Canvas.FillRect(Rect); Inc(Rect.Left, 2); if (S <> '') and (S[1] = #9) then Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 2, Maxint)) else begin if (Length(S) > 20) and (S[18] = '-') and (S[19] = '-') and (S[20] = ' ') then begin { Draw lines that begin with '-- ' (like '-- File entry --') in bold } Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, 17)); Canvas.Font.Style := [fsBold]; Canvas.TextOut(Rect.Left + FDebugLogListTimestampsWidth, Rect.Top, Copy(S, 18, Maxint)); end else Canvas.TextOut(Rect.Left, Rect.Top, S); end; end; procedure TMainForm.DebugCallStackListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var Canvas: TCanvas; S: String; begin Canvas := DebugCallStackList.Canvas; S := DebugCallStackList.Items[Index]; Canvas.FillRect(Rect); Inc(Rect.Left, 2); Canvas.TextOut(Rect.Left, Rect.Top, S); end; procedure TMainForm.FindResultsListDblClick(Sender: TObject); var FindResult: TFindResult; Memo: TIDEScintFileEdit; I: Integer; begin I := FindResultsList.ItemIndex; if I <> -1 then begin FindResult := FindResultsList.Items.Objects[I] as TFindResult; if FindResult <> nil then begin for Memo in FFileMemos do begin if Memo.Used and (PathCompare(Memo.Filename, FindResult.Filename) = 0) then begin MoveCaretAndActivateMemo(Memo, FindResult.Line, True); Memo.SelectAndEnsureVisible(FindResult.Range); ActiveControl := Memo; Exit; end; end; MsgBox('File not opened.', SCompilerFormCaption, mbError, MB_OK); end; end; end; procedure TMainForm.FindResultsListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var Canvas: TCanvas; S, S2: String; FindResult: TFindResult; StartI, EndI: Integer; SaveColor: TColor; begin Canvas := FindResultsList.Canvas; S := FindResultsList.Items[Index]; FindResult := FindResultsList.Items.Objects[Index] as TFindResult; Canvas.FillRect(Rect); Inc(Rect.Left, 2); if FindResult = nil then begin Canvas.Font.Style := [fsBold]; Canvas.TextOut(Rect.Left, Rect.Top, S); end else if not (odSelected in State) then begin StartI := FindResult.Range.StartPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength; EndI := FindResult.Range.EndPos - FindResult.LineStartPos + 1 + FindResult.PrefixStringLength; if StartI > 1 then begin Canvas.TextOut(Rect.Left, Rect.Top, Copy(S, 1, StartI-1)); Rect.Left := Canvas.PenPos.X; end; SaveColor := Canvas.Brush.Color; if FTheme.Dark then Canvas.Brush.Color := FTheme.Colors[tcRed] else Canvas.Brush.Color := FTheme.Colors[tcSelBack]; S2 := Copy(S, StartI, EndI-StartI); Rect.Right := Rect.Left + Canvas.TextWidth(S2); Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2); { TextRect instead of TextOut to avoid a margin around the text } if EndI <= Length(S) then begin Canvas.Brush.Color := SaveColor; S2 := Copy(S, EndI, MaxInt); Rect.Left := Rect.Right; Rect.Right := Rect.Left + Canvas.TextWidth(S2); Canvas.TextRect(Rect, Rect.Left, Rect.Top, S2); end; end else Canvas.TextOut(Rect.Left, Rect.Top, S) end; procedure TMainForm.OutputTabSetClick(Sender: TObject); begin case OutputTabSet.TabIndex of tiCompilerOutput: begin CompilerOutputList.BringToFront; CompilerOutputList.Visible := True; DebugOutputList.Visible := False; DebugCallStackList.Visible := False; FindResultsList.Visible := False; end; tiDebugOutput: begin DebugOutputList.BringToFront; DebugOutputList.Visible := True; CompilerOutputList.Visible := False; DebugCallStackList.Visible := False; FindResultsList.Visible := False; end; tiDebugCallStack: begin DebugCallStackList.BringToFront; DebugCallStackList.Visible := True; CompilerOutputList.Visible := False; DebugOutputList.Visible := False; FindResultsList.Visible := False; end; tiFindResults: begin FindResultsList.BringToFront; FindResultsList.Visible := True; CompilerOutputList.Visible := False; DebugOutputList.Visible := False; DebugCallStackList.Visible := False; end; end; end; procedure TMainForm.ToggleBreakPoint(Line: Integer); var Memo: TIDEScintFileEdit; I: Integer; begin Memo := FActiveMemo as TIDEScintFileEdit; I := Memo.BreakPoints.IndexOf(Line); if I = -1 then Memo.BreakPoints.Add(Line) else Memo.BreakPoints.Delete(I); UpdateLineMarkers(Memo, Line); BuildAndSaveBreakPointLines(Memo); end; procedure TMainForm.MemoMarginClick(Sender: TObject; MarginNumber: Integer; Line: Integer); begin if (MarginNumber = 1) and RToggleBreakPoint.Enabled then ToggleBreakPoint(Line); end; procedure TMainForm.MemoMarginRightClick(Sender: TObject; MarginNumber: Integer; Line: Integer); begin if MarginNumber = 1 then begin var Point := SmallPointToPoint(TSmallPoint(GetMessagePos())); var PopupMenu := TMainFormPopupMenu.Create(Self, BreakPointsPopupMenu); try PopupMenu.Popup(Point.X, Point.Y); finally PopupMenu.Free; end; end; end; procedure TMainForm.RToggleBreakPointClick(Sender: TObject); begin ToggleBreakPoint(FActiveMemo.CaretLine); end; procedure TMainForm.RDeleteBreakPointsClick(Sender: TObject); begin { Also see AnyMemoHasBreakPoint } for var Memo in FFileMemos do begin if Memo.Used and (Memo.BreakPoints.Count > 0) then begin for var I := Memo.BreakPoints.Count-1 downto 0 do begin var Line := Memo.BreakPoints[I]; Memo.BreakPoints.Delete(I); UpdateLineMarkers(Memo, Line); end; BuildAndSaveBreakPointLines(Memo); end; end; end; procedure TMainForm.UpdateFindResult(const FindResult: TFindResult; const ItemIndex: Integer; const NewLine, NewLineStartPos: Integer); begin { Also see FindInFilesDialogFind } const OldPrefix = Format(' Line %d: ', [FindResult.Line+1]); FindResult.Line := NewLine; const NewPrefix = Format(' Line %d: ', [FindResult.Line+1]); FindResultsList.Items[ItemIndex] := NewPrefix + Copy(FindResultsList.Items[ItemIndex], Length(OldPrefix)+1, MaxInt); FindResult.PrefixStringLength := Length(NewPrefix); const PosChange = NewLineStartPos - FindResult.LineStartPos; FindResult.LineStartPos := NewLineStartPos; FindResult.Range.StartPos := FindResult.Range.StartPos + PosChange; FindResult.Range.EndPos := FindResult.Range.EndPos + PosChange; end; procedure TMainForm.MemoLinesInserted(Memo: TIDEScintFileEdit; FirstLine, Count: integer); begin for var I := 0 to FDebugEntriesCount-1 do if (FDebugEntries[I].FileIndex = Memo.CompilerFileIndex) and (FDebugEntries[I].LineNumber >= FirstLine) then Inc(FDebugEntries[I].LineNumber, Count); for var I := FindResultsList.Items.Count-1 downto 0 do begin const FindResult = FindResultsList.Items.Objects[I] as TFindResult; if FindResult <> nil then begin if (PathCompare(FindResult.Filename, Memo.Filename) = 0) and (FindResult.Line >= FirstLine) then begin const NewLine = FindResult.Line + Count; UpdateFindResult(FindResult, I, NewLine, Memo.GetPositionFromLine(NewLine)); end; end; end; if Assigned(Memo.LineState) and (FirstLine < Memo.LineStateCount) then begin { Grow FStateLine if necessary } var GrowAmount := (Memo.LineStateCount + Count) - Memo.LineStateCapacity; if GrowAmount > 0 then begin if GrowAmount < LineStateGrowAmount then GrowAmount := LineStateGrowAmount; ReallocMem(Memo.LineState, SizeOf(TLineState) * (Memo.LineStateCapacity + GrowAmount)); Inc(Memo.LineStateCapacity, GrowAmount); end; { Shift existing line states and clear the new ones } for var I := Memo.LineStateCount-1 downto FirstLine do Memo.LineState[I + Count] := Memo.LineState[I]; for var I := FirstLine to FirstLine + Count - 1 do Memo.LineState[I] := lnUnknown; Inc(Memo.LineStateCount, Count); end; if Memo.StepLine >= FirstLine then Inc(Memo.StepLine, Count); if Memo.ErrorLine >= FirstLine then Inc(Memo.ErrorLine, Count); var BreakPointsChanged := False; for var I := 0 to Memo.BreakPoints.Count-1 do begin const Line = Memo.BreakPoints[I]; if Line >= FirstLine then begin Memo.BreakPoints[I] := Line + Count; BreakPointsChanged := True; end; end; if BreakPointsChanged then BuildAndSaveBreakPointLines(Memo); FNavStacks.LinesInserted(Memo, FirstLine, Count); end; procedure TMainForm.MemoLinesDeleted(Memo: TIDEScintFileEdit; FirstLine, Count, FirstAffectedLine: Integer); begin for var I := 0 to FDebugEntriesCount-1 do begin const DebugEntry: PDebugEntry = @FDebugEntries[I]; if (DebugEntry.FileIndex = Memo.CompilerFileIndex) and (DebugEntry.LineNumber >= FirstLine) then begin if DebugEntry.LineNumber < FirstLine + Count then DebugEntry.LineNumber := -1 else Dec(DebugEntry.LineNumber, Count); end; end; for var I := FindResultsList.Items.Count-1 downto 0 do begin const FindResult = FindResultsList.Items.Objects[I] as TFindResult; if FindResult <> nil then begin if (PathCompare(FindResult.Filename, Memo.Filename) = 0) and (FindResult.Line >= FirstLine) then begin if FindResult.Line < FirstLine + Count then FindResultsList.Items.Delete(I) else begin const NewLine = FindResult.Line - Count; UpdateFindResult(FindResult, I, NewLine, Memo.GetPositionFromLine(NewLine)); end; end; end; end; if Assigned(Memo.LineState) then begin { Shift existing line states } if FirstLine < Memo.LineStateCount - Count then begin for var I := FirstLine to Memo.LineStateCount - Count - 1 do Memo.LineState[I] := Memo.LineState[I + Count]; Dec(Memo.LineStateCount, Count); end else begin { There's nothing to shift because the last line(s) were deleted, or line(s) past FLineStateCount } if Memo.LineStateCount > FirstLine then Memo.LineStateCount := FirstLine; end; end; if Memo.StepLine >= FirstLine then begin if Memo.StepLine < FirstLine + Count then Memo.StepLine := -1 else Dec(Memo.StepLine, Count); end; if Memo.ErrorLine >= FirstLine then begin if Memo.ErrorLine < FirstLine + Count then Memo.ErrorLine := -1 else Dec(Memo.ErrorLine, Count); end; var BreakPointsChanged := False; for var I := Memo.BreakPoints.Count-1 downto 0 do begin const Line = Memo.BreakPoints[I]; if Line >= FirstLine then begin if Line < FirstLine + Count then begin Memo.BreakPoints.Delete(I); BreakPointsChanged := True; end else begin Memo.BreakPoints[I] := Line - Count; BreakPointsChanged := True; end; end; end; if BreakPointsChanged then BuildAndSaveBreakPointLines(Memo); if FNavStacks.LinesDeleted(Memo, FirstLine, Count) then UpdateNavButtons; { We do NOT update FCurrentNavItem here so it might point to a line that's deleted until next UpdateCaretPosPanelAndBackStack by UpdateMemoUI } { When lines are deleted, Scintilla insists on moving all of the deleted lines' markers to the line on which the deletion started (FirstAffectedLine). This is bad for us as e.g. it can result in the line having two conflicting markers (or two of the same marker). There's no way to stop it from doing that, or to easily tell which markers came from which lines, so we simply delete and re-create all markers on the line. } UpdateLineMarkers(Memo, FirstAffectedLine); end; procedure TMainForm.UpdateLineMarkers(const AMemo: TIDEScintFileEdit; const Line: Integer); var NewMarker: Integer; begin if Line >= AMemo.Lines.Count then Exit; var StepLine := AMemo.StepLine = Line; NewMarker := -1; if AMemo.BreakPoints.IndexOf(Line) <> -1 then begin if AMemo.LineState = nil then NewMarker := mmiBreakpoint else if (Line < AMemo.LineStateCount) and (AMemo.LineState[Line] <> lnUnknown) then NewMarker := IfThen(StepLine, mmiBreakpointStep, mmiBreakpointGood) else NewMarker := mmiBreakpointBad; end else if StepLine then NewMarker := mmiStep else begin if Line < AMemo.LineStateCount then begin case AMemo.LineState[Line] of lnHasEntry: NewMarker := mmiHasEntry; lnEntryProcessed: NewMarker := mmiEntryProcessed; end; end; end; { Delete all markers on the line. To flush out any possible duplicates, even the markers we'll be adding next are deleted. } if AMemo.GetMarkers(Line) <> [] then AMemo.DeleteAllMarkersOnLine(Line); if NewMarker <> -1 then AMemo.AddMarker(Line, NewMarker); if StepLine then AMemo.AddMarker(Line, mlmStep) else if AMemo.ErrorLine = Line then AMemo.AddMarker(Line, mlmError) else if NewMarker = mmiBreakpointBad then AMemo.AddMarker(Line, mlmBreakpointBad); end; procedure TMainForm.UpdateLinkLabelLinkClick(Sender: TObject; const Link: string; LinkType: TSysLinkType); begin var Handled := True; if (LinkType = sltID) and (Link = 'hwhatsnew') then HWhatsNew.Click else if (LinkType = sltID) and (Link = 'toptions-vscode') then begin TOptionsForm.DropDownMemoKeyMappingComboBoxOnNextShow := True; TOptions.Click end else Handled := False; if Handled then UpdatePanelClosePaintBoxClick(Sender); end; procedure TMainForm.UpdatePanelClosePaintBoxClick(Sender: TObject); begin var MessageToHideIndex := UpdateLinkLabel.Tag; var Ini := TConfigIniFile.Create; try Ini.WriteInteger('UpdatePanel', FUpdatePanelMessages[MessageToHideIndex].ConfigIdent, FUpdatePanelMessages[MessageToHideIndex].ConfigValue); finally Ini.Free; end; FUpdatePanelMessages.Delete(MessageToHideIndex); UpdateUpdatePanel; end; procedure TMainForm.UpdatePanelDonateImageClick(Sender: TObject); begin HDonate.Click; end; procedure TMainForm.UpdatePanelClosePaintBoxPaint(Sender: TObject); const MENU_SYSTEMCLOSE = 17; MSYSC_NORMAL = 1; begin var Canvas := UpdatePanelClosePaintBox.Canvas; var R := TRect.Create(0, 0, UpdatePanelClosePaintBox.Width, UpdatePanelClosePaintBox.Height); if FMenuThemeData <> 0 then begin var Offset := MulDiv(1, CurrentPPI, 96); Inc(R.Left, Offset); DrawThemeBackground(FMenuThemeData, Canvas.Handle, MENU_SYSTEMCLOSE, MSYSC_NORMAL, R, nil); end else begin InflateRect(R, -MulDiv(6, CurrentPPI, 96), -MulDiv(6, CurrentPPI, 96)); Canvas.Pen.Color := Canvas.Font.Color; Canvas.MoveTo(R.Left, R.Top); Canvas.LineTo(R.Right, R.Bottom); Canvas.MoveTo(R.Left, R.Bottom-1); Canvas.LineTo(R.Right, R.Top-1); end; end; procedure TMainForm.UpdateAllMemoLineMarkers(const AMemo: TIDEScintFileEdit); begin for var Line := 0 to AMemo.Lines.Count-1 do UpdateLineMarkers(AMemo, Line); end; procedure TMainForm.UpdateAllMemosLineMarkers; begin for var Memo in FFileMemos do if Memo.Used then UpdateAllMemoLineMarkers(Memo); end; procedure TMainForm.UpdateBevel1Visibility; begin { Bevel1 is the line between the toolbar and memos when there's nothing in between and the color of the toolbar and memo margins is the same } Bevel1.Visible := (ToolBarPanel.Color = FTheme.Colors[tcMarginBack]) and not UpdatePanel.Visible and not MemosTabSet.Visible; end; function TMainForm.ToCurrentPPI(const XY: Integer): Integer; begin Result := MulDiv(XY, CurrentPPI, 96); end; function TMainForm.FromCurrentPPI(const XY: Integer): Integer; begin Result := MulDiv(XY, 96, CurrentPPI); end; initialization Application.OnGetActiveFormHandle := TMainForm.AppOnGetActiveFormHandle; InitThemeLibrary; InitHtmlHelpLibrary; { For ClearType support, try to make the default font Microsoft Sans Serif } if DefFontData.Name = 'MS Sans Serif' then DefFontData.Name := AnsiString(GetPreferredUIFont); CoInitialize(nil); finalization CoUninitialize(); end.